commit ad0201fb6ec6d61d45591c59f5407be4e277eaae parent 6bd07b7221cdfb0ef5a02a4e320f17769c912761 Author: dwrz <dwrz@dwrz.net> Date: Wed, 20 Nov 2024 14:54:52 +0000 Update Emacs packages Diffstat:
446 files changed, 40379 insertions(+), 45702 deletions(-)
diff --git a/emacs/elpa/archives/gnu/archive-contents b/emacs/elpa/archives/gnu/archive-contents @@ -607,16 +607,18 @@ (:url . "https://elpa.gnu.org/packages/cobol-mode.html") (:commit . "bd7879daa71908616277688ba51d27b60c88b0a2"))]) (code-cells . - [(0 4) + [(0 5) ((emacs - (27 1))) + (27 1)) + (compat + (29 1))) "Lightweight notebooks with support for ipynb files" tar ((:url . "https://github.com/astoff/code-cells.el") (:keywords "convenience" "outlines") (:maintainer "Augusto Stoffel" . "arstoffel@gmail.com") (:authors ("Augusto Stoffel" . "arstoffel@gmail.com")) - (:commit . "44546ca256f3da29e3ac884e3d699c8455acbd6e"))]) + (:commit . "caffb420be106cebbdfe4474ed0507a601603f83"))]) (colorful-mode . [(1 0 4) ((emacs @@ -1403,7 +1405,7 @@ (:url . "https://elpa.gnu.org/packages/elisp-benchmarks.html") (:commit . "1a3d97954957a95a179806e0d49ca6d178b097af"))]) (ellama . - [(0 12 4) + [(0 12 5) ((emacs (28 1)) (llm @@ -1420,7 +1422,7 @@ (:maintainer "Sergey Kostyaev" . "sskostyaev@gmail.com") (:authors ("Sergey Kostyaev" . "sskostyaev@gmail.com")) - (:commit . "882b0b241c2f69124edce70d41dc95ff49cb40e8"))]) + (:commit . "e8f64969d66aa71341804e0a4f8d3e7c632bf3b6"))]) (emacs-gc-stats . [(1 4 2) ((emacs @@ -2533,7 +2535,7 @@ ("Sean Whitton" . "spwhitton@spwhitton.name")) (:commit . "c22a15e86acf28da716532c26ba1371574c8e979"))]) (llm . - [(0 18 0) + [(0 18 1) ((emacs (28 1)) (plz @@ -2547,7 +2549,7 @@ (:maintainer "Andrew Hyatt" . "ahyatt@gmail.com") (:authors ("Andrew Hyatt" . "ahyatt@gmail.com")) - (:commit . "423f483db3b285906e2b0ce45fd928ef84720563"))]) + (:commit . "90c2451d0c0d1b9598e67b2c1a3516a8496f130f"))]) (lmc . [(1 4) nil "Little Man Computer in Elisp" tar diff --git a/emacs/elpa/archives/gnu/archive-contents.signed b/emacs/elpa/archives/gnu/archive-contents.signed @@ -1 +1 @@ -Good signature from 645357D2883A0966 GNU ELPA Signing Agent (2023) <elpasign@elpa.gnu.org> (trust undefined) created at 2024-11-17T10:05:01+0000 using EDDSA -\ No newline at end of file +Good signature from 645357D2883A0966 GNU ELPA Signing Agent (2023) <elpasign@elpa.gnu.org> (trust undefined) created at 2024-11-20T10:05:03+0000 using EDDSA +\ No newline at end of file diff --git a/emacs/elpa/archives/melpa/archive-contents b/emacs/elpa/archives/melpa/archive-contents @@ -163,7 +163,7 @@ (apples-mode . [(20110121 418) nil "Major mode for editing and executing AppleScript code" tar ((:url . "https://github.com/tequilasunset/apples-mode") (:commit . "83a9ab0d6ba82496e2f7df386909b1a55701fccb") (:revdesc . "83a9ab0d6ba8") (:keywords "applescript" "languages") (:authors ("tequilasunset" . "tequilasunset.mac@gmail.com")) (:maintainers ("tequilasunset" . "tequilasunset.mac@gmail.com")) (:maintainer "tequilasunset" . "tequilasunset.mac@gmail.com"))]) (applescript-mode . [(20210802 1715) ((emacs (24 3))) "Major mode for editing AppleScript source" tar ((:url . "https://github.com/emacsorphanage/applescript-mode") (:commit . "00c141bbff46c89a96598b605dee05dd1d89f624") (:revdesc . "00c141bbff46") (:keywords "languages" "tools") (:authors ("sakito" . "sakito@users.sourceforge.jp")) (:maintainers ("sakito" . "sakito@users.sourceforge.jp")) (:maintainer "sakito" . "sakito@users.sourceforge.jp"))]) (aproject . [(20220410 541) nil "Basic project framework for Emacs" tar ((:url . "https://github.com/vietor/aproject") (:commit . "13e176ee69851403bec6471c5cceed17b7912b6f") (:revdesc . "13e176ee6985") (:keywords "environment" "project") (:authors ("Vietor Liu" . "vietor.liu@gmail.com")) (:maintainers ("Vietor Liu" . "vietor.liu@gmail.com")) (:maintainer "Vietor Liu" . "vietor.liu@gmail.com"))]) - (apropospriate-theme . [(20240921 1422) nil "A colorful, low-contrast, light & dark theme set for Emacs with a fun name" tar ((:url . "https://github.com/waymondo/apropospriate-theme") (:commit . "055693f52b5179f896a49c0570b5a6ca441fb2b9") (:revdesc . "055693f52b51") (:authors ("Justin Talbott" . "justin@waymondo.com")) (:maintainers ("Justin Talbott" . "justin@waymondo.com")) (:maintainer "Justin Talbott" . "justin@waymondo.com"))]) + (apropospriate-theme . [(20241119 1) nil "A colorful, low-contrast, light & dark theme set for Emacs with a fun name" tar ((:url . "https://github.com/waymondo/apropospriate-theme") (:commit . "56c8c1b575106e72bcab2227fd73cf34f7f3df79") (:revdesc . "56c8c1b57510") (:authors ("Justin Talbott" . "justin@waymondo.com")) (:maintainers ("Justin Talbott" . "justin@waymondo.com")) (:maintainer "Justin Talbott" . "justin@waymondo.com"))]) (apt-sources-list . [(20180527 1241) ((emacs (24 4))) "Mode for editing APT source.list files" tar ((:url . "https://git.korewanetadesu.com/apt-sources-list.git") (:commit . "44112833b3fa7f4d7e43708e5996782e22bb2fa3") (:revdesc . "44112833b3fa") (:authors ("Dr. Rafael Sepúlveda" . "drs@gnulinux.org.mx")) (:maintainers ("Joe Wreschnig" . "joe.wreschnig@gmail.com")) (:maintainer "Joe Wreschnig" . "joe.wreschnig@gmail.com"))]) (aqi . [(20230530 1204) ((emacs (25 1)) (request (0 3)) (let-alist (0 0))) "Air quality data from the World Air Quality Index" tar ((:url . "https://github.com/zzkt/aqi") (:commit . "cbff3c6ce691a3a1d2f5636384e29d43f0e1d236") (:revdesc . "cbff3c6ce691") (:keywords "air quality" "aqi" "pollution" "weather" "data") (:authors ("nik gaffney" . "nik@fo.am")) (:maintainers ("nik gaffney" . "nik@fo.am")) (:maintainer "nik gaffney" . "nik@fo.am"))]) (arch-packer . [(20170730 1321) ((emacs (25 1)) (s (1 11 0)) (async (1 9 2)) (dash (2 12 0))) "Arch Linux package management frontend" tar ((:url . "https://github.com/brotzeit/arch-packer") (:commit . "940e96f7d357c6570b675a0f942181c787f1bfd7") (:revdesc . "940e96f7d357") (:authors ("Fritz Stelzer" . "brotzeitmacher@gmail.com")) (:maintainers ("Fritz Stelzer" . "brotzeitmacher@gmail.com")) (:maintainer "Fritz Stelzer" . "brotzeitmacher@gmail.com"))]) @@ -291,7 +291,7 @@ (bart-mode . [(20190601 1004) ((emacs (24 3))) "Real time BART departures info" tar ((:url . "https://github.com/mschuldt/bart-mode") (:commit . "f70b6c42452e47c0c6b3ebd4c90e555a9bedeec7") (:revdesc . "f70b6c42452e") (:keywords "convenience" "transit") (:authors ("Michael Schuldt" . "mbschuldt@gmail.com")) (:maintainers ("Michael Schuldt" . "mbschuldt@gmail.com")) (:maintainer "Michael Schuldt" . "mbschuldt@gmail.com"))]) (base16-theme . [(20240908 114) nil "Collection of themes built on combinations of 16 base colors" tar ((:url . "https://github.com/tinted-theming/base16-emacs") (:commit . "077726249216bef6d98d0542eb6289641a58e8d0") (:revdesc . "077726249216") (:authors ("Kaleb Elwert" . "belak@coded.io")) (:maintainers ("Kaleb Elwert" . "belak@coded.io")) (:maintainer "Kaleb Elwert" . "belak@coded.io"))]) (base32 . [(20240227 1821) ((emacs (27 1))) "Base32 support" tar ((:url . "https://gitlab.com/fledermaus/totp.el") (:commit . "927257e97a602b6979a75028e8417bf1499582d4") (:revdesc . "927257e97a60") (:keywords "tools") (:authors ("Vivek Das Mohapatra" . "vivek@etla.org")) (:maintainers ("Vivek Das Mohapatra" . "vivek@etla.org")) (:maintainer "Vivek Das Mohapatra" . "vivek@etla.org"))]) - (bash-completion . [(20230612 1103) ((emacs (25 3))) "Bash completion for the shell buffer" tar ((:url . "https://github.com/szermatt/emacs-bash-completion") (:commit . "f1daac0386c24cbe8a244a62c7588cc6847b07ae") (:revdesc . "f1daac0386c2") (:keywords "convenience" "unix") (:authors ("Stephane Zermatten" . "szermatt@gmx.net")) (:maintainers ("Stephane Zermatten" . "szermatt@gmail.com")) (:maintainer "Stephane Zermatten" . "szermatt@gmail.com"))]) + (bash-completion . [(20241118 1847) ((emacs (25 3))) "Bash completion for the shell buffer" tar ((:url . "https://github.com/szermatt/emacs-bash-completion") (:commit . "f3a85184ef9cc925bedcdbd62f66dd63a658f181") (:revdesc . "f3a85184ef9c") (:keywords "convenience" "unix") (:authors ("Stephane Zermatten" . "szermatt@gmx.net")) (:maintainers ("Stephane Zermatten" . "szermatt@gmail.com")) (:maintainer "Stephane Zermatten" . "szermatt@gmail.com"))]) (basic-c-compile . [(20170302 1112) ((cl-lib (0 5)) (f (0 19 0))) "Quickly create a Makefile, compile and run C" tar ((:url . "https://github.com/nick96/basic-c-compile") (:commit . "335e96e19647ad7245fb68cf7e68cf86c5023d23") (:revdesc . "335e96e19647") (:keywords "c" "makefile" "compilation" "convenience") (:authors ("Nick Spain" . "nicholas.spain96@gmail.com")) (:maintainers ("Nick Spain" . "nicholas.spain96@gmail.com")) (:maintainer "Nick Spain" . "nicholas.spain96@gmail.com"))]) (basic-ide . [(20230118 1040) ((emacs (25)) (basic-mode (0 4 2)) (company (0 9 12)) (flycheck (0 22)) (dash (2 12 0)) (f (0 17 0))) "BASIC IDE c64" tar ((:url . "https://gitlab.com/sasanidas/emacs-c64-basic-ide") (:commit . "e33036f838e61b647927165e81be5d5b855e0518") (:revdesc . "e33036f838e6") (:keywords "languages" "basic") (:authors ("Fermin MF" . "fmfs@posteo.net")) (:maintainers ("Fermin MF" . "fmfs@posteo.net")) (:maintainer "Fermin MF" . "fmfs@posteo.net"))]) (basic-mode . [(20231125 1617) ((seq (2 20)) (emacs (25 1))) "Major mode for editing BASIC code" tar ((:url . "https://github.com/dykstrom/basic-mode") (:commit . "1dc1a635d6d80668c8a583b974205e49ff0fc3ce") (:revdesc . "1dc1a635d6d8") (:keywords "basic" "languages"))]) @@ -531,7 +531,7 @@ (chapel-mode . [(20210513 457) ((emacs (25 1)) (hydra (0 15 0))) "A major mode for the Chapel programming language" tar ((:url . "https://github.com/damon-kwok/chapel-mode") (:commit . "39fd24bb7cf44808200354ac0496be4fc4fddd9a") (:revdesc . "39fd24bb7cf4") (:keywords "chapel" "chpl" "programming" "languages"))]) (char-menu . [(20210321 1657) ((emacs (24 3)) (avy-menu (0 1))) "Create your own menu for fast insertion of arbitrary symbols" tar ((:url . "https://github.com/mrkkrp/char-menu") (:commit . "d77c4d64fc8acc386a0fb9727d346c838e75f011") (:revdesc . "d77c4d64fc8a") (:keywords "convenience" "editing") (:authors ("Mark Karpov" . "markkarpov92@gmail.com")) (:maintainers ("Mark Karpov" . "markkarpov92@gmail.com")) (:maintainer "Mark Karpov" . "markkarpov92@gmail.com"))]) (charmap . [(20200616 1418) nil "Unicode table for Emacs" tar ((:url . "https://github.com/lateau/charmap") (:commit . "feac50b87d2a596c5e5b7b82b79ddd65b6dedd8c") (:revdesc . "feac50b87d2a") (:keywords "unicode" "character" "ucs") (:authors ("Anan Mikami" . "lateau@gmail.com")) (:maintainers ("Anan Mikami" . "lateau@gmail.com")) (:maintainer "Anan Mikami" . "lateau@gmail.com"))]) - (chatgpt-shell . [(20241113 2229) ((emacs (28 1)) (shell-maker (0 62 1))) "ChatGPT shell + buffer insert commands" tar ((:url . "https://github.com/xenodium/chatgpt-shell") (:commit . "fa383b47ed258c1d7b61d7399df02f74a0f8aa98") (:revdesc . "fa383b47ed25"))]) + (chatgpt-shell . [(20241120 1025) ((emacs (28 1)) (shell-maker (0 68 1))) "A multi-llm comint Emacs shell (plus other goodies)" tar ((:url . "https://github.com/xenodium/chatgpt-shell") (:commit . "7132a3d718941493818df47a61f6d6006a513ac1") (:revdesc . "7132a3d71894"))]) (chatu . [(20240518 615) ((org (9 6 6)) (emacs (29 1)) (plantuml-mode (1 2 9))) "Convert and insert any images to org-mode or markdown buffer" tar ((:url . "https://github.com/kimim/chatu") (:commit . "f813f0bc926346fbd8151d2ae7079119d4657abb") (:revdesc . "f813f0bc9263") (:keywords "multimedia" "convenience") (:authors ("Kimi Ma" . "kimi.im@outlook.com")) (:maintainers ("Kimi Ma" . "kimi.im@outlook.com")) (:maintainer "Kimi Ma" . "kimi.im@outlook.com"))]) (chatwork . [(20240910 1531) nil "ChatWork client for Emacs" tar ((:url . "https://github.com/ataka/chatwork") (:commit . "5abbf07bd6063c922191cc645f5771a943e3043c") (:revdesc . "5abbf07bd606") (:keywords "web") (:authors ("Masayuki Ataka" . "masayuki.ataka@gmail.com")) (:maintainers ("Masayuki Ataka" . "masayuki.ataka@gmail.com")) (:maintainer "Masayuki Ataka" . "masayuki.ataka@gmail.com"))]) (cheat-sh . [(20210607 1307) ((emacs (25 1))) "Interact with cheat.sh" tar ((:url . "https://github.com/davep/cheat-sh.el") (:commit . "33bae22feae8d3375739c6bdef08d0dcdf47ee42") (:revdesc . "33bae22feae8") (:keywords "docs" "help") (:authors ("Dave Pearson" . "davep@davep.org")) (:maintainers ("Dave Pearson" . "davep@davep.org")) (:maintainer "Dave Pearson" . "davep@davep.org"))]) @@ -644,7 +644,7 @@ (coc-dc . [(20241104 1739) ((emacs (27 2)) (hydra (0 14 0))) "A Clash of Clans damage calculator" tar ((:url . "https://github.com/S0mbr3/coc-damage-calculator") (:commit . "097bc2496263fc1e69a04d0528b41baf2fd08115") (:revdesc . "097bc2496263") (:keywords "games") (:authors ("S0mbr3" . "0xf2f@proton.me")) (:maintainers ("S0mbr3" . "0xf2f@proton.me")) (:maintainer "S0mbr3" . "0xf2f@proton.me"))]) (codcut . [(20190915 1009) nil "Share pieces of code to Codcut" tar ((:url . "https://github.com/codcut/codcut-emacs") (:commit . "bf07c3db3900e36b0b87423f3b715d6378f86393") (:revdesc . "bf07c3db3900") (:keywords "comm" "tools" "codcut" "share") (:authors ("Diego Pasquali" . "hello@dgopsq.space")) (:maintainers ("Diego Pasquali" . "hello@dgopsq.space")) (:maintainer "Diego Pasquali" . "hello@dgopsq.space"))]) (code-archive . [(20190612 308) ((emacs (24 3))) "Git supported code archive and reference for org-mode" tar ((:url . "https://github.com/mschuldt/code-archive") (:commit . "1ad9af6679d0294c3056eab9cad673f29c562721") (:revdesc . "1ad9af6679d0") (:authors ("Michael Schuldt" . "mbschuldt@gmail.com")) (:maintainers ("Michael Schuldt" . "mbschuldt@gmail.com")) (:maintainer "Michael Schuldt" . "mbschuldt@gmail.com"))]) - (code-cells . [(20241101 1618) ((emacs (27 1)) (compat (29 1))) "Lightweight notebooks with support for ipynb files" tar ((:url . "https://github.com/astoff/code-cells.el") (:commit . "35e68b9d80b216924820e1393bf98ba5b6722edb") (:revdesc . "35e68b9d80b2") (:keywords "convenience" "outlines") (:authors ("Augusto Stoffel" . "arstoffel@gmail.com")) (:maintainers ("Augusto Stoffel" . "arstoffel@gmail.com")) (:maintainer "Augusto Stoffel" . "arstoffel@gmail.com"))]) + (code-cells . [(20241119 1421) ((emacs (27 1)) (compat (29 1))) "Lightweight notebooks with support for ipynb files" tar ((:url . "https://github.com/astoff/code-cells.el") (:commit . "caffb420be106cebbdfe4474ed0507a601603f83") (:revdesc . "caffb420be10") (:keywords "convenience" "outlines") (:authors ("Augusto Stoffel" . "arstoffel@gmail.com")) (:maintainers ("Augusto Stoffel" . "arstoffel@gmail.com")) (:maintainer "Augusto Stoffel" . "arstoffel@gmail.com"))]) (code-compass . [(20231108 1618) ((emacs (26 1)) (s (1 12 0)) (dash (2 13)) (async (1 9 7)) (simple-httpd (1 5 1))) "Navigate software aided by metrics and visualization" tar ((:url . "https://github.com/ag91/code-compass") (:commit . "67ec53f9ca43bea941ec5ba6fccba8565c1d937f") (:revdesc . "67ec53f9ca43") (:keywords "tools" "extensions" "help") (:authors ("Andrea" . "andrea-dev@hotmail.com")) (:maintainers ("Andrea" . "andrea-dev@hotmail.com")) (:maintainer "Andrea" . "andrea-dev@hotmail.com"))]) (code-library . [(20160426 1218) ((gist (1 3 1))) "Use org-mode to collect code snippets" tar ((:url . "https://github.com/lujun9972/code-library") (:commit . "3c79338eae5c892bfb4e4882298422d9fd65d2d7") (:revdesc . "3c79338eae5c") (:keywords "lisp" "code") (:authors ("DarkSun" . "lujun9972@gmail.com")) (:maintainers ("DarkSun" . "lujun9972@gmail.com")) (:maintainer "DarkSun" . "lujun9972@gmail.com"))]) (code-review . [(20221206 113) ((emacs (25 1)) (closql (1 2 0)) (magit (3 0 0)) (transient (0 3 7)) (a (1 0 0)) (ghub (3 5 1)) (uuidgen (1 2)) (deferred (0 5 1)) (markdown-mode (2 4)) (forge (0 3 0)) (emojify (1 2))) "Perform code review from Github, Gitlab, and Bitbucket Cloud" tar ((:url . "https://github.com/wandersoncferreira/code-review") (:commit . "a8bb63b53f2a1fd31302c110e668ad7b5c871b34") (:revdesc . "a8bb63b53f2a") (:keywords "git" "tools" "vc") (:authors ("Wanderson Ferreira" . "https://github.com/wandersoncferreira")) (:maintainers ("Wanderson Ferreira" . "wand@hey.com")) (:maintainer "Wanderson Ferreira" . "wand@hey.com"))]) @@ -759,6 +759,7 @@ (company-ycmd . [(20180520 1053) ((ycmd (1 3)) (company (0 9 3)) (deferred (0 5 1)) (s (1 11 0)) (dash (2 13 0)) (let-alist (1 0 5)) (f (0 19 0))) "Company-mode backend for ycmd" tar ((:url . "https://github.com/abingham/emacs-ycmd") (:commit . "966594701c1eef1f6d4dad0c71c6d43a029977d7") (:revdesc . "966594701c1e"))]) (compdef . [(20200304 611) ((emacs (24 4))) "A local completion definer" tar ((:url . "https://github.com/cyruseuros/compdef") (:commit . "30fb5846ed851efee641ce8c5d8879ad36cd7ac6") (:revdesc . "30fb5846ed85") (:keywords "convenience"))]) (competitive-programming-snippets . [(20201115 1702) ((emacs (26)) (yasnippet (0 8 0))) "Competitive Programming snippets for yasnippet" tar ((:url . "https://github.com/sei40kr/competitive-programming-snippets") (:commit . "3b43c1aeaa6676d1d3d0c47e78790db9bee150b6") (:revdesc . "3b43c1aeaa66") (:keywords "tools") (:authors ("Seong Yong-ju" . "sei40kr@gmail.com")) (:maintainers ("Seong Yong-ju" . "sei40kr@gmail.com")) (:maintainer "Seong Yong-ju" . "sei40kr@gmail.com"))]) + (compile-angel . [(20241120 505) ((emacs (26 1))) "Automatically Compile Elisp files (auto-compile alternative)" tar ((:url . "https://github.com/jamescherti/compile-angel.el") (:commit . "359069adbd67e713782a08ae2554032cf1477703") (:revdesc . "359069adbd67") (:keywords "convenience"))]) (compile-multi . [(20240923 1814) ((emacs (28 1))) "A multi target interface to compile" tar ((:url . "https://github.com/mohkale/compile-multi") (:commit . "94b2f267d1e424cf523643a3c9841c83f0a86368") (:revdesc . "94b2f267d1e4") (:keywords "tools" "compile" "build") (:authors ("mohsin kaleem" . "mohkale@kisara.moe")) (:maintainers ("mohsin kaleem" . "mohkale@kisara.moe")) (:maintainer "mohsin kaleem" . "mohkale@kisara.moe"))]) (compile-multi-all-the-icons . [(20240923 1814) ((emacs (28 0)) (all-the-icons-completion (0 0 1))) "Affixate `compile-multi' with icons" tar ((:url . "https://github.com/mohkale/compile-multi") (:commit . "94b2f267d1e424cf523643a3c9841c83f0a86368") (:revdesc . "94b2f267d1e4") (:keywords "tools" "compile" "build") (:authors ("mohsin kaleem" . "mohkale@kisara.moe")) (:maintainers ("mohsin kaleem" . "mohkale@kisara.moe")) (:maintainer "mohsin kaleem" . "mohkale@kisara.moe"))]) (compile-multi-embark . [(20240923 1814) ((emacs (28 1)) (compile-multi (0 4)) (embark (0 22 1))) "Integration for `compile-multi' and `embark'" tar ((:url . "https://github.com/mohkale/compile-multi") (:commit . "94b2f267d1e424cf523643a3c9841c83f0a86368") (:revdesc . "94b2f267d1e4") (:keywords "project" "convenience") (:authors ("Mohsin Kaleem" . "mohkale@kisara.moe")) (:maintainers ("Mohsin Kaleem" . "mohkale@kisara.moe")) (:maintainer "Mohsin Kaleem" . "mohkale@kisara.moe"))]) @@ -777,7 +778,7 @@ (connection . [(20191111 446) nil "TCP-based client connection" tar ((:url . "https://github.com/myrkr/dictionary-el") (:commit . "c9cad101100975e88873636bfd426b7a19304ebd") (:revdesc . "c9cad1011009") (:keywords "network") (:authors ("Torsten Hilbrich" . "torsten.hilbrich@gmx.net")) (:maintainers ("Torsten Hilbrich" . "torsten.hilbrich@gmx.net")) (:maintainer "Torsten Hilbrich" . "torsten.hilbrich@gmx.net"))]) (conner . [(20240828 123) ((emacs (29 1))) "Define and run project specific commands" tar ((:url . "https://github.com/tralph3/conner") (:commit . "93caf208e8e7f6b0627e5eb162f1488311d16b4c") (:revdesc . "93caf208e8e7") (:keywords "tools"))]) (constant-theme . [(20180921 1012) ((emacs (24 1))) "A calm, dark, almost monochrome color theme" tar ((:url . "https://github.com/Jannis/emacs-constant-theme") (:commit . "0feb9f99d708633d62fa548c953ebbe68fd70de0") (:revdesc . "0feb9f99d708") (:keywords "themes") (:authors ("Jannis Pohlmann" . "contact@jannispohlmann.de")) (:maintainers ("Jannis Pohlmann" . "contact@jannispohlmann.de")) (:maintainer "Jannis Pohlmann" . "contact@jannispohlmann.de"))]) - (consult . [(20241115 517) ((emacs (28 1)) (compat (30))) "Consulting completing-read" tar ((:url . "https://github.com/minad/consult") (:commit . "554c21567a05e367a0daf60a199ba1db6ba09eca") (:revdesc . "554c21567a05") (:keywords "matching" "files" "completion") (:maintainers ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainer "Daniel Mendler" . "mail@daniel-mendler.de"))]) + (consult . [(20241117 2113) ((emacs (28 1)) (compat (30))) "Consulting completing-read" tar ((:url . "https://github.com/minad/consult") (:commit . "917cdd86cce06d74235ba0084422341b860e1569") (:revdesc . "917cdd86cce0") (:keywords "matching" "files" "completion") (:maintainers ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainer "Daniel Mendler" . "mail@daniel-mendler.de"))]) (consult-ag . [(20230227 406) ((emacs (27 1)) (consult (0 32))) "The silver searcher integration using Consult" tar ((:url . "https://github.com/yadex205/consult-ag") (:commit . "9eb4df265aedf2628a714610c2ade6d2f21de053") (:revdesc . "9eb4df265aed") (:authors ("Kanon Kakuno and contributors" . "yadex205@outlook.jp")) (:maintainers ("Kanon Kakuno and contributors" . "yadex205@outlook.jp")) (:maintainer "Kanon Kakuno and contributors" . "yadex205@outlook.jp"))]) (consult-codesearch . [(20230315 1424) ((emacs (27 1)) (consult (0 20))) "Consult interface for codesearch" tar ((:url . "https://github.com/youngker/consult-codesearch.el") (:commit . "51df545bb57b468058245950322ae15f6c3a0ce2") (:revdesc . "51df545bb57b") (:keywords "tools") (:authors ("Youngjoo Lee" . "youngker@gmail.com")) (:maintainers ("Youngjoo Lee" . "youngker@gmail.com")) (:maintainer "Youngjoo Lee" . "youngker@gmail.com"))]) (consult-company . [(20230606 1824) ((emacs (27 1)) (company (0 9)) (consult (0 9))) "Consult frontend for company" tar ((:url . "https://github.com/mohkale/consult-company") (:commit . "6e309fa9115c9ecd29aa27bff4e3b733979e5dbc") (:revdesc . "6e309fa9115c") (:authors ("mohsin kaleem" . "mohkale@kisara.moe")) (:maintainers ("mohsin kaleem" . "mohkale@kisara.moe")) (:maintainer "mohsin kaleem" . "mohkale@kisara.moe"))]) @@ -801,7 +802,7 @@ (consult-org-roam . [(20240217 1442) ((emacs (27 1)) (org-roam (2 2 0)) (consult (0 16))) "Consult integration for org-roam" tar ((:url . "https://github.com/jgru/consult-org-roam") (:commit . "a6dec09dcd06a3014409044399c4f8860ca45ef1") (:revdesc . "a6dec09dcd06") (:authors ("jgru" . "https://github.com/jgru")) (:maintainers ("jgru" . "https://github.com/jgru")) (:maintainer "jgru" . "https://github.com/jgru"))]) (consult-project-extra . [(20231221 1857) ((emacs (27 1)) (consult (0 17)) (project (0 8 1))) "Consult integration for project.el" tar ((:url . "https://github.com/Qkessler/consult-project-extra") (:commit . "982e8008d69ea6733a2a7548e245d645c0fefb3f") (:revdesc . "982e8008d69e") (:keywords "convenience" "project" "management"))]) (consult-projectile . [(20230821 406) ((emacs (25 1)) (consult (0 12)) (projectile (2 5 0))) "Consult integration for projectile" tar ((:url . "https://gitlab.com/OlMon/consult-projectile") (:commit . "400439c56d17bca7888f7d143d8a11f84900a406") (:revdesc . "400439c56d17") (:keywords "convenience"))]) - (consult-recoll . [(20231211 1221) ((emacs (26 1)) (consult (0 19))) "Recoll queries using consult" tar ((:url . "https://codeberg.org/jao/consult-recoll") (:commit . "ba68d052d9479aeaa5dda15a57a2c070df7d9bca") (:revdesc . "ba68d052d947") (:keywords "docs" "convenience") (:authors ("Jose A Ortega Ruiz" . "jao@gnu.org")) (:maintainers ("Jose A Ortega Ruiz" . "jao@gnu.org")) (:maintainer "Jose A Ortega Ruiz" . "jao@gnu.org"))]) + (consult-recoll . [(20241119 1807) ((emacs (26 1)) (consult (0 19))) "Recoll queries using consult" tar ((:url . "https://codeberg.org/jao/consult-recoll") (:commit . "c81d40c70b73a7351d7a4591b14f222682b7a084") (:revdesc . "c81d40c70b73") (:keywords "docs" "convenience") (:authors ("Jose A Ortega Ruiz" . "jao@gnu.org")) (:maintainers ("Jose A Ortega Ruiz" . "jao@gnu.org")) (:maintainer "Jose A Ortega Ruiz" . "jao@gnu.org"))]) (consult-spotify . [(20211114 2258) ((emacs (26 1)) (consult (0 8)) (espotify (0 1))) "Spotify queries using consult" tar ((:url . "https://codeberg.org/jao/espotify") (:commit . "5c1dcf0182135cda4191d4ba206fe2f265100293") (:revdesc . "5c1dcf018213") (:keywords "multimedia") (:authors ("Jose A Ortega Ruiz" . "jao@gnu.org")))]) (consult-tex . [(20240808 1300) ((emacs (28 2)) (consult (0 35))) "Consult powered completion for tex" tar ((:url . "https://gitlab.com/titus.pinta/consult-tex") (:commit . "9df92b31a8e7ef253667229a4e05153ea13346de") (:revdesc . "9df92b31a8e7") (:keywords "consult" "tex" "latex") (:maintainers ("Titus Pinta" . "titus.pinta@gmail.com")) (:maintainer "Titus Pinta" . "titus.pinta@gmail.com"))]) (consult-todo . [(20241029 409) ((emacs (29 1)) (consult (0 35)) (hl-todo (3 1 2))) "Search hl-todo keywords in consult" tar ((:url . "https://github.com/liuyinz/consult-todo") (:commit . "bd67bca32a69bf09f137cacb01c0310da9e76575") (:revdesc . "bd67bca32a69") (:authors ("liuyinz" . "liuyinz@gmail.com")) (:maintainers ("liuyinz" . "liuyinz@gmail.com")) (:maintainer "liuyinz" . "liuyinz@gmail.com"))]) @@ -813,7 +814,7 @@ (control-mode . [(20160624 1710) nil "A \"control\" mode, similar to vim's \"normal\" mode" tar ((:url . "https://github.com/stephendavidmarsh/control-mode") (:commit . "6bf487144119b03f9cc54168f70e3d7d8d84e22b") (:revdesc . "6bf487144119") (:keywords "convenience" "emulations") (:authors ("Stephen Marsh" . "stephen.david.marsh@gmail.com")) (:maintainers ("Stephen Marsh" . "stephen.david.marsh@gmail.com")) (:maintainer "Stephen Marsh" . "stephen.david.marsh@gmail.com"))]) (conventional-changelog . [(20230902 815) ((emacs (26 3)) (transient (0 4 1))) "Conventional Changelog Generator" tar ((:url . "https://github.com/liuyinz/emacs-conventional-changelog") (:commit . "97778186ff529a487d7fb0fc20d199d26ef70f5c") (:revdesc . "97778186ff52") (:keywords "tools") (:authors ("liuyinz" . "liuyinz95@gmail.com")) (:maintainers ("liuyinz" . "liuyinz95@gmail.com")) (:maintainer "liuyinz" . "liuyinz95@gmail.com"))]) (cool-mode . [(20231026 456) ((emacs (25))) "Major mode for cool compiler language" tar ((:url . "https://github.com/nverno/cool-mode") (:commit . "46b6a38a99a954c5e77e90506eafec4092690692") (:revdesc . "46b6a38a99a9") (:authors ("Noah Peart" . "noah.v.peart@gmail.com")) (:maintainers ("Noah Peart" . "noah.v.peart@gmail.com")) (:maintainer "Noah Peart" . "noah.v.peart@gmail.com"))]) - (copilot-chat . [(20241114 1226) ((request (0 3 2)) (markdown-mode (2 6)) (emacs (27 1)) (chatgpt-shell (1 6 1)) (magit (4 0 0))) "Copilot chat interface" tar ((:url . "https://github.com/chep/copilot-chat.el") (:commit . "d0bf1751a67cea931d732af1ee9bcc63bd1faaf6") (:revdesc . "d0bf1751a67c") (:keywords "convenience" "tools") (:authors ("cedric.chepied" . "cedric.chepied@gmail.com")) (:maintainers ("cedric.chepied" . "cedric.chepied@gmail.com")) (:maintainer "cedric.chepied" . "cedric.chepied@gmail.com"))]) + (copilot-chat . [(20241118 1209) ((request (0 3 2)) (markdown-mode (2 6)) (emacs (27 1)) (chatgpt-shell (1 6 1)) (magit (4 0 0))) "Copilot chat interface" tar ((:url . "https://github.com/chep/copilot-chat.el") (:commit . "d2f3ef17d755d8920c747ee5677db5b003a13406") (:revdesc . "d2f3ef17d755") (:keywords "convenience" "tools") (:authors ("cedric.chepied" . "cedric.chepied@gmail.com")) (:maintainers ("cedric.chepied" . "cedric.chepied@gmail.com")) (:maintainer "cedric.chepied" . "cedric.chepied@gmail.com"))]) (copy-as-format . [(20231112 1710) ((cl-lib (0 5))) "Copy buffer locations as GitHub/Slack/JIRA etc... formatted code" tar ((:url . "https://github.com/sshaw/copy-as-format") (:commit . "b9f6f725ca9701c5a02bfb479573fdfcce2e1e30") (:revdesc . "b9f6f725ca97") (:keywords "github" "slack" "jira" "telegram" "gitlab" "bitbucket" "org-mode" "pod" "rst" "asciidoc" "whatsapp" "tools" "convenience") (:authors ("Skye Shaw" . "skye.shaw@gmail.com")) (:maintainers ("Skye Shaw" . "skye.shaw@gmail.com")) (:maintainer "Skye Shaw" . "skye.shaw@gmail.com"))]) (copy-file-on-save . [(20230402 1829) ((emacs (24 3)) (compat (29))) "Copy file on save, automatic deployment it" tar ((:url . "https://github.com/emacs-php/emacs-auto-deployment") (:commit . "370b1586feb2690d3c72185bd4f17c31ce03673a") (:revdesc . "370b1586feb2") (:keywords "files" "comm" "deploy") (:authors ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainers ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainer "USAMI Kenta" . "tadsan@zonu.me"))]) (copyit . [(20241030 543) ((emacs (24 3)) (s (1 9 0))) "Copy it, yank anything!" tar ((:url . "https://github.com/zonuexe/emacs-copyit") (:commit . "09556ba8407dc2b132b7f76cd1b458c0773a1fe8") (:revdesc . "09556ba8407d") (:keywords "convenience" "yank" "clipboard") (:authors ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainers ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainer "USAMI Kenta" . "tadsan@zonu.me"))]) @@ -929,7 +930,7 @@ (daemons . [(20231212 1324) ((emacs (25 1)) (s (1 13 0)) (compat (29 1 4 2))) "UI for managing init system daemons (services)" tar ((:url . "https://github.com/cbowdon/daemons.el") (:commit . "6b6b97b7bac3040cfc58ea5ca7bd9dc9003068fb") (:revdesc . "6b6b97b7bac3") (:keywords "unix" "convenience"))]) (dakrone-light-theme . [(20170808 2140) nil "Dakrone's custom light theme" tar ((:url . "https://github.com/dakrone/dakrone-light-theme") (:commit . "06f198dc8b4ca7421990b30a23d89c8e0b8c5de4") (:revdesc . "06f198dc8b4c") (:keywords "color" "themes" "faces") (:authors ("Lee Hinman" . "lee_AT_writequit.org")) (:maintainers ("Lee Hinman" . "lee_AT_writequit.org")) (:maintainer "Lee Hinman" . "lee_AT_writequit.org"))]) (dakrone-theme . [(20170801 1933) nil "Dakrone's custom dark theme" tar ((:url . "https://github.com/dakrone/dakrone-theme") (:commit . "232ad1be5f3572dcbdf528f1655109aa355a6937") (:revdesc . "232ad1be5f35") (:keywords "color" "themes") (:authors ("Lee Hinman" . "lee_AT_writequit.org")) (:maintainers ("Lee Hinman" . "lee_AT_writequit.org")) (:maintainer "Lee Hinman" . "lee_AT_writequit.org"))]) - (dall-e-shell . [(20241112 1928) ((emacs (27 1)) (shell-maker (0 61 1))) "Interaction mode for DALL-E" tar ((:url . "https://github.com/xenodium/dall-e-shell") (:commit . "11d318a4ac37e6a5077ea4d66ddaa144f448cd14") (:revdesc . "11d318a4ac37"))]) + (dall-e-shell . [(20241118 1015) ((emacs (27 1)) (shell-maker (0 67 1))) "Interaction mode for DALL-E" tar ((:url . "https://github.com/xenodium/dall-e-shell") (:commit . "d7f54f002c9271bc46c7403af898ed12e3abea69") (:revdesc . "d7f54f002c92"))]) (daml-lsp . [(20231101 1818) ((daml-mode (1 0)) (dash (2 18 0)) (f (0 20 0)) (ht (2 3)) (lsp-mode (7 0))) "LSP client definition for daml" tar ((:url . "https://github.com/bartfailt/daml-lsp") (:commit . "26ea6a1b34c49aaa5a2b395a0468c8af710bfab7") (:revdesc . "26ea6a1b34c4"))]) (daml-mode . [(20231106 916) ((emacs (27 1)) (haskell-mode (16 1))) "Major mode for daml" tar ((:url . "https://github.com/bartfailt/daml-mode") (:commit . "3ba1166edd4c22402996625b1f8a05a2d5b1cbc6") (:revdesc . "3ba1166edd4c"))]) (danneskjold-theme . [(20241114 749) nil "Beautiful high-contrast Emacs theme" tar ((:url . "https://github.com/rails-to-cosmos/danneskjold-theme") (:commit . "96c000887d5bf7be17ff315c939bb7c8c962b86a") (:revdesc . "96c000887d5b") (:authors ("Dmitry Akatov" . "akatovda@yandex.com")) (:maintainers ("Dmitry Akatov" . "akatovda@yandex.com")) (:maintainer "Dmitry Akatov" . "akatovda@yandex.com"))]) @@ -1102,6 +1103,7 @@ (dispass . [(20140202 1531) ((dash (1 0 0))) "Emacs wrapper for DisPass" tar ((:url . "https://github.com/ryuslash/dispass.el") (:commit . "b6e8f89040ebaaf0e7609b04bc27a8979f0ae861") (:revdesc . "b6e8f89040eb") (:keywords "processes") (:authors ("Tom Willemsen" . "tom@ryuslash.org")) (:maintainers ("Tom Willemsen" . "tom@ryuslash.org")) (:maintainer "Tom Willemsen" . "tom@ryuslash.org"))]) (display-theme . [(20140115 1556) ((emacs (24))) "Display current theme(s) at mode-line" tar ((:url . "https://github.com/kawabata/emacs-display-theme") (:commit . "b180b3be7a74ae4799a14e7e4bc2fe10e3ff7a15") (:revdesc . "b180b3be7a74") (:keywords "tools") (:authors ("Taichi" . "kawabata.taichi_at_gmail.com")) (:maintainers ("Taichi" . "kawabata.taichi_at_gmail.com")) (:maintainer "Taichi" . "kawabata.taichi_at_gmail.com"))]) (display-wttr . [(20221102 1426) ((emacs (27 1))) "Display wttr(weather) in the mode line" tar ((:url . "https://git.sr.ht/~josegpt/display-wttr") (:commit . "7062953d034e27c297d58748cf74dad552aa2873") (:revdesc . "7062953d034e") (:authors ("Jose G Perez Taveras" . "josegpt27@gmail.com")) (:maintainers ("Jose G Perez Taveras" . "josegpt27@gmail.com")) (:maintainer "Jose G Perez Taveras" . "josegpt27@gmail.com"))]) + (disproject . [(20241120 654) ((emacs (29 4)) (transient (0 7 8))) "Dispatch project commands with Transient" tar ((:url . "https://github.com/aurtzy/disproject") (:commit . "cdde9bd1c32dc99f9ea4a42741f242c99dd4570e") (:revdesc . "cdde9bd1c32d") (:keywords "convenience" "files" "vc") (:authors ("aurtzy" . "aurtzy@gmail.com")) (:maintainers ("aurtzy" . "aurtzy@gmail.com")) (:maintainer "aurtzy" . "aurtzy@gmail.com"))]) (dispwatch . [(20210305 342) ((emacs (24 4))) "Watch displays for configuration changes" tar ((:url . "https://github.com/mnp/dispwatch") (:commit . "03abbac89a9f625aaa1a808dd49ae4906f466421") (:revdesc . "03abbac89a9f") (:keywords "frames") (:authors ("Mitchell Perilstein" . "mitchell.perilstein@gmail.com")) (:maintainers ("Mitchell Perilstein" . "mitchell.perilstein@gmail.com")) (:maintainer "Mitchell Perilstein" . "mitchell.perilstein@gmail.com"))]) (dist-file-mode . [(20240107 2040) ((emacs (26))) "Dispatch major mode for *.dist files" tar ((:url . "https://github.com/emacs-php/dist-file-mode.el") (:commit . "8bb2f05487164cd690cac9c9c442969f6f79b81f") (:revdesc . "8bb2f0548716") (:keywords "files" "convenience") (:authors ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainers ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainer "USAMI Kenta" . "tadsan@zonu.me"))]) (distel-completion-lib . [(20180827 1344) nil "Completion library for Erlang/Distel" tar ((:url . "https://github.com/sebastiw/distel-completion") (:commit . "acc4c0a5521904203d797fe96b08e5fae4233c7e") (:revdesc . "acc4c0a55219") (:keywords "erlang" "distel" "completion"))]) @@ -1145,7 +1147,7 @@ (doom . [(20180301 2308) ((cl-lib (0 5))) "DOM implementation and manipulation library" tar ((:url . "https://github.com/kensanata/doom") (:commit . "e59040aefc92dd9b3134eb623624307fb9e4327b") (:revdesc . "e59040aefc92") (:keywords "xml" "dom") (:authors ("Alex Schroeder" . "alex@gnu.org") ("Henrik.Motakef" . "elisp@henrik-motakef.de") ("Katherine Whitlock" . "toroidal-code@gmail.com") ("Syohei YOSHIDA" . "syohex@gmail.com")))]) (doom-modeline . [(20241117 1101) ((emacs (25 1)) (compat (29 1 4 5)) (nerd-icons (0 1 0)) (shrink-path (0 3 1))) "A minimal and modern mode-line" tar ((:url . "https://github.com/seagle0128/doom-modeline") (:commit . "e6ae2ecfea9b5dd26191e131382a7505f7a775b9") (:revdesc . "e6ae2ecfea9b") (:keywords "faces" "mode-line") (:authors ("Vincent Zhang" . "seagle0128@gmail.com")) (:maintainers ("Vincent Zhang" . "seagle0128@gmail.com")) (:maintainer "Vincent Zhang" . "seagle0128@gmail.com"))]) (doom-modeline-now-playing . [(20240522 1704) ((emacs (24 4)) (doom-modeline (3 0 0)) (async (1 9 3))) "Segment for Doom Modeline to show playerctl information" tar ((:url . "https://github.com/elken/doom-modeline-now-playing") (:commit . "1532f324f98a234aa14e12ebdfd17cebba978d6a") (:revdesc . "1532f324f98a") (:authors ("Ellis Kenyő" . "me@elken.dev")) (:maintainers ("Ellis Kenyő" . "me@elken.dev")) (:maintainer "Ellis Kenyő" . "me@elken.dev"))]) - (doom-themes . [(20240909 2117) ((emacs (25 1)) (cl-lib (0 5))) "An opinionated pack of modern color-themes" tar ((:url . "https://github.com/doomemacs/themes") (:commit . "1cac71a4b2434036496a49b4440fdba3d0b5b387") (:revdesc . "1cac71a4b243") (:keywords "themes" "faces") (:authors ("Henrik Lissner" . "contact@henrik.io")) (:maintainers ("Henrik Lissner" . "contact@henrik.io")) (:maintainer "Henrik Lissner" . "contact@henrik.io"))]) + (doom-themes . [(20241120 157) ((emacs (25 1)) (cl-lib (0 5))) "An opinionated pack of modern color-themes" tar ((:url . "https://github.com/doomemacs/themes") (:commit . "3c03f525d5c0ac0859f31231778f97e10a705e0d") (:revdesc . "3c03f525d5c0") (:keywords "themes" "faces") (:authors ("Henrik Lissner" . "contact@henrik.io")) (:maintainers ("Henrik Lissner" . "contact@henrik.io")) (:maintainer "Henrik Lissner" . "contact@henrik.io"))]) (dot-env . [(20230820 2014) ((emacs (24 4)) (s (1 13 0))) "Dotenv functionality" tar ((:url . "https://github.com/amodelbello/dot-env.el") (:commit . "83ce690e8ef9175fc621c85d5fbef4f7ace7b7a8") (:revdesc . "83ce690e8ef9") (:keywords "convenience" "dotenv" "environment" "configuration"))]) (dot-mode . [(20180312 2300) ((emacs (24 3))) "Minor mode to repeat typing or commands" tar ((:url . "https://github.com/wyrickre/dot-mode") (:commit . "6ca22b73bcdae2363ee9641b822a60685df16a3e") (:revdesc . "6ca22b73bcda") (:keywords "convenience") (:authors ("Robert Wyrick" . "rob@wyrick.org")) (:maintainers ("Robert Wyrick" . "rob@wyrick.org")) (:maintainer "Robert Wyrick" . "rob@wyrick.org"))]) (dotenv-mode . [(20191027 2129) ((emacs (24 3))) "Major mode for .env files" tar ((:url . "https://github.com/preetpalS/emacs-dotenv-mode") (:commit . "e3701bf739bde44f6484eb7753deadaf691b73fb") (:revdesc . "e3701bf739bd"))]) @@ -1168,7 +1170,7 @@ (dropbox . [(20220314 1638) ((request (0 3 0)) (json (1 2)) (oauth (1 0 3))) "Emacs backend for dropbox" tar ((:url . "https://github.com/pavpanchekha/dropbox.el") (:commit . "c048faad0be24e8fa31974f08b710a87cf5b668c") (:revdesc . "c048faad0be2") (:keywords "dropbox") (:authors ("Pavel Panchekha" . "me@pavpanchekha.com")) (:maintainers ("Pavel Panchekha" . "me@pavpanchekha.com")) (:maintainer "Pavel Panchekha" . "me@pavpanchekha.com"))]) (drupal-mode . [(20240816 1236) ((php-mode (1 5 0))) "Advanced minor mode for Drupal development" tar ((:url . "https://github.com/arnested/drupal-mode") (:commit . "3f91d1d44df11ebd0137a896055fca6a1bb2f554") (:revdesc . "3f91d1d44df1") (:keywords "programming" "php" "drupal") (:authors ("Arne Jørgensen" . "arne@arnested.dk")) (:maintainers ("Arne Jørgensen" . "arne@arnested.dk")) (:maintainer "Arne Jørgensen" . "arne@arnested.dk"))]) (drupal-spell . [(20130520 1655) nil "Aspell extra dictionary for Drupal" tar ((:url . "https://github.com/arnested/drupal-spell") (:commit . "a69f5e3b62c4c0da74ce26c1d00d5b8f7395e4ae") (:revdesc . "a69f5e3b62c4") (:keywords "wp") (:authors ("Arne Jørgensen" . "arne@arnested.dk")) (:maintainers ("Arne Jørgensen" . "arne@arnested.dk")) (:maintainer "Arne Jørgensen" . "arne@arnested.dk"))]) - (dslide . [(20241021 439) ((emacs (29 2))) "Domain Specific sLIDEs. A presentation framework" tar ((:url . "https://github.com/positron-solutions/dslide") (:commit . "84b4b8c7476a27a461a0e176b8b5c206ab5d28ea") (:revdesc . "84b4b8c7476a") (:keywords "convenience" "org-mode" "presentation" "narrowing") (:authors ("Positron" . "contact@positron.solutions")) (:maintainers ("Positron" . "contact@positron.solutions")) (:maintainer "Positron" . "contact@positron.solutions"))]) + (dslide . [(20241119 859) ((emacs (29 2))) "Domain Specific sLIDEs. A presentation framework" tar ((:url . "https://github.com/positron-solutions/dslide") (:commit . "4209916697c74f196be6834edfa01a25da597444") (:revdesc . "4209916697c7") (:keywords "convenience" "org-mode" "presentation" "narrowing") (:authors ("Positron" . "contact@positron.solutions")) (:maintainers ("Positron" . "contact@positron.solutions")) (:maintainer "Positron" . "contact@positron.solutions"))]) (dsvn . [(20221102 1416) nil "Subversion interface" tar ((:url . "https://github.com/emacsmirror/dsvn") (:commit . "36ecd5219584e46dcf6bd252e2ea1ec517d2fc05") (:revdesc . "36ecd5219584") (:keywords "docs") (:authors ("David Kågedal" . "davidk@lysator.liu.se") ("Mattias Engdegård" . "mattiase@acm.org")) (:maintainers ("Mattias Engdegård" . "mattiase@acm.org")) (:maintainer "Mattias Engdegård" . "mattiase@acm.org"))]) (dtb-mode . [(20210105 1132) ((emacs (25))) "Show device tree souce in dtbs" tar ((:url . "https://github.com/schspa/dtb-mode") (:commit . "d5bca7d1afaac5615c586b60c7314a1d0e2514dc") (:revdesc . "d5bca7d1afaa") (:keywords "dtb" "dts" "convenience") (:authors ("Schspa Shi" . "schspa@gmail.com")) (:maintainers ("Schspa Shi" . "schspa@gmail.com")) (:maintainer "Schspa Shi" . "schspa@gmail.com"))]) (dtext-mode . [(20231120 1606) ((emacs (24 4))) "Major mode for Danbooru DText" tar ((:url . "https://github.com/JohnDevlopment/dtext-mode.el") (:commit . "5c68d1c05c4606f68384569d9baaef4f6e72fc73") (:revdesc . "5c68d1c05c46") (:keywords "languages") (:authors ("John Russell" . "johndevlopment7@gmail.com")) (:maintainers ("John Russell" . "johndevlopment7@gmail.com")) (:maintainer "John Russell" . "johndevlopment7@gmail.com"))]) @@ -1210,7 +1212,7 @@ (eacl . [(20220526 1434) ((emacs (25 1))) "Auto-complete lines by grepping project" tar ((:url . "https://github.com/redguardtoo/eacl") (:commit . "4fe2cafbfeb73d806ebea8801c3522ff2886f30b") (:revdesc . "4fe2cafbfeb7") (:keywords "abbrev" "convenience" "matching") (:authors ("Chen Bin" . "chenbinDOTshATgmailDOTcom")) (:maintainers ("Chen Bin" . "chenbinDOTshATgmailDOTcom")) (:maintainer "Chen Bin" . "chenbinDOTshATgmailDOTcom"))]) (earl . [(20241020 1847) ((emacs (29 1))) "Erlang distribution protocol implementation" tar ((:url . "https://github.com/axelf4/earl") (:commit . "aa10aae9891a599f523f269cc391ed316775d12a") (:revdesc . "aa10aae9891a") (:keywords "comm" "extensions" "languages" "processes") (:authors ("Axel Forsman" . "axel@axelf.se")) (:maintainers ("Axel Forsman" . "axel@axelf.se")) (:maintainer "Axel Forsman" . "axel@axelf.se"))]) (earthfile-mode . [(20230809 2250) ((emacs (26))) "Major mode for editing Earthly file" tar ((:url . "https://github.com/earthly/earthly-emacs") (:commit . "3029e5ab06171ca5947041e95053561e10e5ba41") (:revdesc . "3029e5ab0617") (:authors ("Thanabodee Charoenpiriyakij" . "wingyminus@gmail.com")) (:maintainers ("Thanabodee Charoenpiriyakij" . "wingyminus@gmail.com")) (:maintainer "Thanabodee Charoenpiriyakij" . "wingyminus@gmail.com"))]) - (eask . [(20241114 423) ((emacs (26 1))) "Core Eask APIs, for Eask CLI development" tar ((:url . "https://github.com/emacs-eask/eask") (:commit . "d449538ab8d5783d22dc84680c6f27b273cb4478") (:revdesc . "d449538ab8d5") (:keywords "lisp" "eask" "api") (:authors ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Jen-Chieh" . "jcs090218@gmail.com"))]) + (eask . [(20241117 1929) ((emacs (26 1))) "Core Eask APIs, for Eask CLI development" tar ((:url . "https://github.com/emacs-eask/eask") (:commit . "79eef0a2d94f5f6880baa90fde50b885a71e2d2c") (:revdesc . "79eef0a2d94f") (:keywords "lisp" "eask" "api") (:authors ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Jen-Chieh" . "jcs090218@gmail.com"))]) (eask-mode . [(20240101 819) ((emacs (24 3)) (eask (0 1 0))) "Major mode for editing Eask files" tar ((:url . "https://github.com/emacs-eask/eask-mode") (:commit . "774bf05f2d778a107f27f8fa47034ad15f16395c") (:revdesc . "774bf05f2d77") (:keywords "lisp" "eask") (:authors ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Jen-Chieh" . "jcs090218@gmail.com"))]) (easky . [(20240608 744) ((emacs (27 1)) (eask-mode (0 1 0)) (eask (0 1 0)) (ansi (0 4 1)) (lv (0 0)) (marquee-header (0 1 0))) "Control the Eask command-line interface" tar ((:url . "https://github.com/emacs-eask/easky") (:commit . "d75ec4865742a4939bd685360f8ec5b076bdcf77") (:revdesc . "d75ec4865742") (:keywords "maint" "easky") (:authors ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Jen-Chieh" . "jcs090218@gmail.com"))]) (easy-after-load . [(20170817 1231) nil "Eval-after-load for all files in a directory" tar ((:url . "https://github.com/pd/easy-after-load") (:commit . "29e20145da49ac9ea40463c552130777408040de") (:revdesc . "29e20145da49"))]) @@ -1220,7 +1222,7 @@ (easy-kill . [(20220511 557) ((emacs (25)) (cl-lib (0 5))) "Kill & mark things easily" tar ((:url . "https://github.com/leoliu/easy-kill") (:commit . "de7d66c3c864a4722a973ee9bc228a14be49ba0c") (:revdesc . "de7d66c3c864") (:keywords "killing" "convenience") (:authors ("Leo Liu" . "sdl.web@gmail.com")) (:maintainers ("Leo Liu" . "sdl.web@gmail.com")) (:maintainer "Leo Liu" . "sdl.web@gmail.com"))]) (easy-kill-extras . [(20240122 1649) ((easy-kill (0 9 4))) "Extra functions for easy-kill" tar ((:url . "https://github.com/knu/easy-kill-extras.el") (:commit . "6ec0a1ff47aee681f7aa7af4250ede75815385f2") (:revdesc . "6ec0a1ff47ae") (:keywords "killing" "convenience") (:authors ("Akinori MUSHA" . "knu@iDaemons.org")) (:maintainers ("Akinori MUSHA" . "knu@iDaemons.org")) (:maintainer "Akinori MUSHA" . "knu@iDaemons.org"))]) (easy-repeat . [(20150516 848) ((emacs (24 4))) "Repeat easily" tar ((:url . "https://github.com/xuchunyang/easy-repeat.el") (:commit . "060f0e6801c82c40c06961dc0528a00e18947a8c") (:revdesc . "060f0e6801c8") (:keywords "repeat" "convenience") (:authors ("Chunyang Xu" . "xuchunyang56@gmail.com")) (:maintainers ("Chunyang Xu" . "xuchunyang56@gmail.com")) (:maintainer "Chunyang Xu" . "xuchunyang56@gmail.com"))]) - (easysession . [(20241115 1449) ((emacs (25 1)) (f (0 18 2))) "Easily persist and restore your editing sessions" tar ((:url . "https://github.com/jamescherti/easysession.el") (:commit . "991653e2ee64e03c7790b789343c74b60f337004") (:revdesc . "991653e2ee64") (:keywords "convenience"))]) + (easysession . [(20241118 1601) ((emacs (25 1)) (f (0 18 2))) "Easily persist and restore your editing sessions" tar ((:url . "https://github.com/jamescherti/easysession.el") (:commit . "157f2d2130280720190198f74b850e228348ffaa") (:revdesc . "157f2d213028") (:keywords "convenience"))]) (ebdb-mua-sidecar . [(20240428 1852) ((emacs (28 1)) (universal-sidecar (1 5 1)) (ebdb (0 8 20))) "EBDB Integration for Universal Sidecar" tar ((:url . "https://git.sr.ht/~swflint/emacs-universal-sidecar") (:commit . "4c78015d10caba9c700e6e6b582004ae1c1d5344") (:revdesc . "4c78015d10ca") (:keywords "mail" "convenience") (:authors ("Samuel W. Flint" . "me@samuelwflint.com")) (:maintainers ("Samuel W. Flint" . "me@samuelwflint.com")) (:maintainer "Samuel W. Flint" . "me@samuelwflint.com"))]) (ebf . [(20210225 1211) ((dash (2 18 0)) (cl-lib (0 5))) "Brainfuck language transpiler to Emacs Lisp" tar ((:url . "https://github.com/rexim/ebf") (:commit . "6cbeb4d62416f4cfd5be8906667342af8ecc44a6") (:revdesc . "6cbeb4d62416") (:authors ("Alexey Kutepov" . "reximkut@gmail.com")) (:maintainers ("Alexey Kutepov" . "reximkut@gmail.com")) (:maintainer "Alexey Kutepov" . "reximkut@gmail.com"))]) (ebib . [(20241109 2340) ((parsebib (6 0)) (emacs (27 1)) (compat (29 1 4 3))) "A BibTeX database manager" tar ((:url . "https://github.com/joostkremers/ebib") (:commit . "5dac71546bb8541ee67104c17df6fc3ae5e364db") (:revdesc . "5dac71546bb8") (:keywords "text" "bibtex") (:authors ("Joost Kremers" . "joostkremers@fastmail.fm")) (:maintainers ("Joost Kremers" . "joostkremers@fastmail.fm")) (:maintainer "Joost Kremers" . "joostkremers@fastmail.fm"))]) @@ -1255,7 +1257,7 @@ (editorconfig-generate . [(20190513 433) ((emacs (24))) "Generate .editorconfig" tar ((:url . "https://github.com/10sr/editorconfig-generate-el") (:commit . "47a31f928f46d2a0188db8e2cffa5d6354a81573") (:revdesc . "47a31f928f46") (:keywords "tools") (:authors ("10sr" . "8.slashes@gmail.com")) (:maintainers ("10sr" . "8.slashes@gmail.com")) (:maintainer "10sr" . "8.slashes@gmail.com"))]) (edn . [(20160215 1219) ((cl-lib (0 3)) (emacs (24 1)) (peg (0 6))) "Support for reading and writing the edn data format from elisp" tar ((:url . "https://github.com/expez/edn.el") (:commit . "be9e32d1b49e35247b263b0243df7cfdc8d413ab") (:revdesc . "be9e32d1b49e") (:keywords "edn" "clojure") (:authors ("Lars Andersen" . "expez@expez.com")) (:maintainers ("Lars Andersen" . "expez@expez.com")) (:maintainer "Lars Andersen" . "expez@expez.com"))]) (ednc . [(20240209 2028) ((emacs (26 1))) "Emacs Desktop Notification Center" tar ((:url . "https://github.com/sinic/ednc") (:commit . "2580ada68ecc93aa693c61f997c9cf581698242e") (:revdesc . "2580ada68ecc") (:keywords "unix") (:authors ("Simon Nicolussi" . "sinic@sinic.name")) (:maintainers ("Simon Nicolussi" . "sinic@sinic.name")) (:maintainer "Simon Nicolussi" . "sinic@sinic.name"))]) - (edts-mode . [(20230926 2146) nil "EDTS setup and configuration" tar ((:url . "https://github.com/sebastiw/edts") (:commit . "5c3cded3fab56baa60874f4e1efd14155cec587f") (:revdesc . "5c3cded3fab5") (:keywords "erlang") (:authors ("Thomas Järvstrand" . "thomas.jarvstrand@gmail.com")) (:maintainers ("Thomas Järvstrand" . "thomas.jarvstrand@gmail.com")) (:maintainer "Thomas Järvstrand" . "thomas.jarvstrand@gmail.com"))]) + (edts . [(20230926 2146) ((auto-complete (20201213 1255)) (auto-highlight-symbol (20211106 638)) (dash (20210609 1330)) (emacs (24 3)) (erlang (20210315 1640)) (f (20191110 1357)) (popup (20210317 138)) (s (20210603 736))) "Erlang Development Tool Suite" tar ((:url . "https://github.com/sebastiw/edts") (:commit . "5c3cded3fab56baa60874f4e1efd14155cec587f") (:revdesc . "5c3cded3fab5"))]) (edwina . [(20221206 1610) ((emacs (25))) "Dynamic window manager" tar ((:url . "https://gitlab.com/ajgrf/edwina") (:commit . "f95c31b1de95df7e83338a5d4daf3363df325862") (:revdesc . "f95c31b1de95") (:keywords "convenience") (:authors ("Alex Griffin" . "a@ajgrf.com")) (:maintainers ("Alex Griffin" . "a@ajgrf.com")) (:maintainer "Alex Griffin" . "a@ajgrf.com"))]) (efar . [(20230216 1213) ((emacs (26 1))) "FAR-like file manager" tar ((:url . "https://github.com/suntsov/efar") (:commit . "78618a6cd9fe7d46c3728db3589d1fe50f7c1c6b") (:revdesc . "78618a6cd9fe") (:keywords "files") (:authors ("Vladimir Suntsov" . "vladimir@suntsov.online")) (:maintainers (nil . "vladimir@suntsov.online")) (:maintainer nil . "vladimir@suntsov.online"))]) (eff . [(20240708 231) ((emacs (28))) "Show symbols in Executable File Formats" tar ((:url . "https://github.com/oxidase/eff") (:commit . "b8298439360b29333d3dcd8a352e00cde2b6ccd7") (:revdesc . "b8298439360b") (:keywords "elf" "readelf" "convenience"))]) @@ -1278,14 +1280,14 @@ (eink-theme . [(20190219 858) nil "E Ink color theme" tar ((:url . "https://github.com/maio/eink-emacs") (:commit . "326b07523dcb076d6209cdbc7fdbb73df296dbdb") (:revdesc . "326b07523dcb") (:authors ("Marian Schubert" . "marian.schubert@gmail.com")) (:maintainers ("Marian Schubert" . "marian.schubert@gmail.com")) (:maintainer "Marian Schubert" . "marian.schubert@gmail.com"))]) (ejc-sql . [(20241111 117) ((emacs (26 3)) (clomacs (0 0 5)) (dash (2 16 0)) (spinner (1 7 3))) "Emacs SQL client uses Clojure JDBC" tar ((:url . "https://gitlab.com/kostafey/ejc-sql") (:commit . "1fc5a38d974aed401424ecd3b49a74e0a0ebc3bb") (:revdesc . "1fc5a38d974a") (:keywords "sql" "jdbc") (:authors ("Kostafey" . "kostafey@gmail.com")) (:maintainers ("Kostafey" . "kostafey@gmail.com")) (:maintainer "Kostafey" . "kostafey@gmail.com"))]) (ejson-mode . [(20190720 2138) ((emacs (25))) "Major mode for editing ejson files" tar ((:url . "https://github.com/dantecatalfamo/ejson-mode") (:commit . "9630dfac9549779711dbe89e621f516bb4b3a354") (:revdesc . "9630dfac9549") (:keywords "convenience" "languages" "tools"))]) - (ekg . [(20241025 456) ((triples (0 4 0)) (emacs (28 1)) (llm (0 17 0))) "A system for recording and linking information" tar ((:url . "https://github.com/ahyatt/ekg") (:commit . "981606fd5c2cefdb5ec34982fcaf7a1a10f80287") (:revdesc . "981606fd5c2c") (:keywords "outlines" "hypermedia") (:authors ("Andrew Hyatt" . "ahyatt@gmail.com")) (:maintainers ("Andrew Hyatt" . "ahyatt@gmail.com")) (:maintainer "Andrew Hyatt" . "ahyatt@gmail.com"))]) + (ekg . [(20241118 224) ((triples (0 4 0)) (emacs (28 1)) (llm (0 18 0))) "A system for recording and linking information" tar ((:url . "https://github.com/ahyatt/ekg") (:commit . "942457bb75574f17058cba1da25e46aeee3fde4b") (:revdesc . "942457bb7557") (:keywords "outlines" "hypermedia") (:authors ("Andrew Hyatt" . "ahyatt@gmail.com")) (:maintainers ("Andrew Hyatt" . "ahyatt@gmail.com")) (:maintainer "Andrew Hyatt" . "ahyatt@gmail.com"))]) (el-autoyas . [(20120918 1317) nil "Automatically create Emacs-Lisp Yasnippets" tar ((:url . "https://github.com/mattfidler/el-autoyas.el") (:commit . "bde0251ecb504f585dfa27c205c8e312655310cc") (:revdesc . "bde0251ecb50") (:keywords "emacs" "lisp" "mode" "yasnippet"))]) (el-fetch . [(20230624 2) ((emacs (25 1))) "Show system information in Neofetch-like style (eg CPU, RAM)" tar ((:url . "https://gitlab.com/xgqt/emacs-el-fetch") (:commit . "7907fd7829ca55b21a62d23c17066fdfde9cd07c") (:revdesc . "7907fd7829ca") (:keywords "games") (:authors ("Maciej Barć" . "xgqt@riseup.net")) (:maintainers ("Maciej Barć" . "xgqt@riseup.net")) (:maintainer "Maciej Barć" . "xgqt@riseup.net"))]) (el-fly-indent-mode . [(20180422 243) ((emacs (25))) "Indent Emacs Lisp on the fly" tar ((:url . "https://github.com/jiahaoli95/el-fly-indent-mode.el") (:commit . "1dd4b907ff4d9581c18b4e38e8719e83ba0dace1") (:revdesc . "1dd4b907ff4d") (:keywords "lisp" "languages") (:authors ("Jiahao Li" . "jiahaowork@gmail.com")) (:maintainers ("Jiahao Li" . "jiahaowork@gmail.com")) (:maintainer "Jiahao Li" . "jiahaowork@gmail.com"))]) (el-get . [(20240408 837) nil "Manage the external elisp bits and pieces you depend upon" tar ((:url . "https://github.com/dimitri/el-get") (:commit . "1c5b0eb7fa162523183a96e409e4e3ae6b5cc3a0") (:revdesc . "1c5b0eb7fa16") (:keywords "emacs" "package" "elisp" "install" "elpa" "git" "git-svn" "bzr" "cvs" "svn" "darcs" "hg" "apt-get" "fink" "pacman" "http" "http-tar" "emacswiki") (:authors ("Dimitri Fontaine" . "dim@tapoueh.org")) (:maintainers ("Dimitri Fontaine" . "dim@tapoueh.org")) (:maintainer "Dimitri Fontaine" . "dim@tapoueh.org"))]) (el-init . [(20150728 920) ((emacs (24)) (cl-lib (0 5)) (anaphora (1 0 0))) "A loader inspired by init-loader" tar ((:url . "https://github.com/HKey/el-init") (:commit . "25fd21d820bca1cf576b8f70c8d5a3bc76792597") (:revdesc . "25fd21d820bc") (:authors ("Hiroki YAMAKAWA" . "s06139@gmail.com")) (:maintainers ("Hiroki YAMAKAWA" . "s06139@gmail.com")) (:maintainer "Hiroki YAMAKAWA" . "s06139@gmail.com"))]) (el-init-viewer . [(20150303 828) ((emacs (24)) (cl-lib (0 5)) (ctable (0 1 2)) (dash (2 10 0)) (anaphora (1 0 0)) (el-init (0 1 4))) "Record viewer for el-init" tar ((:url . "https://github.com/HKey/el-init-viewer") (:commit . "c40417db7808c8b8c9b2f196a69de5da7eee84a2") (:revdesc . "c40417db7808") (:authors ("Hiroki YAMAKAWA" . "s06139@gmail.com")) (:maintainers ("Hiroki YAMAKAWA" . "s06139@gmail.com")) (:maintainer "Hiroki YAMAKAWA" . "s06139@gmail.com"))]) - (el-job . [(20241114 2235) ((emacs (28 1)) (compat (30))) "Call a function using all CPU cores" tar ((:url . "https://github.com/meedstrom/el-job") (:commit . "32ea3c18394ef56bb61c4699c02038122160ea3a") (:revdesc . "32ea3c18394e") (:keywords "processes") (:authors ("Martin Edström" . "meedstrom91@gmail.com")) (:maintainers ("Martin Edström" . "meedstrom91@gmail.com")) (:maintainer "Martin Edström" . "meedstrom91@gmail.com"))]) + (el-job . [(20241119 1918) ((emacs (28 1)) (compat (30))) "Call a function using all CPU cores" tar ((:url . "https://github.com/meedstrom/el-job") (:commit . "c1d9aec762c7ca571ec61a6cbf581279bbb8ee67") (:revdesc . "c1d9aec762c7") (:keywords "processes") (:authors ("Martin Edström" . "meedstrom91@gmail.com")) (:maintainers ("Martin Edström" . "meedstrom91@gmail.com")) (:maintainer "Martin Edström" . "meedstrom91@gmail.com"))]) (el-mock . [(20220625 1949) nil "Tiny Mock and Stub framework in Emacs Lisp" tar ((:url . "https://github.com/rejeep/el-mock.el") (:commit . "6cfbc9de8f1927295dca6864907fe4156bd71910") (:revdesc . "6cfbc9de8f19") (:keywords "lisp" "testing" "unittest") (:authors ("rubikitch" . "rubikitch@ruby-lang.org")) (:maintainers ("Johan Andersson" . "johan.rejeep@gmail.com")) (:maintainer "Johan Andersson" . "johan.rejeep@gmail.com"))]) (el-patch . [(20231123 2216) ((emacs (26))) "Future-proof your Elisp" tar ((:url . "https://github.com/radian-software/el-patch") (:commit . "92803e7ea6e07cd56667ed7ea0dfacfc1f37f6d9") (:revdesc . "92803e7ea6e0") (:keywords "extensions") (:authors ("Radian LLC" . "contact+el-patch@radian.codes")) (:maintainers ("Radian LLC" . "contact+el-patch@radian.codes")) (:maintainer "Radian LLC" . "contact+el-patch@radian.codes"))]) (el-secretario . [(20220426 1905) ((emacs (27 1)) (org-ql (0 6 -1)) (hercules (0 3))) "Unify all your inboxes with the Emacs secretary" tar ((:url . "https://git.sr.ht/~zetagon/el-secretario") (:commit . "575396ca689065188ad0f90c379d9bcf7ff6fc0b") (:revdesc . "575396ca6890") (:keywords "convenience") (:authors ("Leo Okawa Ericson" . "http://github/Zetagon")) (:maintainers ("Leo" . "github@relevant-information.com")) (:maintainer "Leo" . "github@relevant-information.com"))]) @@ -1353,7 +1355,7 @@ (elixir-mode . [(20230626 1738) ((emacs (25))) "Major mode for editing Elixir files" tar ((:url . "https://github.com/elixir-editors/emacs-elixir") (:commit . "00d6580a040a750e019218f9392cf9a4c2dac23a") (:revdesc . "00d6580a040a") (:keywords "languages" "elixir"))]) (elixir-ts-mode . [(20240820 947) ((emacs (29 1)) (heex-ts-mode (1 3))) "Major mode for Elixir with tree-sitter support" tar ((:url . "https://github.com/wkirschbaum/elixir-ts-mode") (:commit . "b35c983f551ccf821ebebad50747b5b417133e52") (:revdesc . "b35c983f551c") (:keywords "elixir" "languages" "tree-sitter"))]) (elixir-yasnippets . [(20150417 1239) ((yasnippet (0 8 0))) "Yasnippets for Elixir" tar ((:url . "https://github.com/hisea/elixir-yasnippets") (:commit . "980ca7626c14ef0573bec0035ec7942796062783") (:revdesc . "980ca7626c14") (:keywords "snippets") (:authors ("Yinghai Zhao" . "zyinghai@gmail.com")) (:maintainers ("Yinghai Zhao" . "zyinghai@gmail.com")) (:maintainer "Yinghai Zhao" . "zyinghai@gmail.com"))]) - (ellama . [(20241025 2349) ((emacs (28 1)) (llm (0 6 0)) (spinner (1 7 4)) (transient (0 7 6)) (compat (29 1))) "Tool for interacting with LLMs" tar ((:url . "https://github.com/s-kostyaev/ellama") (:commit . "882b0b241c2f69124edce70d41dc95ff49cb40e8") (:revdesc . "882b0b241c2f") (:keywords "help" "local" "tools") (:authors ("Sergey Kostyaev" . "sskostyaev@gmail.com")) (:maintainers ("Sergey Kostyaev" . "sskostyaev@gmail.com")) (:maintainer "Sergey Kostyaev" . "sskostyaev@gmail.com"))]) + (ellama . [(20241118 1307) ((emacs (28 1)) (llm (0 6 0)) (spinner (1 7 4)) (transient (0 7 6)) (compat (29 1))) "Tool for interacting with LLMs" tar ((:url . "https://github.com/s-kostyaev/ellama") (:commit . "e8f64969d66aa71341804e0a4f8d3e7c632bf3b6") (:revdesc . "e8f64969d66a") (:keywords "help" "local" "tools") (:authors ("Sergey Kostyaev" . "sskostyaev@gmail.com")) (:maintainers ("Sergey Kostyaev" . "sskostyaev@gmail.com")) (:maintainer "Sergey Kostyaev" . "sskostyaev@gmail.com"))]) (ellocate . [(20200112 1931) ((emacs (25 1)) (s (1 12 0)) (f (0 20 0))) "The locate command reimplemented in Emacs Lisp" tar ((:url . "https://github.com/walseb/ellocate") (:commit . "81405082f68f0577c9f176d3d4f034a7142aba59") (:revdesc . "81405082f68f") (:keywords "matching") (:authors ("Sebastian Wålinder" . "s.walinder@gmail.com")) (:maintainers ("Sebastian Wålinder" . "s.walinder@gmail.com")) (:maintainer "Sebastian Wålinder" . "s.walinder@gmail.com"))]) (elm-mode . [(20230315 1122) ((f (0 17)) (s (1 7 0)) (emacs (25 1)) (seq (2 23)) (reformatter (0 3))) "Major mode for Elm" tar ((:url . "https://github.com/jcollard/elm-mode") (:commit . "699841865e1bd5b7f2077baa7121510b6bcad3c7") (:revdesc . "699841865e1b"))]) (elm-test-runner . [(20230905 331) ((emacs (24 4))) "Enhanced support for running elm-test" tar ((:url . "https://github.com/juanedi/elm-test-runner") (:commit . "b664e50a4c849f5f2e2f434fc01718da10515612") (:revdesc . "b664e50a4c84"))]) @@ -1388,9 +1390,9 @@ (elx . [(20240805 1311) ((emacs (26 1)) (compat (30 0 0 0)) (llama (0 3 1))) "Extract information from Emacs Lisp libraries" tar ((:url . "https://github.com/emacscollective/elx") (:commit . "be1afda54a182c726d7f0c584b2ac4854384ffda") (:revdesc . "be1afda54a18") (:keywords "docs" "libraries" "packages") (:authors ("Jonas Bernoulli" . "emacs.elx@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.elx@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.elx@jonas.bernoulli.dev"))]) (elysium . [(20241102 2222) ((emacs (27 1)) (gptel (0 9 0))) "Automatically apply LLM-created code-suggestions" tar ((:url . "https://github.com/lanceberge/elysium") (:commit . "dcb194e0e49e2c1864e0fa2ccec3d7e37b0a44b6") (:revdesc . "dcb194e0e49e") (:authors ("Lance Bergeron" . "bergeron.lance6@gmail.com")) (:maintainers ("Lance Bergeron" . "bergeron.lance6@gmail.com")) (:maintainer "Lance Bergeron" . "bergeron.lance6@gmail.com"))]) (emacs-everywhere . [(20240509 1715) ((emacs (26 3))) "System-wide popup windows for quick edits" tar ((:url . "https://github.com/tecosaur/emacs-everywhere") (:commit . "0b731ca6da351ba40953d090acf69e81757d437b") (:revdesc . "0b731ca6da35") (:keywords "convenience" "frames") (:authors ("TEC" . "https://github.com/tecosaur")) (:maintainers ("TEC" . "contact@tecosaur.net")) (:maintainer "TEC" . "contact@tecosaur.net"))]) - (emacsc . [(20240629 1325) nil "Helper for emacsc(1)" tar ((:url . "https://github.com/knu/emacsc") (:commit . "49b0bbbcd021424da4000bf47193bd2d928b2228") (:revdesc . "49b0bbbcd021") (:keywords "tools") (:authors ("Akinori MUSHA" . "knu@iDaemons.org")) (:maintainers ("Akinori MUSHA" . "knu@iDaemons.org")) (:maintainer "Akinori MUSHA" . "knu@iDaemons.org"))]) + (emacsc . [(20241119 1435) nil "Helper for emacsc(1)" tar ((:url . "https://github.com/knu/emacsc") (:commit . "0868b7f52adae264fb79e10e57a7481632eee76e") (:revdesc . "0868b7f52ada") (:keywords "tools") (:authors ("Akinori MUSHA" . "knu@iDaemons.org")) (:maintainers ("Akinori MUSHA" . "knu@iDaemons.org")) (:maintainer "Akinori MUSHA" . "knu@iDaemons.org"))]) (emacsist-view . [(20160426 1223) nil "Mode for viewing emacsist.com" tar ((:url . "https://github.com/lujun9972/emacsist-view") (:commit . "f67761259ed779a9bc95c9a4e0474522990c5c6b") (:revdesc . "f67761259ed7") (:keywords "convenience" "usability") (:authors ("DarkSun" . "lujun9972@gmail.com")) (:maintainers ("DarkSun" . "lujun9972@gmail.com")) (:maintainer "DarkSun" . "lujun9972@gmail.com"))]) - (emacsql . [(20241116 1523) ((emacs (26 1))) "High-level SQL database front-end" tar ((:url . "https://github.com/magit/emacsql") (:commit . "8ebf559f58fdeba53d23e80562181fb67917942e") (:revdesc . "8ebf559f58fd") (:authors ("Christopher Wellons" . "wellons@nullprogram.com")) (:maintainers ("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev"))]) + (emacsql . [(20241117 2114) ((emacs (26 1))) "High-level SQL database front-end" tar ((:url . "https://github.com/magit/emacsql") (:commit . "c8fceaf236fc4b68e95160e0d4161a3e50a670ad") (:revdesc . "c8fceaf236fc") (:authors ("Christopher Wellons" . "wellons@nullprogram.com")) (:maintainers ("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev"))]) (emacsshot . [(20191206 944) ((emacs (24 4))) "Snapshot a frame or window from within" tar ((:url . "https://gitlab.com/marcowahl/emacsshot") (:commit . "fe958b11056f3c671ebdd604d5aa574323284ca5") (:revdesc . "fe958b11056f") (:keywords "convenience") (:authors ("Marco Wahl" . "marcowahlsoft@gmail.com")))]) (emamux . [(20200315 1220) ((emacs (24 3))) "Interact with tmux" tar ((:url . "https://github.com/emacsorphanage/emamux") (:commit . "6172131d78038f0b1490e24bac60534bf4ad3b30") (:revdesc . "6172131d7803") (:authors ("Syohei YOSHIDA" . "syohex@gmail.com")) (:maintainers ("Syohei YOSHIDA" . "syohex@gmail.com")) (:maintainer "Syohei YOSHIDA" . "syohex@gmail.com"))]) (emamux-ruby-test . [(20130812 1639) ((emamux (0 1)) (projectile (0 9 1))) "Ruby test with emamux" tar ((:url . "https://github.com/emacsorphanage/emamux-ruby-test") (:commit . "785bfd44d097a46bb2ebe1e62ac7595fd4dc9ab5") (:revdesc . "785bfd44d097"))]) @@ -1434,7 +1436,7 @@ (eno . [(20191013 1239) ((dash (2 12 1)) (edit-at-point (1 0))) "Goto/copy/cut any word/symbol/line in view, similar to ace-jump/easymotion" tar ((:url . "https://github.com/emacsattic/eno") (:commit . "c5c6193687c0bede1ddf507c430cf8b0a6d272d9") (:revdesc . "c5c6193687c0") (:authors (nil . "e.enoson@gmail.com")) (:maintainers (nil . "e.enoson@gmail.com")) (:maintainer nil . "e.enoson@gmail.com"))]) (enotify . [(20130407 1348) nil "A networked notification system for emacs" tar ((:url . "https://github.com/laynor/enotify") (:commit . "7fd2f48ef4ff32c8f013c634ea2dd6b1d1409f80") (:revdesc . "7fd2f48ef4ff") (:keywords "tools") (:authors ("Alessandro Piras" . "laynor@gmail.com")) (:maintainers ("Alessandro Piras" . "laynor@gmail.com")) (:maintainer "Alessandro Piras" . "laynor@gmail.com"))]) (environ . [(20230518 1310) ((emacs (24 1)) (dash (2 17 0)) (f (0 20 0)) (s (1 12 0))) "API for environment variables and env files" tar ((:url . "https://github.com/cfclrk/environ") (:commit . "9530e2f1ead5bd37aca4d298514800f73b3cc0a7") (:revdesc . "9530e2f1ead5") (:keywords "tools") (:authors ("Chris Clark" . "cfclrk@gmail.com")) (:maintainers ("Chris Clark" . "cfclrk@gmail.com")) (:maintainer "Chris Clark" . "cfclrk@gmail.com"))]) - (envrc . [(20240613 907) ((emacs (26 1)) (inheritenv (0 1))) "Support for `direnv' that operates buffer-locally" tar ((:url . "https://github.com/purcell/envrc") (:commit . "2316e004c1574234fe4d991bd75a254cdeaa83ae") (:revdesc . "2316e004c157") (:keywords "processes" "tools") (:authors ("Steve Purcell" . "steve@sanityinc.com")) (:maintainers ("Steve Purcell" . "steve@sanityinc.com")) (:maintainer "Steve Purcell" . "steve@sanityinc.com"))]) + (envrc . [(20241118 1700) ((emacs (26 1)) (inheritenv (0 1)) (seq (2 24))) "Support for `direnv' that operates buffer-locally" tar ((:url . "https://github.com/purcell/envrc") (:commit . "9bbe723eb0749b66da0dead9d7eb49aa62a36bb9") (:revdesc . "9bbe723eb074") (:keywords "processes" "tools") (:authors ("Steve Purcell" . "steve@sanityinc.com")) (:maintainers ("Steve Purcell" . "steve@sanityinc.com")) (:maintainer "Steve Purcell" . "steve@sanityinc.com"))]) (eopengrok . [(20230114 1413) ((s (1 9 0)) (dash (2 10 0)) (magit (2 1 0)) (cl-lib (0 5))) "Opengrok interface for emacs" tar ((:url . "https://github.com/youngker/eopengrok.el") (:commit . "83b1695774f8bdc322e528ade9dffe9b2e93f32a") (:revdesc . "83b1695774f8") (:keywords "tools") (:authors ("Youngjoo Lee" . "youngker@gmail.com")) (:maintainers ("Youngjoo Lee" . "youngker@gmail.com")) (:maintainer "Youngjoo Lee" . "youngker@gmail.com"))]) (epc . [(20140610 534) ((concurrent (0 3 1)) (ctable (0 1 2))) "A RPC stack for the Emacs Lisp" tar ((:url . "https://github.com/kiwanami/emacs-epc") (:commit . "94cd36a3bec752263ac9b1b3a9dd2def329d2af7") (:revdesc . "94cd36a3bec7") (:keywords "lisp" "rpc") (:authors ("SAKURAI Masashi" . "m.sakuraiatkiwanami.net")) (:maintainers ("SAKURAI Masashi" . "m.sakuraiatkiwanami.net")) (:maintainer "SAKURAI Masashi" . "m.sakuraiatkiwanami.net"))]) (epic . [(20170210 23) ((htmlize (1 47))) "Evernote Picker for Cocoa Emacs" tar ((:url . "https://github.com/yoshinari-nomura/epic") (:commit . "a41826c330eb0ea061d58a08cc861b0c4ac8ec4e") (:revdesc . "a41826c330eb") (:keywords "evernote" "applescript") (:authors ("Yoshinari Nomura" . "nom@quickhack.net")) (:maintainers ("Yoshinari Nomura" . "nom@quickhack.net")) (:maintainer "Yoshinari Nomura" . "nom@quickhack.net"))]) @@ -1516,7 +1518,7 @@ (espy . [(20200317 2333) ((emacs (24))) "Emacs Simple Password Yielder" tar ((:url . "https://github.com/walseb/espy") (:commit . "2c01be937a5e5bde62921684a0b27300705fb4e0") (:revdesc . "2c01be937a5e") (:keywords "convenience") (:authors ("Sebastian Wålinder" . "s.walinder@gmail.com")) (:maintainers ("Sebastian Wålinder" . "s.walinder@gmail.com")) (:maintainer "Sebastian Wålinder" . "s.walinder@gmail.com"))]) (esqlite . [(20151206 1206) ((pcsv (1 3 3))) "Manipulate sqlite file from Emacs" tar ((:url . "https://github.com/mhayashi1120/Emacs-esqlite") (:commit . "fae9826cbc255b0f0686a801288f1441bda5f631") (:revdesc . "fae9826cbc25") (:keywords "data") (:authors ("Masahiro Hayashi" . "mhayashi1120@gmail.com")) (:maintainers ("Masahiro Hayashi" . "mhayashi1120@gmail.com")) (:maintainer "Masahiro Hayashi" . "mhayashi1120@gmail.com"))]) (esqlite-helm . [(20151116 850) ((esqlite (0 2 0)) (helm (20131207 845))) "Define helm source for sqlite database" tar ((:url . "https://github.com/mhayashi1120/Emacs-esqlite") (:commit . "84d5b16198f30949c544affba751ee0d58a000d9") (:revdesc . "84d5b16198f3") (:keywords "data") (:authors ("Masahiro Hayashi" . "mhayashi1120@gmail.com")) (:maintainers ("Masahiro Hayashi" . "mhayashi1120@gmail.com")) (:maintainer "Masahiro Hayashi" . "mhayashi1120@gmail.com"))]) - (ess . [(20241106 2028) ((emacs (25 1))) "Emacs Speaks Statistics" tar ((:url . "https://github.com/emacs-ess/ESS") (:commit . "461bd6bee440b92c2dcddd64965eeabbdcc65e31") (:revdesc . "461bd6bee440") (:authors ("David Smith" . "dsmith@stats.adelaide.edu.au") ("A.J. Rossini" . "blindglobe@gmail.com") ("Richard M. Heiberger" . "rmh@temple.edu") ("Kurt Hornik" . "Kurt.Hornik@R-project.org") ("Martin Maechler" . "maechler@stat.math.ethz.ch") ("Rodney A. Sparapani" . "rsparapa@mcw.edu") ("Stephen Eglen" . "stephen@gnu.org") ("Sebastian P. Luque" . "spluque@gmail.com") ("Henning Redestig" . "henning.red@googlemail.com") ("Vitalie Spinu" . "spinuvit@gmail.com") ("Lionel Henry" . "lionel.hry@gmail.com") ("J. Alexander Branham" . "alex.branham@gmail.com")) (:maintainers ("ESS Core Team" . "ESS-core@r-project.org")) (:maintainer "ESS Core Team" . "ESS-core@r-project.org"))]) + (ess . [(20241119 2023) ((emacs (25 1))) "Emacs Speaks Statistics" tar ((:url . "https://github.com/emacs-ess/ESS") (:commit . "dbebca483e7386fa5c17505ab444c817f6926bd4") (:revdesc . "dbebca483e73") (:authors ("David Smith" . "dsmith@stats.adelaide.edu.au") ("A.J. Rossini" . "blindglobe@gmail.com") ("Richard M. Heiberger" . "rmh@temple.edu") ("Kurt Hornik" . "Kurt.Hornik@R-project.org") ("Martin Maechler" . "maechler@stat.math.ethz.ch") ("Rodney A. Sparapani" . "rsparapa@mcw.edu") ("Stephen Eglen" . "stephen@gnu.org") ("Sebastian P. Luque" . "spluque@gmail.com") ("Henning Redestig" . "henning.red@googlemail.com") ("Vitalie Spinu" . "spinuvit@gmail.com") ("Lionel Henry" . "lionel.hry@gmail.com") ("J. Alexander Branham" . "alex.branham@gmail.com")) (:maintainers ("ESS Core Team" . "ESS-core@r-project.org")) (:maintainer "ESS Core Team" . "ESS-core@r-project.org"))]) (ess-R-data-view . [(20130509 1158) ((ctable (20130313 1743)) (popup (20130324 1305)) (ess (20130225 1754))) "Data viewer for GNU R" tar ((:url . "https://github.com/myuhe/ess-R-data-view.el") (:commit . "d6e98d3ae1e2a2ea39a56eebcdb73e99d29562e9") (:revdesc . "d6e98d3ae1e2") (:keywords "convenience") (:authors ("myuhe" . "yuhei.maeda_at_gmail.com")))]) (ess-r-insert-obj . [(20220610 1406) ((emacs (26 1)) (ess (18 10 1))) "Insert objects in ESS-R" tar ((:url . "https://github.com/ShuguangSun/ess-r-insert-obj") (:commit . "2ded9c23d0af2a7f6c0e02f9ea4af0e5b3cb7fb4") (:revdesc . "2ded9c23d0af") (:keywords "tools") (:authors ("Shuguang Sun" . "shuguang79@qq.com")) (:maintainers ("Shuguang Sun" . "shuguang79@qq.com")) (:maintainer "Shuguang Sun" . "shuguang79@qq.com"))]) (ess-smart-equals . [(20210411 1333) ((emacs (25 1)) (ess (18 10))) "Flexible, context-sensitive assignment key for R/S" tar ((:url . "https://github.com/genovese/ess-smart-equals") (:commit . "fea9eea4b59c3e9559b379508e3500076ca99ef1") (:revdesc . "fea9eea4b59c") (:keywords "r" "s" "ess" "convenience") (:authors ("Christopher R. Genovese" . "genovese@cmu.edu")) (:maintainers ("Christopher R. Genovese" . "genovese@cmu.edu")) (:maintainer "Christopher R. Genovese" . "genovese@cmu.edu"))]) @@ -1541,6 +1543,7 @@ (evalator-clojure . [(20160208 2148) ((cider (0 10 0)) (evalator (1 0 0))) "Clojure evaluation context for evalator via CIDER" tar ((:url . "https://github.com/seanirby/evalator-clojure") (:commit . "caa4e0a137bdfada86593128a654e16aa617ad50") (:revdesc . "caa4e0a137bd") (:keywords "languages" "clojure" "cider" "helm") (:maintainers ("Sean Irby" . "sean.t.irby@gmail.com")) (:maintainer "Sean Irby" . "sean.t.irby@gmail.com"))]) (evangelion-theme . [(20241116 1036) ((emacs (27 1))) "A dark colour scheme inspired by Neon Genesis Evangelion" tar ((:url . "https://github.com/crmsnbleyd/evangelion-theme") (:commit . "89577330e93f1c11b3e75d1c8bbae6accc18fc48") (:revdesc . "89577330e93f") (:keywords "faces" "theme") (:authors ("Andrew Jose" . "mail@drewsh.com")) (:maintainers ("Andrew Jose" . "mail@drewsh.com")) (:maintainer "Andrew Jose" . "mail@drewsh.com"))]) (eve-mode . [(20170822 2231) ((emacs (25)) (polymode (1 0)) (markdown-mode (2 0))) "Major mode for editing Eve documents" tar ((:url . "https://github.com/witheve/emacs-eve-mode") (:commit . "a4661114d9c18725691b76321d72167ca5a9070a") (:revdesc . "a4661114d9c1") (:keywords "languages" "wp" "tools") (:authors ("Joshua Cole" . "joshuafcole@gmail.com")) (:maintainers ("Joshua Cole" . "joshuafcole@gmail.com")) (:maintainer "Joshua Cole" . "joshuafcole@gmail.com"))]) + (evedel . [(20241114 11) ((emacs (29 1)) (gptel (0 9 0))) "Instructed LLM programmer/assistant" tar ((:url . "https://github.com/daedsidog/evedel") (:commit . "0e6faec72903e1fd541c416883696309aa300ced") (:revdesc . "0e6faec72903") (:keywords "convenience" "tools") (:authors ("daedsidog" . "contact@daedsidog.com")) (:maintainers ("daedsidog" . "contact@daedsidog.com")) (:maintainer "daedsidog" . "contact@daedsidog.com"))]) (evenok . [(20241031 2134) ((emacs (28 1))) "Themes with perceptively evenly distributed colors" tar ((:url . "https://codeberg.org/mekeor/evenok") (:commit . "06a84eea4cf9a845266f8bde68abe25d85bd2b77") (:revdesc . "06a84eea4cf9") (:keywords "faces" "theme") (:authors ("Mekeor Melire" . "mekeor@posteo.de")) (:maintainers ("Mekeor Melire" . "mekeor@posteo.de")) (:maintainer "Mekeor Melire" . "mekeor@posteo.de"))]) (everlasting-scratch . [(20240612 814) ((emacs (25 1))) "The *scratch* that lasts forever" tar ((:url . "https://github.com/beacoder/everlasting-scratch") (:commit . "fa1b2af29e8bb463400bbea912ab4dfaa2b0c890") (:revdesc . "fa1b2af29e8b") (:keywords "convenience" "tool") (:authors ("Huming Chen" . "chenhuming@gmail.com")) (:maintainers ("Huming Chen" . "chenhuming@gmail.com")) (:maintainer "Huming Chen" . "chenhuming@gmail.com"))]) (evil . [(20241006 1754) ((emacs (24 1)) (cl-lib (0 5)) (goto-chg (1 6)) (nadvice (0 3))) "Extensible vi layer" tar ((:url . "https://github.com/emacs-evil/evil") (:commit . "b7ab3840dbfc1da5f9ad56542fc94e3dab4be5f1") (:revdesc . "b7ab3840dbfc") (:keywords "emulations") (:maintainers ("Tom Dalziel" . "tom.dalziel@gmail.com")) (:maintainer "Tom Dalziel" . "tom.dalziel@gmail.com"))]) @@ -1571,7 +1574,7 @@ (evil-indent-textobject . [(20130831 2219) ((evil (0))) "Evil textobjects based on indentation" tar ((:url . "https://github.com/cofi/evil-indent-textobject") (:commit . "70a1154a531b7cfdbb9a31d6922482791e20a3a7") (:revdesc . "70a1154a531b") (:keywords "convenience" "evil") (:authors ("Michael Markert" . "markert.michael@gmail.com")) (:maintainers ("Michael Markert" . "markert.michael@gmail.com")) (:maintainer "Michael Markert" . "markert.michael@gmail.com"))]) (evil-leader . [(20140606 1243) ((evil (0))) "Let there be <leader>" tar ((:url . "https://github.com/cofi/evil-leader") (:commit . "39f7014bcf8b36463e0c7512c638bda4bac6c2cf") (:revdesc . "39f7014bcf8b") (:keywords "evil" "vim-emulation" "leader") (:authors ("Michael Markert" . "markert.michael@googlemail.com")) (:maintainers ("Michael Markert" . "markert.michael@googlemail.com")) (:maintainer "Michael Markert" . "markert.michael@googlemail.com"))]) (evil-ledger . [(20180802 1612) ((emacs (24 4)) (evil (1 2 12)) (ledger-mode (0))) "Make `ledger-mode' more `evil'" tar ((:url . "https://github.com/atheriel/evil-ledger") (:commit . "7a9f9f5d39c42fffdba8004f8982642351f2b233") (:revdesc . "7a9f9f5d39c4") (:keywords "convenience" "evil" "languages" "ledger" "vim-emulation") (:authors ("Aaron Jacobs" . "atheriel@gmail.com")) (:maintainers ("Aaron Jacobs" . "atheriel@gmail.com")) (:maintainer "Aaron Jacobs" . "atheriel@gmail.com"))]) - (evil-lion . [(20220317 1030) ((emacs (24 3)) (evil (1 0 0))) "Evil align operator, port of vim-lion" tar ((:url . "https://github.com/edkolev/evil-lion") (:commit . "4da660e124731ed65e7aaa6c067c30e876619429") (:revdesc . "4da660e12473") (:keywords "emulations" "evil" "vim") (:authors ("edkolev" . "evgenysw@gmail.com")) (:maintainers ("edkolev" . "evgenysw@gmail.com")) (:maintainer "edkolev" . "evgenysw@gmail.com"))]) + (evil-lion . [(20241119 1044) ((emacs (24 3)) (evil (1 0 0))) "Evil align operator, port of vim-lion" tar ((:url . "https://github.com/edkolev/evil-lion") (:commit . "88bf528c5e79b4a7cc28525865824ad737a4b954") (:revdesc . "88bf528c5e79") (:keywords "emulations" "evil" "vim") (:authors ("edkolev" . "evgenysw@gmail.com")) (:maintainers ("edkolev" . "evgenysw@gmail.com")) (:maintainer "edkolev" . "evgenysw@gmail.com"))]) (evil-lisp-state . [(20160404 248) ((evil (1 0 9)) (bind-map (0)) (smartparens (1 6 1))) "An evil state to edit Lisp code" tar ((:url . "https://github.com/syl20bnr/evil-lisp-state") (:commit . "3c65fecd9917a41eaf6460f22187e2323821f3ce") (:revdesc . "3c65fecd9917") (:keywords "convenience" "editing" "evil" "smartparens" "lisp" "mnemonic") (:authors ("Sylvain Benner" . "sylvain.benner@gmail.com")) (:maintainers ("Sylvain Benner" . "sylvain.benner@gmail.com")) (:maintainer "Sylvain Benner" . "sylvain.benner@gmail.com"))]) (evil-lispops . [(20240428 1356) ((emacs (26 1)) (evil (1 2 10))) "Operations for editing lisp evilly" tar ((:url . "https://github.com/precompute/evil-lispops") (:commit . "372b52df1a45fcea6c9461e7909cfdbb1db822a9") (:revdesc . "372b52df1a45") (:authors ("precompute" . "git@precompute.net")) (:maintainers ("precompute" . "git@precompute.net")) (:maintainer "precompute" . "git@precompute.net"))]) (evil-lispy . [(20190502 739) ((lispy (0 26 0)) (evil (1 2 12)) (hydra (0 13 5))) "Precision Lisp editing with Evil and Lispy" tar ((:url . "https://github.com/mikavilpas/evil-lispy") (:commit . "ed317f7fccbdbeea8aa04a91b1b1f48a0e2ddc4e") (:revdesc . "ed317f7fccbd") (:keywords "lisp") (:authors ("Brandon Carrell" . "brandoncarrell@gmail.com") ("Mika Vilpas" . "mika.vilpas@gmail.com")) (:maintainers ("Brandon Carrell" . "brandoncarrell@gmail.com") ("Mika Vilpas" . "mika.vilpas@gmail.com")) (:maintainer "Brandon Carrell" . "brandoncarrell@gmail.com"))]) @@ -1614,7 +1617,7 @@ (evil-textobj-entire . [(20150422 1254) ((emacs (24)) (evil (1 0 0))) "Text object for entire lines of buffer for evil" tar ((:url . "https://github.com/supermomonga/evil-textobj-entire") (:commit . "5b3a98f3a69edc3a788f539f6ffef4a0ef5e853d") (:revdesc . "5b3a98f3a69e") (:keywords "convenience" "emulations"))]) (evil-textobj-line . [(20211101 1429) ((evil (1 0 0))) "Line text object for Evil" tar ((:url . "https://github.com/emacsorphanage/evil-textobj-line") (:commit . "9eaf9a5485c2b5c05e16552b34632ca520cd681d") (:revdesc . "9eaf9a5485c2") (:authors ("Syohei YOSHIDA" . "syohex@gmail.com")) (:maintainers ("Syohei YOSHIDA" . "syohex@gmail.com")) (:maintainer "Syohei YOSHIDA" . "syohex@gmail.com"))]) (evil-textobj-syntax . [(20231119 1633) ((emacs (24)) (evil (0))) "Provides syntax text objects" tar ((:url . "https://github.com/laishulu/evil-textobj-syntax") (:commit . "64252ded690a2e65b71a1c84aa3acd24e704d02f") (:revdesc . "64252ded690a") (:keywords "evil" "syntax" "highlight" "text-object"))]) - (evil-textobj-tree-sitter . [(20240829 247) ((emacs (25 1))) "Provides evil textobjects using tree-sitter" tar ((:url . "https://github.com/meain/evil-textobj-tree-sitter") (:commit . "b4ef204ff80ed00b03cf8839ee29101ed867dd58") (:revdesc . "b4ef204ff80e") (:keywords "evil" "tree-sitter" "text-object" "convenience"))]) + (evil-textobj-tree-sitter . [(20241118 1711) ((emacs (25 1))) "Provides evil textobjects using tree-sitter" tar ((:url . "https://github.com/meain/evil-textobj-tree-sitter") (:commit . "bce236e5d2cc2fa4eae7d284ffd19ad18d46349a") (:revdesc . "bce236e5d2cc") (:keywords "evil" "tree-sitter" "text-object" "convenience"))]) (evil-traces . [(20230820 2255) ((emacs (25 1)) (evil (1 2 13))) "Visual hints for `evil-ex'" tar ((:url . "https://github.com/mamapanda/evil-traces") (:commit . "3b4e08c522d1a4c6f458ab5dc21914fd307333a1") (:revdesc . "3b4e08c522d1") (:keywords "emulations" "evil" "visual") (:authors ("Daniel Phan" . "daniel.phan36@gmail.com")) (:maintainers ("Daniel Phan" . "daniel.phan36@gmail.com")) (:maintainer "Daniel Phan" . "daniel.phan36@gmail.com"))]) (evil-tree-edit . [(20231206 1836) ((emacs (29 1)) (tree-edit (0 1 0)) (tree-sitter (0 15 0)) (evil (1 0 0)) (avy (0 5 0)) (s (0 0 0))) "Evil structural editing for any language!" tar ((:url . "https://github.com/ethan-leba/tree-edit") (:commit . "9e3635e3fd0449bf259d42ea29c93e46ef623fe7") (:revdesc . "9e3635e3fd04") (:authors ("Ethan Leba" . "ethanleba5@gmail.com")) (:maintainers ("Ethan Leba" . "ethanleba5@gmail.com")) (:maintainer "Ethan Leba" . "ethanleba5@gmail.com"))]) (evil-tutor . [(20150103 653) ((evil (1 0 9))) "Vimtutor adapted to Evil and wrapped in a major-mode" tar ((:url . "https://github.com/syl20bnr/evil-tutor") (:commit . "909273bac88b98a565f1b89bbb13d523b7edce2b") (:revdesc . "909273bac88b") (:keywords "convenience" "editing" "evil") (:authors ("Sylvain Benner" . "sylvain.benner@gmail.com")) (:maintainers ("Sylvain Benner" . "sylvain.benner@gmail.com")) (:maintainer "Sylvain Benner" . "sylvain.benner@gmail.com"))]) @@ -1815,7 +1818,7 @@ (flycheck-grammalecte . [(20230605 1035) ((emacs (26 1)) (flycheck (26))) "Integrate Grammalecte with Flycheck" tar ((:url . "https://git.umaneti.net/flycheck-grammalecte/") (:commit . "76aca865992d828af54d77c1cf9a70663747e080") (:revdesc . "76aca865992d") (:keywords "i18n" "text") (:authors ("Guilhem Doulcier" . "guilhem.doulcier@espci.fr") ("tienne Deparis" . "etienne@depar.is")) (:maintainers ("tienne Deparis" . "etienne@depar.is")) (:maintainer "tienne Deparis" . "etienne@depar.is"))]) (flycheck-grammarly . [(20240101 847) ((emacs (25 1)) (flycheck (0 14)) (grammarly (0 3 0)) (s (1 12 0))) "Grammarly support for Flycheck" tar ((:url . "https://github.com/emacs-grammarly/flycheck-grammarly") (:commit . "cb011efcc05b111bb4638cc42c24c5b11fc5f378") (:revdesc . "cb011efcc05b") (:keywords "convenience" "grammar" "check") (:authors ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Jen-Chieh" . "jcs090218@gmail.com"))]) (flycheck-guile . [(20230405 1154) ((emacs (25 1)) (flycheck (0 22)) (geiser (0 20))) "A Flycheck checker for GNU Guile" tar ((:url . "https://github.com/flatwhatson/flycheck-guile") (:commit . "dd7bbdc48fd21cf8d270c913c56cd580f8ec3d03") (:revdesc . "dd7bbdc48fd2") (:authors ("Ricardo Wurmus" . "rekado@elephly.net")) (:maintainers ("Andrew Whatson" . "whatson@tailcall.au")) (:maintainer "Andrew Whatson" . "whatson@tailcall.au"))]) - (flycheck-haskell . [(20230706 1439) ((emacs (24 3)) (flycheck (0 25)) (haskell-mode (13 7)) (dash (2 4 0)) (seq (1 11)) (let-alist (1 0 1))) "Flycheck: Automatic Haskell configuration" tar ((:url . "https://github.com/flycheck/flycheck-haskell") (:commit . "b7c4861aa754220b7d0cfc05aa0895bb35665683") (:revdesc . "b7c4861aa754") (:keywords "tools" "convenience") (:authors ("Sebastian Wiesner" . "swiesner@lunaryorn.com")) (:maintainers ("Sebastian Wiesner" . "swiesner@lunaryorn.com")) (:maintainer "Sebastian Wiesner" . "swiesner@lunaryorn.com"))]) + (flycheck-haskell . [(20241119 1046) ((emacs (24 3)) (flycheck (0 25)) (haskell-mode (13 7)) (dash (2 4 0)) (seq (1 11)) (let-alist (1 0 1))) "Flycheck: Automatic Haskell configuration" tar ((:url . "https://github.com/flycheck/flycheck-haskell") (:commit . "0977232112d02b9515e272ab85fe0eb9e07bbc50") (:revdesc . "0977232112d0") (:keywords "tools" "convenience") (:authors ("Sebastian Wiesner" . "swiesner@lunaryorn.com")) (:maintainers ("Sebastian Wiesner" . "swiesner@lunaryorn.com")) (:maintainer "Sebastian Wiesner" . "swiesner@lunaryorn.com"))]) (flycheck-hdevtools . [(20160926 702) ((flycheck (0 21 -4 1)) (dash (2 0))) "A flycheck checker for Haskell using hdevtools" tar ((:url . "https://github.com/flycheck/flycheck-hdevtools") (:commit . "53829f0c57800615718cfce27ffa16d8ba286cee") (:revdesc . "53829f0c5780") (:keywords "convenience" "languages" "tools") (:authors ("Steve Purcell" . "steve@sanityinc.com")) (:maintainers ("Steve Purcell" . "steve@sanityinc.com")) (:maintainer "Steve Purcell" . "steve@sanityinc.com"))]) (flycheck-hl-todo . [(20230807 1500) ((emacs (25 1)) (hl-todo (1 9 0)) (flycheck (0 14))) "Display hl-todo keywords in flycheck" tar ((:url . "https://github.com/alvarogonzalezsotillo/flycheck-hl-todo") (:commit . "16b66ea07e9d31950093ef0ff97d42b8e7ebf10f") (:revdesc . "16b66ea07e9d") (:keywords "convenience") (:authors ("lvaro González Sotillo" . "alvarogonzalezsotillo@gmail.com")) (:maintainers ("lvaro González Sotillo" . "alvarogonzalezsotillo@gmail.com")) (:maintainer "lvaro González Sotillo" . "alvarogonzalezsotillo@gmail.com"))]) (flycheck-hledger . [(20241029 1710) ((emacs (27 1)) (flycheck (31))) "Flycheck module to check hledger journals" tar ((:url . "https://github.com/DamienCassou/flycheck-hledger") (:commit . "66e12fce7d4875327bce06b2fc33043924c710ed") (:revdesc . "66e12fce7d48") (:authors ("Damien Cassou" . "damien@cassou.me")) (:maintainers ("Damien Cassou" . "damien@cassou.me")) (:maintainer "Damien Cassou" . "damien@cassou.me"))]) @@ -2016,7 +2019,7 @@ (fuo . [(20190812 927) ((emacs (24 4))) "Feeluown client" tar ((:url . "https://github.com/feeluown/emacs-fuo") (:commit . "0e4122f94a336a50c02bc96652d25ac3d74bedeb") (:revdesc . "0e4122f94a33") (:keywords "feeluown" "multimedia" "unix") (:authors ("cosven" . "yinshaowen241@gmail.com")) (:maintainers ("cosven" . "yinshaowen241@gmail.com")) (:maintainer "cosven" . "yinshaowen241@gmail.com"))]) (furl . [(20150509 316) nil "Friendly URL retrieval" tar ((:url . "https://github.com/nex3/furl-el") (:commit . "014438271e0ef27333dfcd599cb247f12a20d870") (:revdesc . "014438271e0e") (:authors ("Natalie Weizenbaum" . "nweiz@google.com")) (:maintainers ("Natalie Weizenbaum" . "nweiz@google.com")) (:maintainer "Natalie Weizenbaum" . "nweiz@google.com"))]) (fussy . [(20240607 2153) ((emacs (27 2)) (flx (0 5))) "Fuzzy completion style using `flx'" tar ((:url . "https://github.com/jojojames/fussy") (:commit . "21f4ac6b971f61890d46308d7ac5db64c20228e6") (:revdesc . "21f4ac6b971f") (:keywords "matching") (:authors ("James Nguyen" . "james@jojojames.com")) (:maintainers ("James Nguyen" . "james@jojojames.com")) (:maintainer "James Nguyen" . "james@jojojames.com"))]) - (futhark-mode . [(20241107 956) ((emacs (24 3)) (cl-lib (0 5)) (reformatter (0 4))) "Major mode for editing Futhark source files" tar ((:url . "https://github.com/diku-dk/futhark-mode") (:commit . "ec3579710823edef055909d705de25788b735598") (:revdesc . "ec3579710823") (:keywords "languages"))]) + (futhark-mode . [(20241120 854) ((emacs (24 3)) (cl-lib (0 5)) (reformatter (0 4))) "Major mode for editing Futhark source files" tar ((:url . "https://github.com/diku-dk/futhark-mode") (:commit . "a9cb4ee550d1ae14a7274d4e0c9bb6a2dff17c5a") (:revdesc . "a9cb4ee550d1") (:keywords "languages"))]) (fuz . [(20200104 524) ((emacs (25 1))) "Fast and precise fuzzy scoring/matching utils" tar ((:url . "https://github.com/rustify-emacs/fuz.el") (:commit . "0b6b64cebde5675be3a28520ee16234db48d3b8b") (:revdesc . "0b6b64cebde5") (:keywords "lisp") (:authors ("Zhu Zihao" . "all_but_last@163.com")) (:maintainers ("Zhu Zihao" . "all_but_last@163.com")) (:maintainer "Zhu Zihao" . "all_but_last@163.com"))]) (fuzzy . [(20240101 830) ((emacs (24 3))) "Fuzzy Matching" tar ((:url . "https://github.com/auto-complete/fuzzy-el") (:commit . "295140da741ac02c1bd3dec69ccf7f6268d60ec5") (:revdesc . "295140da741a") (:keywords "convenience") (:authors ("Tomohiro Matsuyama" . "m2ym.pub@gmail.com")) (:maintainers ("Tomohiro Matsuyama" . "m2ym.pub@gmail.com")) (:maintainer "Tomohiro Matsuyama" . "m2ym.pub@gmail.com"))]) (fuzzy-finder . [(20210906 217) ((emacs (24 4))) "Fuzzy Finder App Integration" tar ((:url . "https://github.com/10sr/fuzzy-finder-el") (:commit . "915a281fc8e50df84dcc205f9357e8314d60fa54") (:revdesc . "915a281fc8e5") (:keywords "matching") (:authors ("10sr" . "8.slashes@gmail.com")) (:maintainers ("10sr" . "8.slashes@gmail.com")) (:maintainer "10sr" . "8.slashes@gmail.com"))]) @@ -2222,7 +2225,7 @@ (govc . [(20240208 2356) ((emacs (24 3)) (dash (1 5 0)) (s (1 9 0)) (magit-popup (2 0 50)) (json-mode (1 6 0))) "Interface to govc for managing VMware ESXi and vCenter" tar ((:url . "https://github.com/vmware/govmomi") (:commit . "5d7849f71f7080873f4c7d75c999a5bf55d8486d") (:revdesc . "5d7849f71f70") (:keywords "convenience"))]) (govet . [(20170808 1724) nil "Linter/problem finder for the Go source code" tar ((:url . "https://github.com/meshelton/govet") (:commit . "1b8c044aa856f4b62a682bc57494af19d22a6053") (:revdesc . "1b8c044aa856"))]) (gpastel . [(20231030 713) ((emacs (25 1))) "Integrates GPaste with the kill-ring" tar ((:url . "https://github.com/DamienCassou/gpastel") (:commit . "d35505abb1e38ddda61440b033ebd4decac7a25c") (:revdesc . "d35505abb1e3") (:keywords "tools") (:authors ("Damien Cassou" . "damien@cassou.me")) (:maintainers ("Damien Cassou" . "damien@cassou.me")) (:maintainer "Damien Cassou" . "damien@cassou.me"))]) - (gpr-ts-mode . [(20241020 2248) ((emacs (29 1))) "Major mode for GNAT project files using Tree-Sitter" tar ((:url . "https://github.com/brownts/gpr-ts-mode") (:commit . "9a9daff32247156760dfbf360f65d4df5a027168") (:revdesc . "9a9daff32247") (:keywords "gpr" "gnat" "ada" "languages" "tree-sitter") (:authors ("Troy Brown" . "brownts@troybrown.dev")) (:maintainers ("Troy Brown" . "brownts@troybrown.dev")) (:maintainer "Troy Brown" . "brownts@troybrown.dev"))]) + (gpr-ts-mode . [(20241120 259) ((emacs (29 1))) "Major mode for GNAT project files using Tree-Sitter" tar ((:url . "https://github.com/brownts/gpr-ts-mode") (:commit . "598f2bca35d0fdedb8862a2cd73b119d915b848c") (:revdesc . "598f2bca35d0") (:keywords "gpr" "gnat" "ada" "languages" "tree-sitter") (:authors ("Troy Brown" . "brownts@troybrown.dev")) (:maintainers ("Troy Brown" . "brownts@troybrown.dev")) (:maintainer "Troy Brown" . "brownts@troybrown.dev"))]) (gpr-yasnippets . [(20230516 627) ((emacs (24 4)) (yasnippet (0 14 0))) "Yasnippets for GNAT project files" tar ((:url . "https://github.com/brownts/gpr-yasnippets") (:commit . "d66ea90e8e45f6d0c3bd62185967c26190117296") (:revdesc . "d66ea90e8e45") (:keywords "gpr" "gnat" "languages" "snippets") (:authors ("Troy Brown" . "brownts@troybrown.dev")) (:maintainers ("Troy Brown" . "brownts@troybrown.dev")) (:maintainer "Troy Brown" . "brownts@troybrown.dev"))]) (gpt . [(20241020 1841) ((emacs (24 4))) "Run instruction-following language models" tar ((:url . "https://github.com/stuhlmueller/gpt.el") (:commit . "3f3d0c4c1f2d5460ed3296a63c7938c5040aaa8e") (:revdesc . "3f3d0c4c1f2d") (:keywords "openai" "anthropic" "claude" "language" "copilot" "convenience" "tools") (:authors ("Andreas Stuhlmueller" . "andreas@ought.org")) (:maintainers ("Andreas Stuhlmueller" . "andreas@ought.org")) (:maintainer "Andreas Stuhlmueller" . "andreas@ought.org"))]) (gpt-commit . [(20230716 331) ((emacs (27 1)) (magit (2 90)) (request (0 3 2))) "Commit messages with GPT in Emacs" tar ((:url . "https://github.com/ywkim/gpt-commit") (:commit . "8a8883be2051eed499c5bc3035a75ff56d64d5ff") (:revdesc . "8a8883be2051") (:authors ("Youngwook Kim" . "youngwook.kim@gmail.com")) (:maintainers ("Youngwook Kim" . "youngwook.kim@gmail.com")) (:maintainer "Youngwook Kim" . "youngwook.kim@gmail.com"))]) @@ -2286,7 +2289,7 @@ (hack-mode . [(20240905 2225) ((emacs (25 1)) (s (1 11 0))) "Major mode for the Hack programming language" tar ((:url . "https://github.com/hhvm/hack-mode") (:commit . "343e45f2a616c726f20ba099f3f98a1a01cec405") (:revdesc . "343e45f2a616") (:authors ("John Allen" . "jallen@fb.com") ("Wilfred Hughes" . "me@wilfred.me.uk")) (:maintainers ("John Allen" . "jallen@fb.com") ("Wilfred Hughes" . "me@wilfred.me.uk")) (:maintainer "John Allen" . "jallen@fb.com"))]) (hacker-typer . [(20170206 1520) ((emacs (24))) "Pretend to write code like a pro" tar ((:url . "https://github.com/dieggsy/emacs-hacker-typer") (:commit . "d5a23714a4ccc5071580622f278597d5973f40bd") (:revdesc . "d5a23714a4cc") (:keywords "hacker" "typer" "multimedia" "games") (:authors ("Diego A. Mundo" . "diegoamundo@gmail.com")) (:maintainers ("Diego A. Mundo" . "diegoamundo@gmail.com")) (:maintainer "Diego A. Mundo" . "diegoamundo@gmail.com"))]) (hackernews . [(20240405 807) nil "Hacker News Client for Emacs" tar ((:url . "https://github.com/clarete/hackernews.el") (:commit . "7c1e9de10fd6b299d45b383302d223d7e3285da9") (:revdesc . "7c1e9de10fd6") (:keywords "comm" "hypermedia" "news") (:authors ("Lincoln de Sousa" . "lincoln@clarete.li")) (:maintainers ("Basil L. Contovounesios" . "basil@contovou.net")) (:maintainer "Basil L. Contovounesios" . "basil@contovou.net"))]) - (haki-theme . [(20241007 1441) ((emacs (27 1))) "An elegant, high-contrast dark theme in modern sense" tar ((:url . "https://github.com/idlip/haki") (:commit . "9d5771e23140b02101b8d6c410b56143df3d7756") (:revdesc . "9d5771e23140") (:keywords "faces" "theme" "accessibility"))]) + (haki-theme . [(20241118 1802) ((emacs (27 1))) "An elegant, high-contrast dark theme in modern sense" tar ((:url . "https://github.com/idlip/haki") (:commit . "3b13b5dd594d6cc5798117f216b266d86f1ffa16") (:revdesc . "3b13b5dd594d") (:keywords "faces" "theme" "accessibility"))]) (hal-mode . [(20160704 1746) nil "Major mode for editing HAL files" tar ((:url . "https://github.com/machinekoder/hal-mode") (:commit . "cd2f66f219ee520198d4586fb6b169cef7ad3f21") (:revdesc . "cd2f66f219ee") (:keywords "language"))]) (halloweenie-theme . [(20231011 1252) ((emacs (27 1)) (autothemer (0 2))) "Dark and spooky Halloween color theme" tar ((:url . "https://cicadas.surf/cgit/halloweenie-theme.git") (:commit . "db39ff0516e071aa890585c39fe411ea355e8b06") (:revdesc . "db39ff0516e0") (:keywords "faces" "theme" "halloween" "pumpkin") (:authors ("Colin Okay" . "colin@cicadas.surf")) (:maintainers ("Colin Okay" . "colin@cicadas.surf")) (:maintainer "Colin Okay" . "colin@cicadas.surf"))]) (ham-mode . [(20150811 1306) ((html-to-markdown (1 2)) (markdown-mode (2 0))) "Html As Markdown. Transparently edit an html file using markdown" tar ((:url . "https://github.com/Malabarba/ham-mode") (:commit . "3a141986a21c2aa6eefb428983352abb8b7907d2") (:revdesc . "3a141986a21c") (:keywords "convenience" "emulation" "wp") (:authors ("Artur Malabarba" . "bruce.connor.am@gmail.com")) (:maintainers ("Artur Malabarba" . "bruce.connor.am@gmail.com")) (:maintainer "Artur Malabarba" . "bruce.connor.am@gmail.com"))]) @@ -2423,7 +2426,7 @@ (helm-ls-git . [(20240828 607) ((helm (3 9 5)) (emacs (25 3))) "The git project manager for helm" tar ((:url . "https://github.com/emacs-helm/helm-ls-git") (:commit . "9338106a4caa51ba264c75c3a70976629a4aeb7b") (:revdesc . "9338106a4caa") (:keywords "helm" "convenience" "vc" "files" "buffers" "completion" "diff" "log" "git"))]) (helm-ls-hg . [(20150909 543) ((helm (1 7 8))) "List hg files in hg project" tar ((:url . "https://github.com/emacs-helm/helm-ls-hg") (:commit . "61b91a22fcfb62d0fc56e361ec01ce96973c7165") (:revdesc . "61b91a22fcfb"))]) (helm-ls-svn . [(20190316 2203) ((emacs (24 1)) (helm (1 7 0)) (cl-lib (0 5))) "Helm extension to list svn files" tar ((:url . "https://github.com/emacsmirror/helm-ls-svn") (:commit . "a6043e1187282f649e2cb9f0e722a42daf41294b") (:revdesc . "a6043e118728") (:keywords "helm" "svn") (:authors ("Chunyang Xu" . "chunyang@macports.org")) (:maintainers ("Chunyang Xu" . "chunyang@macports.org")) (:maintainer "Chunyang Xu" . "chunyang@macports.org"))]) - (helm-lsp . [(20210419 2014) ((emacs (25 1)) (dash (2 14 1)) (lsp-mode (5 0)) (helm (2 0))) "LSP helm integration" tar ((:url . "https://github.com/emacs-lsp/helm-lsp") (:commit . "c2c6974dadfac459b1a69a1217441283874cea92") (:revdesc . "c2c6974dadfa") (:keywords "languages" "debug") (:authors ("Ivan Yonchovski" . "yyoncho@gmail.com")) (:maintainers ("Ivan Yonchovski" . "yyoncho@gmail.com")) (:maintainer "Ivan Yonchovski" . "yyoncho@gmail.com"))]) + (helm-lsp . [(20241118 1931) ((emacs (27 1)) (dash (2 14 1)) (lsp-mode (5 0)) (helm (2 0))) "LSP helm integration" tar ((:url . "https://github.com/emacs-lsp/helm-lsp") (:commit . "e740efb2abbc0ffd43f6dbcdb4527bc55723b842") (:revdesc . "e740efb2abbc") (:keywords "languages" "debug") (:authors ("Ivan Yonchovski" . "yyoncho@gmail.com")) (:maintainers ("Ivan Yonchovski" . "yyoncho@gmail.com")) (:maintainer "Ivan Yonchovski" . "yyoncho@gmail.com"))]) (helm-lxc . [(20200323 816) ((emacs (25)) (cl-lib (0 5)) (helm (2 9 4)) (lxc-tramp (0 2 0))) "Helm interface to manage LXC containers" tar ((:url . "https://github.com/montag451/helm-lxc") (:commit . "37fe2d7ed97967edf59a3b68b1434910516ae24f") (:revdesc . "37fe2d7ed979") (:keywords "helm" "lxc" "convenience"))]) (helm-make . [(20200620 27) nil "Select a Makefile target with helm" tar ((:url . "https://github.com/abo-abo/helm-make") (:commit . "ebd71e85046d59b37f6a96535e01993b6962c559") (:revdesc . "ebd71e85046d") (:keywords "makefile") (:authors ("Oleh Krehel" . "ohwoeowho@gmail.com")) (:maintainers ("Oleh Krehel" . "ohwoeowho@gmail.com")) (:maintainer "Oleh Krehel" . "ohwoeowho@gmail.com"))]) (helm-migemo . [(20240921 1551) ((emacs (25 1)) (helm (1 7 8)) (migemo (1 9))) "Migemo plug-in for helm" tar ((:url . "https://github.com/emacs-jp/helm-migemo") (:commit . "6da30a3ee3ddcfde6068a5b05be24f888d9a7b53") (:revdesc . "6da30a3ee3dd") (:keywords "matching" "convenience" "tools" "i18n") (:authors ("rubikitch" . "rubikitch@ruby-lang.org")) (:maintainers ("Yuhei Maeda" . "yuhei.maeda_at_gmail.com")) (:maintainer "Yuhei Maeda" . "yuhei.maeda_at_gmail.com"))]) @@ -2607,7 +2610,7 @@ (hydandata-light-theme . [(20190809 1925) nil "A light color theme that is easy on your eyes" tar ((:url . "https://github.com/chkhd/hydandata-light-theme") (:commit . "812ffa4bee3163098ef66ee4506feed45018be4e") (:revdesc . "812ffa4bee31") (:keywords "color-theme" "theme") (:authors ("David Chkhikvadze" . "david@chkhd.net")) (:maintainers ("David Chkhikvadze" . "david@chkhd.net")) (:maintainer "David Chkhikvadze" . "david@chkhd.net"))]) (hyde . [(20160508 308) nil "Major mode to help create and manage Jekyll blogs" tar ((:url . "https://github.com/nibrahim/Hyde") (:commit . "a8cd6ed00ecd8d7de0ded2f4867015b412b15b76") (:revdesc . "a8cd6ed00ecd"))]) (hydra . [(20220910 1206) ((cl-lib (0 5)) (lv (0))) "Make bindings that stick around" tar ((:url . "https://github.com/abo-abo/hydra") (:commit . "317e1de33086637579a7aeb60f77ed0405bf359b") (:revdesc . "317e1de33086") (:keywords "bindings") (:authors ("Oleh Krehel" . "ohwoeowho@gmail.com")) (:maintainers ("Oleh Krehel" . "ohwoeowho@gmail.com")) (:maintainer "Oleh Krehel" . "ohwoeowho@gmail.com"))]) - (hyperbole . [(20241116 2220) ((emacs (27 2))) "GNU Hyperbole: The Everyday Hypertextual Information Manager" tar ((:url . "https://git.savannah.gnu.org/git/hyperbole.git") (:commit . "e6f401027c9a507c96529b77d20e6a280ec7d40e") (:revdesc . "e6f401027c9a") (:keywords "comm" "convenience" "files" "frames" "hypermedia" "languages" "mail" "matching" "mouse" "multimedia" "outlines" "tools" "wp") (:authors ("Robert Weiner" . "rsw@gnu.org")) (:maintainers ("Robert Weiner" . "rsw@gnu.org")) (:maintainer "Robert Weiner" . "rsw@gnu.org"))]) + (hyperbole . [(20241119 534) ((emacs (27 2))) "GNU Hyperbole: The Everyday Hypertextual Information Manager" tar ((:url . "https://git.savannah.gnu.org/git/hyperbole.git") (:commit . "f2b98683ef86cc6464fbff59f9ae07e69999a943") (:revdesc . "f2b98683ef86") (:keywords "comm" "convenience" "files" "frames" "hypermedia" "languages" "mail" "matching" "mouse" "multimedia" "outlines" "tools" "wp") (:authors ("Robert Weiner" . "rsw@gnu.org")) (:maintainers ("Robert Weiner" . "rsw@gnu.org")) (:maintainer "Robert Weiner" . "rsw@gnu.org"))]) (hyperdrive . [(20241101 2353) ((emacs (28 1)) (map (3 0)) (compat (30 0 0 0)) (org (9 7 6)) (plz (0 9 1)) (persist (0 6 1)) (taxy-magit-section (0 14)) (transient (0 7 7))) "P2P filesystem" tar ((:url . "https://git.sr.ht/~ushin/hyperdrive.el") (:commit . "581752cad8bcd701c863b08a779e4ca982325cae") (:revdesc . "581752cad8bc") (:authors ("Joseph Turner" . "joseph@ushin.org")) (:maintainers ("Joseph Turner" . "~ushin/ushin@lists.sr.ht")) (:maintainer "Joseph Turner" . "~ushin/ushin@lists.sr.ht"))]) (hyperdrive-org-transclusion . [(20241028 427) ((emacs (28 1)) (hyperdrive (0 4 2)) (org-transclusion (1 4 0))) "Tranclude hyperdrive content" tar ((:url . "https://git.sr.ht/~ushin/hyperdrive-org-transclusion") (:commit . "252e2df3fe7a07a122a365a637c47a43b26e179c") (:revdesc . "252e2df3fe7a") (:authors ("Joseph Turner" . "joseph@ushin.org")) (:maintainers ("Joseph Turner" . "~ushin/ushin@lists.sr.ht")) (:maintainer "Joseph Turner" . "~ushin/ushin@lists.sr.ht"))]) (hyperkitty . [(20220226 1951) ((request (0 3 2)) (emacs (25 1))) "Emacs interface for Hyperkitty archives" tar ((:url . "https://github.com/maxking/hyperkitty.el") (:commit . "2c1d22ff017d096c359aa151e6a29f7214a58118") (:revdesc . "2c1d22ff017d") (:keywords "mail" "hyperkitty" "mailman") (:authors ("Abhilash Raj" . "maxking@asynchronous.in")) (:maintainers ("Abhilash Raj" . "maxking@asynchronous.in")) (:maintainer "Abhilash Raj" . "maxking@asynchronous.in"))]) @@ -2712,7 +2715,7 @@ (inform . [(20200723 500) ((emacs (25 1))) "Symbol links in Info buffers to their help documentation" tar ((:url . "https://github.com/dieter-wilhelm/inform") (:commit . "8ff0a19a9f40cfa8283da8ed73de94c35a327423") (:revdesc . "8ff0a19a9f40") (:keywords "help" "docs" "convenience") (:authors ("H. Dieter Wilhelm" . "dieter@duenenhof-wilhelm.de")))]) (inform7 . [(20200430 1539) ((emacs (24 3)) (s (1 12 0))) "Major mode for working with Inform 7 files" tar ((:url . "https://github.com/GuiltyDolphin/inform7-mode") (:commit . "a409bbc6f04264f7f00616a995fa6ecf59d33d0d") (:revdesc . "a409bbc6f042") (:keywords "languages") (:authors ("Ben Moon" . "software@guiltydolphin.com")) (:maintainers ("Ben Moon" . "software@guiltydolphin.com")) (:maintainer "Ben Moon" . "software@guiltydolphin.com"))]) (inherit-local . [(20170409 1649) ((emacs (24 3))) "Inherited buffer-local variables" tar ((:url . "https://github.com/shlevy/inherit-local") (:commit . "b1f4ff9c41f9d64e4adaf5adcc280b82f084cdc7") (:revdesc . "b1f4ff9c41f9"))]) - (inheritenv . [(20230804 651) ((emacs (24 4))) "Make temp buffers inherit buffer-local environment variables" tar ((:url . "https://github.com/purcell/inheritenv") (:commit . "00106bb208d06e5f1ec25d0c2f41c000cbb25076") (:revdesc . "00106bb208d0") (:keywords "unix") (:authors ("Steve Purcell" . "steve@sanityinc.com")) (:maintainers ("Steve Purcell" . "steve@sanityinc.com")) (:maintainer "Steve Purcell" . "steve@sanityinc.com"))]) + (inheritenv . [(20241119 1355) ((emacs (24 4))) "Make temp buffers inherit buffer-local environment variables" tar ((:url . "https://github.com/purcell/inheritenv") (:commit . "b9e67cc20c069539698a9ac54d0e6cc11e616c6f") (:revdesc . "b9e67cc20c06") (:keywords "unix") (:authors ("Steve Purcell" . "steve@sanityinc.com")) (:maintainers ("Steve Purcell" . "steve@sanityinc.com")) (:maintainer "Steve Purcell" . "steve@sanityinc.com"))]) (inhibit-mouse . [(20241114 1902) ((emacs (24 1))) "Deactivate mouse input during editing" tar ((:url . "https://github.com/jamescherti/inhibit-mouse.el") (:commit . "ce8180dd631d4aadd8b3c434ecbb77c2f5e31012") (:revdesc . "ce8180dd631d") (:keywords "convenience"))]) (ini . [(20220827 2009) ((emacs (24 4))) "Converting between INI files and association lists" tar ((:url . "https://github.com/EsaLaine/ini.el") (:commit . "d50fe629497d51c6390a56bbded1ad77ce12e5af") (:revdesc . "d50fe629497d"))]) (ini-mode . [(20230211 1512) ((emacs (24 1))) "Major mode for Windows-style ini files" tar ((:url . "https://github.com/Lindydancer/ini-mode") (:commit . "5472abc94e564edc6b469c48d2324519a044a77c") (:revdesc . "5472abc94e56") (:keywords "languages" "faces"))]) @@ -2847,7 +2850,7 @@ (jetbrains-darcula-theme . [(20230223 1901) nil "A complete port of the default JetBrains Darcula theme" tar ((:url . "https://github.com/ianyepan/jetbrains-darcula-emacs-theme") (:commit . "46f153385e50998826ca13e18056c6a972768cfd") (:revdesc . "46f153385e50"))]) (jg-quicknav . [(20170809 130) ((s (1 9 0)) (cl-lib (0 5))) "Quickly navigate the file system to find a file" tar ((:url . "https://github.com/jeffgran/jg-quicknav") (:commit . "c8d53e774d63e68a944092c08a026b57da741038") (:revdesc . "c8d53e774d63") (:keywords "navigation") (:authors ("Jeff Gran" . "jeff@jeffgran.com")) (:maintainers ("Jeff Gran" . "jeff@jeffgran.com")) (:maintainer "Jeff Gran" . "jeff@jeffgran.com"))]) (jinja2-mode . [(20220117 807) nil "A major mode for jinja2" tar ((:url . "https://github.com/paradoxxxzero/jinja2-mode") (:commit . "03e5430a7efe1d163a16beaf3c82c5fd2c2caee1") (:revdesc . "03e5430a7efe"))]) - (jinx . [(20241105 2132) ((emacs (28 1)) (compat (30))) "Enchanted Spell Checker" tar ((:url . "https://github.com/minad/jinx") (:commit . "c44d2517cfbe2214e7e2840e16ad1ad739e1c1a4") (:revdesc . "c44d2517cfbe") (:keywords "convenience" "text") (:authors ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainers ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainer "Daniel Mendler" . "mail@daniel-mendler.de"))]) + (jinx . [(20241119 1644) ((emacs (28 1)) (compat (30))) "Enchanted Spell Checker" tar ((:url . "https://github.com/minad/jinx") (:commit . "61144055e8ce445568baa19302f4af60e15a2e6d") (:revdesc . "61144055e8ce") (:keywords "convenience" "text") (:authors ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainers ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainer "Daniel Mendler" . "mail@daniel-mendler.de"))]) (jira-markup-mode . [(20150601 2109) nil "Emacs Major mode for JIRA-markup-formatted text files" tar ((:url . "https://github.com/mnuessler/jira-markup-mode") (:commit . "53bf083fdbece483f1351f32085b424b38c4c1f2") (:revdesc . "53bf083fdbec") (:keywords "jira" "markup") (:authors ("Matthias Nuessler" . "m.nuessler@web.de")) (:maintainers ("Matthias Nuessler" . "m.nuessler@web.de")) (:maintainer "Matthias Nuessler" . "m.nuessler@web.de"))]) (jiralib2 . [(20200520 2031) ((emacs (25)) (request (0 3)) (dash (2 14 1))) "JIRA REST API bindings to Elisp" tar ((:url . "https://github.com/nyyManni/jiralib2") (:commit . "c21c4e759eff549dbda11099f2f680b78d7f5a01") (:revdesc . "c21c4e759eff") (:keywords "comm" "jira" "rest" "api") (:authors ("Henrik Nyman" . "h@nyymanni.com")) (:maintainers ("Henrik Nyman" . "h@nyymanni.com")) (:maintainer "Henrik Nyman" . "h@nyymanni.com"))]) (jirascope . [(20240122 2130) ((emacs (25 1))) "A Jira client" tar ((:url . "https://github.com/Duckonaut/jirascope") (:commit . "61acd8d6adbd6b25ebcc5436b4dce6d5c6d2981c") (:revdesc . "61acd8d6adbd") (:keywords "tools") (:authors ("Stanisław Zagórowski" . "duckonaut@gmail.com")) (:maintainers ("Stanisław Zagórowski" . "duckonaut@gmail.com")) (:maintainer "Stanisław Zagórowski" . "duckonaut@gmail.com"))]) @@ -2896,7 +2899,7 @@ (jtags . [(20160211 2029) nil "Enhanced tags functionality for Java development" tar ((:url . "https://git.code.sf.net/p/jtags/code") (:commit . "f7d29e1635ef7ee4ee2cdb8f1f6ab83e1015c84a") (:revdesc . "f7d29e1635ef") (:keywords "languages" "tools") (:authors ("Alexander Baltatzis" . "alexander@baltatzis.com") ("Johan Dykstrom" . "jody4711-sf@yahoo.se")) (:maintainers ("Johan Dykstrom" . "jody4711-sf@yahoo.se")) (:maintainer "Johan Dykstrom" . "jody4711-sf@yahoo.se"))]) (jtsx . [(20240715 2002) ((emacs (29 1))) "Extends JSX/TSX built-in support" tar ((:url . "https://github.com/llemaitre19/jtsx") (:commit . "e81259a7584619ce3266a2d532f674ef45ee4274") (:revdesc . "e81259a75846") (:keywords "languages") (:authors ("Loïc Lemaître" . "loic.lemaitre@gmail.com")) (:maintainers ("Loïc Lemaître" . "loic.lemaitre@gmail.com")) (:maintainer "Loïc Lemaître" . "loic.lemaitre@gmail.com"))]) (julia-formatter . [(20231130 1512) ((emacs (27 1)) (session-async (0 0 5))) "Use JuliaFormatter.jl for julia code" tar ((:url . "https://codeberg.org/FelipeLema/julia-formatter.el") (:commit . "4b40481cc9c0dcb3c9704436e00d613067d44bf5") (:revdesc . "4b40481cc9c0") (:keywords "convenience" "tools") (:authors ("Felipe Lema" . "felipe.lema@mortemale.org")) (:maintainers ("Felipe Lema" . "felipe.lema@mortemale.org")) (:maintainer "Felipe Lema" . "felipe.lema@mortemale.org"))]) - (julia-mode . [(20240926 1528) ((emacs (26 1))) "Major mode for editing Julia source code" tar ((:url . "https://github.com/JuliaEditorSupport/julia-emacs") (:commit . "09897a8cbab48adaacdef6f852d7cebd3945a645") (:revdesc . "09897a8cbab4") (:keywords "languages"))]) + (julia-mode . [(20241120 857) ((emacs (26 1))) "Major mode for editing Julia source code" tar ((:url . "https://github.com/JuliaEditorSupport/julia-emacs") (:commit . "709c43410fb5da068d7d582cf3f545f7a7a68133") (:revdesc . "709c43410fb5") (:keywords "languages"))]) (julia-repl . [(20241113 1152) ((emacs (25 1)) (s (1 12))) "A minor mode for a Julia REPL" tar ((:url . "https://github.com/tpapp/julia-repl") (:commit . "bb90cc1fceccc8dfd0e4b60d624271e4aca6b9b8") (:revdesc . "bb90cc1fcecc") (:keywords "languages") (:authors ("Tamas Papp" . "tkpapp@gmail.com")) (:maintainers ("Tamas Papp" . "tkpapp@gmail.com")) (:maintainer "Tamas Papp" . "tkpapp@gmail.com"))]) (julia-shell . [(20161125 1910) ((julia-mode (0 3))) "Major mode for an inferior Julia shell" tar ((:url . "https://github.com/dennisog/julia-shell-mode") (:commit . "583a0b2ca20461ab4356929fd0f2212c22341b69") (:revdesc . "583a0b2ca204") (:authors ("Dennis Ogbe" . "dogbe@purdue.edu")) (:maintainers ("Dennis Ogbe" . "dogbe@purdue.edu")) (:maintainer "Dennis Ogbe" . "dogbe@purdue.edu"))]) (julia-snail . [(20240812 840) ((emacs (26 2)) (dash (2 16 0)) (julia-mode (0 3)) (s (1 12 0)) (spinner (1 7 3)) (popup (0 5 9))) "Julia Snail" tar ((:url . "https://github.com/gcv/julia-snail") (:commit . "dff92c4250e40a6cc106f0ea993f9631ad55eb7c") (:revdesc . "dff92c4250e4"))]) @@ -2908,7 +2911,7 @@ (jump-to-line . [(20130122 1653) nil "Jump to line number at point" tar ((:url . "https://github.com/ongaeshi/jump-to-line") (:commit . "01ef8c3529d85e6c59cc20840acbc4a8e8325bc8") (:revdesc . "01ef8c3529d8") (:keywords "jump" "line" "back" "file" "ruby" "csharp" "python" "perl"))]) (jump-tree . [(20171014 1551) nil "Treat position history as a tree" tar ((:url . "https://github.com/yangwen0228/jump-tree") (:commit . "282267dc6305889e31d46b405b7ad4dfe5923b66") (:revdesc . "282267dc6305") (:keywords "convenience" "position" "jump" "tree") (:authors ("Wen Yang" . "yangwen0228@foxmail.com")) (:maintainers ("Wen Yang" . "yangwen0228@foxmail.com")) (:maintainer "Wen Yang" . "yangwen0228@foxmail.com"))]) (jumplist . [(20151120 345) ((cl-lib (0 5))) "Jump like vim jumplist or ex jumplist" tar ((:url . "https://github.com/ganmacs/jumplist") (:commit . "c482d137d95bc5e1bcd790cdbde25b7f729b2502") (:revdesc . "c482d137d95b") (:keywords "jumplist" "vim") (:authors ("ganmacs" . "ganmacs_at_gmail.com")) (:maintainers ("ganmacs" . "ganmacs_at_gmail.com")) (:maintainer "ganmacs" . "ganmacs_at_gmail.com"))]) - (jupyter . [(20241004 241) ((emacs (26)) (cl-lib (0 5)) (org (9 1 6)) (zmq (0 10 10)) (simple-httpd (1 5 0)) (websocket (1 9))) "Jupyter" tar ((:url . "https://github.com/emacs-jupyter/jupyter") (:commit . "674af0481a94f2ce56c62aa7668a966254ef26ef") (:revdesc . "674af0481a94") (:authors ("Nathaniel Nicandro" . "nathanielnicandro@gmail.com")) (:maintainers ("Nathaniel Nicandro" . "nathanielnicandro@gmail.com")) (:maintainer "Nathaniel Nicandro" . "nathanielnicandro@gmail.com"))]) + (jupyter . [(20241120 230) ((emacs (27)) (cl-lib (0 5)) (org (9 1 6)) (zmq (0 10 10)) (simple-httpd (1 5 0)) (websocket (1 9))) "Jupyter" tar ((:url . "https://github.com/emacs-jupyter/jupyter") (:commit . "577371744b36aa0afa117b7ded21d08f60331ff6") (:revdesc . "577371744b36") (:authors ("Nathaniel Nicandro" . "nathanielnicandro@gmail.com")) (:maintainers ("Nathaniel Nicandro" . "nathanielnicandro@gmail.com")) (:maintainer "Nathaniel Nicandro" . "nathanielnicandro@gmail.com"))]) (just-mode . [(20240424 1809) ((emacs (26 1))) "Justfile editing mode" tar ((:url . "https://github.com/leon-barrett/just-mode.el") (:commit . "4c0df4cc4b8798f1a7e99fb78b79c4bf7eec12c1") (:revdesc . "4c0df4cc4b87") (:keywords "files" "languages" "tools") (:authors ("Leon Barrett" . "(leon@barrettnexus.com)")) (:maintainers ("Leon Barrett" . "(leon@barrettnexus.com)")) (:maintainer "Leon Barrett" . "(leon@barrettnexus.com)"))]) (just-ts-mode . [(20241014 2252) ((emacs (29 1))) "Justfile editing mode" tar ((:url . "https://github.com/leon-barrett/just-ts-mode.el") (:commit . "acb598f1edabae9f679a507c8e22c21b3f2da132") (:revdesc . "acb598f1edab") (:keywords "files" "languages" "tools" "treesitter") (:authors ("Leon Barrett" . "(leon@barrettnexus.com)")) (:maintainers ("Leon Barrett" . "(leon@barrettnexus.com)")) (:maintainer "Leon Barrett" . "(leon@barrettnexus.com)"))]) (justl . [(20241116 530) ((transient (0 1 0)) (emacs (27 1)) (s (1 2 0)) (f (0 20 0)) (inheritenv (0 2))) "Major mode for driving just files" tar ((:url . "https://github.com/psibi/justl.el") (:commit . "82925541b4a36e0e9f95eee0f4a0ea348c750990") (:revdesc . "82925541b4a3") (:keywords "just" "justfile" "tools" "processes"))]) @@ -2963,7 +2966,7 @@ (kfg . [(20140909 538) ((f (0 17 1))) "An emacs configuration system" tar ((:url . "https://github.com/czipperz/kfg") (:commit . "ffc35b77f227d4c64a1271ec30d31333ffeb0013") (:revdesc . "ffc35b77f227") (:authors ("Austin Bingham" . "austin.bingham@gmail.com")) (:maintainers ("Austin Bingham" . "austin.bingham@gmail.com")) (:maintainer "Austin Bingham" . "austin.bingham@gmail.com"))]) (khalel . [(20240527 527) ((emacs (27 1))) "Import, edit and create calendar events through khal" tar ((:url . "https://gitlab.com/hperrey/khalel") (:commit . "14ef50352394cd1d62b80bc17ab14f4f801f47cd") (:revdesc . "14ef50352394") (:keywords "event" "calendar" "ics" "khal") (:authors ("Hanno Perrey" . "http://gitlab.com/hperrey")) (:maintainers ("Hanno Perrey" . "hanno@hoowl.se")) (:maintainer "Hanno Perrey" . "hanno@hoowl.se"))]) (khardel . [(20231126 1502) ((emacs (27 1)) (yaml-mode (0 0 13))) "Integrate with khard" tar ((:url . "https://github.com/DamienCassou/khardel") (:commit . "205e374b36252183a146a7a8f857bcf95a77edc3") (:revdesc . "205e374b3625") (:authors ("Damien Cassou" . "damien@cassou.me")) (:maintainers ("Damien Cassou" . "damien@cassou.me")) (:maintainer "Damien Cassou" . "damien@cassou.me"))]) - (khoj . [(20241112 1832) ((emacs (27 1)) (transient (0 3 0)) (dash (2 19 1))) "Your Second Brain" tar ((:url . "https://github.com/khoj-ai/khoj") (:commit . "d607ad7a271f53c4daf1c5c8321f5776d752cbe8") (:revdesc . "d607ad7a271f") (:keywords "search" "chat" "ai" "org-mode" "outlines" "markdown" "pdf" "image") (:authors ("Debanjum Singh Solanky" . "debanjum@khoj.dev") ("Saba Imran" . "saba@khoj.dev")) (:maintainers ("Debanjum Singh Solanky" . "debanjum@khoj.dev") ("Saba Imran" . "saba@khoj.dev")) (:maintainer "Debanjum Singh Solanky" . "debanjum@khoj.dev"))]) + (khoj . [(20241119 130) ((emacs (27 1)) (transient (0 3 0)) (dash (2 19 1))) "Your Second Brain" tar ((:url . "https://github.com/khoj-ai/khoj") (:commit . "5134d49d7133e34962c396dc7be75bb6c3a46a29") (:revdesc . "5134d49d7133") (:keywords "search" "chat" "ai" "org-mode" "outlines" "markdown" "pdf" "image") (:authors ("Debanjum Singh Solanky" . "debanjum@khoj.dev") ("Saba Imran" . "saba@khoj.dev")) (:maintainers ("Debanjum Singh Solanky" . "debanjum@khoj.dev") ("Saba Imran" . "saba@khoj.dev")) (:maintainer "Debanjum Singh Solanky" . "debanjum@khoj.dev"))]) (kibit-helper . [(20150508 1533) ((s (0 8)) (emacs (24))) "Conveniently use the Kibit Leiningen plugin from Emacs" tar ((:url . "https://github.com/brunchboy/kibit-helper") (:commit . "ec5f154db3bb0c838e86f527353f08644cede926") (:revdesc . "ec5f154db3bb") (:keywords "languages" "clojure" "kibit") (:authors ("James Elliott" . "james@brunchboy.com")) (:maintainers ("James Elliott" . "james@brunchboy.com")) (:maintainer "James Elliott" . "james@brunchboy.com"))]) (kill-file-path . [(20230306 1041) ((emacs (26))) "Copy file name into kill ring" tar ((:url . "https://github.com/chyla/kill-file-path") (:commit . "5dcbce69cbae17665216a32dd20f27de54c62972") (:revdesc . "5dcbce69cbae") (:keywords "files") (:authors ("Adam Chyła" . "adam@chyla.org")) (:maintainers ("Adam Chyła" . "adam@chyla.org")) (:maintainer "Adam Chyła" . "adam@chyla.org"))]) (kill-or-bury-alive . [(20230606 1503) ((emacs (24 4))) "Precise control over buffer killing" tar ((:url . "https://github.com/mrkkrp/kill-or-bury-alive") (:commit . "16c393db6ad0c7e184af0a24d26b637e23543b1f") (:revdesc . "16c393db6ad0") (:keywords "convenience") (:authors ("Mark Karpov" . "markkarpov92@gmail.com")) (:maintainers ("Mark Karpov" . "markkarpov92@gmail.com")) (:maintainer "Mark Karpov" . "markkarpov92@gmail.com"))]) @@ -3108,7 +3111,7 @@ (lispyville . [(20220715 29) ((lispy (0)) (evil (1 2 12)) (cl-lib (0 5)) (emacs (24 4))) "A minor mode for integrating evil with lispy" tar ((:url . "https://github.com/noctuid/lispyville") (:commit . "14ee8711d58b649aeac03581d22b10ab077f06bd") (:revdesc . "14ee8711d58b") (:keywords "vim" "evil" "lispy" "lisp" "parentheses") (:authors ("Fox Kiester" . "noct@posteo.net")) (:maintainers ("Fox Kiester" . "noct@posteo.net")) (:maintainer "Fox Kiester" . "noct@posteo.net"))]) (list-environment . [(20210930 1439) nil "A tabulated process environment editor" tar ((:url . "https://github.com/dgtized/list-environment.el") (:commit . "0a72a5a9c1abc090b25202a0387e3f766994b053") (:revdesc . "0a72a5a9c1ab") (:keywords "processes" "unix") (:authors ("Charles L.G. Comstock" . "dgtized@gmail.com")) (:maintainers ("Charles L.G. Comstock" . "dgtized@gmail.com")) (:maintainer "Charles L.G. Comstock" . "dgtized@gmail.com"))]) (list-packages-ext . [(20151115 1716) ((s (1 6 0)) (ht (1 5 0)) (persistent-soft (0 8 6))) "Extras for list-packages" tar ((:url . "https://github.com/laynor/list-packages-ext") (:commit . "b4dd644e4369c9aa66f5bb8895ea49ebbfd0a27a") (:revdesc . "b4dd644e4369") (:keywords "convenience" "tools") (:authors ("Alessandro Piras" . "laynor@gmail.com")) (:maintainers ("Alessandro Piras" . "laynor@gmail.com")) (:maintainer "Alessandro Piras" . "laynor@gmail.com"))]) - (list-unicode-display . [(20230216 958) ((emacs (24 3))) "Search for and list unicode characters by name" tar ((:url . "https://github.com/purcell/list-unicode-display") (:commit . "57b4384ebe0c5d10890ee0dfcf66d0b16e5f5060") (:revdesc . "57b4384ebe0c") (:keywords "convenience") (:authors ("Steve Purcell" . "steve@sanityinc.com")) (:maintainers ("Steve Purcell" . "steve@sanityinc.com")) (:maintainer "Steve Purcell" . "steve@sanityinc.com"))]) + (list-unicode-display . [(20241119 1152) ((emacs (24 3))) "Search for and list unicode characters by name" tar ((:url . "https://github.com/purcell/list-unicode-display") (:commit . "68feedd776082c1743588c2b07dbb6539dbe51bf") (:revdesc . "68feedd77608") (:keywords "convenience") (:authors ("Steve Purcell" . "steve@sanityinc.com")) (:maintainers ("Steve Purcell" . "steve@sanityinc.com")) (:maintainer "Steve Purcell" . "steve@sanityinc.com"))]) (list-utils . [(20241106 1849) nil "List-manipulation utility functions" tar ((:url . "https://github.com/rolandwalker/list-utils") (:commit . "bbea0e7cc7ab7d96e7f062014bde438aa8ffcd43") (:revdesc . "bbea0e7cc7ab") (:keywords "extensions") (:authors ("Roland Walker" . "walker@pobox.com")) (:maintainers ("Roland Walker" . "walker@pobox.com")) (:maintainer "Roland Walker" . "walker@pobox.com"))]) (listenbrainz . [(20230530 741) ((emacs (27 1)) (request (0 3))) "ListenBrainz API interface" tar ((:url . "https://github.com/zzkt/metabrainz") (:commit . "2386189ec8a19a74d7b8a46e08a9fa6d974a6305") (:revdesc . "2386189ec8a1") (:keywords "music" "scrobbling" "multimedia") (:authors ("nik gaffney" . "nik@fo.am")) (:maintainers ("nik gaffney" . "nik@fo.am")) (:maintainer "nik gaffney" . "nik@fo.am"))]) (lister . [(20240102 1500) ((emacs (26 1))) "Yet another list printer" tar ((:url . "https://github.com/publicimageltd/lister") (:commit . "84fbba7450ac02cbb844727a28b6f245f553df7b") (:revdesc . "84fbba7450ac") (:keywords "lisp") (:authors (nil . "joerg@joergvolbers.de")) (:maintainers (nil . "joerg@joergvolbers.de")) (:maintainer nil . "joerg@joergvolbers.de"))]) @@ -3149,7 +3152,7 @@ (lognav-mode . [(20240115 1637) ((emacs (24 3))) "Navigate Log Error Messages" tar ((:url . "https://github.com/ellisvelo/lognav-mode") (:commit . "139da9eb356b4432f416d1db49fdbfa46fb1bf8d") (:revdesc . "139da9eb356b") (:keywords "log" "error" "lognav-mode" "convenience") (:authors ("Shawn Ellis" . "shawn.ellis17@gmail.com")) (:maintainers ("Shawn Ellis" . "shawn.ellis17@gmail.com")) (:maintainer "Shawn Ellis" . "shawn.ellis17@gmail.com"))]) (logpad . [(20201113 917) nil "Simulate Windows Notepad for logging" tar ((:url . "https://github.com/dertuxmalwieder/logpad.el") (:commit . "2955c6e3de40bd1e84acb4c16c7690b210f82bec") (:revdesc . "2955c6e3de40") (:keywords "files" "outlines" "notepad") (:authors ("Sven Knurr" . "git@tuxproject.de")) (:maintainers ("Sven Knurr" . "git@tuxproject.de")) (:maintainer "Sven Knurr" . "git@tuxproject.de"))]) (logstash-conf . [(20210123 1949) nil "Basic mode for editing logstash configuration" tar ((:url . "https://github.com/Wilfred/logstash-conf.el") (:commit . "ec9b527191cd47d3b5947cb0ec3d6a8a57b121ea") (:revdesc . "ec9b527191cd") (:authors ("Wilfred Hughes" . "me@wilfred.me.uk")) (:maintainers ("Wilfred Hughes" . "me@wilfred.me.uk")) (:maintainer "Wilfred Hughes" . "me@wilfred.me.uk"))]) - (logview . [(20241104 2042) ((emacs (25 1)) (datetime (0 8)) (extmap (1 0))) "Major mode for viewing log files" tar ((:url . "https://github.com/doublep/logview") (:commit . "0db778bb0ced79989a5112a722d218761893101d") (:revdesc . "0db778bb0ced") (:keywords "files" "tools") (:authors ("Paul Pogonyshev" . "pogonyshev@gmail.com")) (:maintainers ("Paul Pogonyshev" . "pogonyshev@gmail.com")) (:maintainer "Paul Pogonyshev" . "pogonyshev@gmail.com"))]) + (logview . [(20241118 1819) ((emacs (25 1)) (datetime (0 8)) (extmap (1 0))) "Major mode for viewing log files" tar ((:url . "https://github.com/doublep/logview") (:commit . "de9694cfdc7006017781e7d32bb8bad38c7fda46") (:revdesc . "de9694cfdc70") (:keywords "files" "tools") (:authors ("Paul Pogonyshev" . "pogonyshev@gmail.com")) (:maintainers ("Paul Pogonyshev" . "pogonyshev@gmail.com")) (:maintainer "Paul Pogonyshev" . "pogonyshev@gmail.com"))]) (lol-data-dragon . [(20200705 1822) ((emacs (25 1))) "Browse Champions of League of Legends on Data Dragon" tar ((:url . "https://github.com/xuchunyang/lol-data-dragon.el") (:commit . "0deec9867bd7ba96220ee2968a9b2a94fd474431") (:revdesc . "0deec9867bd7") (:keywords "games" "hypermedia"))]) (lolcat . [(20190527 1145) ((emacs (24 3))) "Rainbows and unicorns!" tar ((:url . "https://github.com/xuchunyang/lolcat.el") (:commit . "4855e587a3b9681c077dac4b9f166dd860f439a4") (:revdesc . "4855e587a3b9") (:authors ("Xu Chunyang" . "mail@xuchunyang.me")) (:maintainers ("Xu Chunyang" . "mail@xuchunyang.me")) (:maintainer "Xu Chunyang" . "mail@xuchunyang.me"))]) (lolcode-mode . [(20111002 847) nil "Major mode for editing LOLCODE" tar ((:url . "https://github.com/bodil/lolcode-mode") (:commit . "280a47e0bf02ee3abc7c5b6b14345056f41981f9") (:revdesc . "280a47e0bf02") (:keywords "lolcode" "major" "mode") (:authors ("Bodil Stokke" . "lolcode@bodil.tv")) (:maintainers ("Bodil Stokke" . "lolcode@bodil.tv")) (:maintainer "Bodil Stokke" . "lolcode@bodil.tv"))]) @@ -3166,11 +3169,11 @@ (lsp-cfn . [(20240112 921) ((emacs (27 0)) (lsp-mode (8 0 0)) (yaml-mode (0 0 15))) "LSP integration for cfn-lsp-extra" tar ((:url . "https://github.com/LaurenceWarne/lsp-cfn.el") (:commit . "2297533003118ebd9db0116b4d3486a987e98ca9") (:revdesc . "229753300311"))]) (lsp-dart . [(20241114 2005) ((emacs (27 1)) (lsp-treemacs (0 3)) (lsp-mode (7 0 1)) (dap-mode (0 6)) (f (0 20 0)) (dash (2 14 1)) (dart-mode (1 0 5)) (jsonrpc (1 0 15)) (ht (2 2))) "Dart support lsp-mode" tar ((:url . "https://github.com/emacs-lsp/lsp-dart") (:commit . "7e3d3429418bc42cda7fa7b58e6644a705cf2f89") (:revdesc . "7e3d3429418b") (:keywords "languages" "extensions"))]) (lsp-docker . [(20240419 1428) ((emacs (27 1)) (dash (2 14 1)) (lsp-mode (6 2 1)) (f (0 20 0)) (s (1 13 0)) (yaml (0 2 0)) (ht (2 0))) "LSP Docker integration" tar ((:url . "https://github.com/emacs-lsp/lsp-docker") (:commit . "16a0cfbe06813a1191b19e412445f9d34cd7493f") (:revdesc . "16a0cfbe0681") (:keywords "languages" "langserver") (:authors ("Ivan Yonchovski" . "yyoncho@gmail.com")) (:maintainers ("Ivan Yonchovski" . "yyoncho@gmail.com")) (:maintainer "Ivan Yonchovski" . "yyoncho@gmail.com"))]) - (lsp-focus . [(20200906 1917) ((emacs (26 1)) (focus (0 1 1)) (lsp-mode (6 1))) "Focus.el support for lsp-mode" tar ((:url . "https://github.com/emacs-lsp/lsp-focus") (:commit . "d01f0af156e4e78dcb9fa8e080a652cf8f221d30") (:revdesc . "d01f0af156e4") (:keywords "languages" "lsp-mode"))]) + (lsp-focus . [(20241119 1451) ((emacs (27 1)) (focus (0 1 1)) (lsp-mode (6 1))) "Focus.el support for lsp-mode" tar ((:url . "https://github.com/emacs-lsp/lsp-focus") (:commit . "3420d82c6c8635b4184ebacd50e0902deeeb9845") (:revdesc . "3420d82c6c86") (:keywords "languages" "lsp-mode"))]) (lsp-grammarly . [(20240229 115) ((emacs (27 1)) (lsp-mode (6 1)) (grammarly (0 3 0)) (request (0 3 0)) (s (1 12 0)) (ht (2 3))) "LSP Clients for Grammarly" tar ((:url . "https://github.com/emacs-grammarly/lsp-grammarly") (:commit . "39deb23b282785eaffc6ae17838c92c613a49315") (:revdesc . "39deb23b2827") (:keywords "convenience" "lsp" "grammarly" "checker") (:authors ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Jen-Chieh" . "jcs090218@gmail.com"))]) (lsp-haskell . [(20241024 1701) ((emacs (27 1)) (lsp-mode (3 0)) (haskell-mode (16 1))) "Haskell support for lsp-mode" tar ((:url . "https://github.com/emacs-lsp/lsp-haskell") (:commit . "6981f8d1225c038c1a130e8cf70530cfe15f976e") (:revdesc . "6981f8d1225c") (:keywords "haskell"))]) (lsp-intellij . [(20180831 2051) ((emacs (25 1)) (lsp-mode (4 1))) "Intellij lsp client" tar ((:url . "https://github.com/Ruin0x11/lsp-intellij") (:commit . "cf30f0ac63bd0140e758840b8ab070e8313697b2") (:revdesc . "cf30f0ac63bd") (:keywords "languages" "processes" "tools") (:authors ("Ruin0x11" . "ipickering2@gmail.com")) (:maintainers ("Ruin0x11" . "ipickering2@gmail.com")) (:maintainer "Ruin0x11" . "ipickering2@gmail.com"))]) - (lsp-ivy . [(20220831 1823) ((emacs (25 1)) (dash (2 14 1)) (lsp-mode (6 2 1)) (ivy (0 13 0))) "LSP ivy integration" tar ((:url . "https://github.com/emacs-lsp/lsp-ivy") (:commit . "9ecf4dd9b1207109802bd1882aa621eb1c385106") (:revdesc . "9ecf4dd9b120") (:keywords "languages" "debug"))]) + (lsp-ivy . [(20241119 1452) ((emacs (27 1)) (dash (2 14 1)) (lsp-mode (6 2 1)) (ivy (0 13 0))) "LSP ivy integration" tar ((:url . "https://github.com/emacs-lsp/lsp-ivy") (:commit . "553276f3c8a6bc15859a9be666b0a50af65e9bc6") (:revdesc . "553276f3c8a6") (:keywords "languages" "debug"))]) (lsp-java . [(20240524 2207) ((emacs (27 1)) (lsp-mode (6 0)) (markdown-mode (2 3)) (dash (2 18 0)) (f (0 20 0)) (ht (2 0)) (request (0 3 0)) (treemacs (2 5)) (dap-mode (0 5))) "Java support for lsp-mode" tar ((:url . "https://github.com/emacs-lsp/lsp-java") (:commit . "4909c14b9012eed669a9c3f11a8df055d5bb8a0e") (:revdesc . "4909c14b9012") (:keywords "languague" "tools"))]) (lsp-javacomp . [(20190124 1755) ((emacs (25 1)) (lsp-mode (3 0)) (s (1 2 0))) "Provide Java IDE features powered by JavaComp" tar ((:url . "https://github.com/tigersoldier/lsp-javacomp") (:commit . "82aa4ad6ca03a74565c35e855b318b1887bcd89b") (:revdesc . "82aa4ad6ca03") (:keywords "java" "tools" "lsp"))]) (lsp-jedi . [(20230824 1908) ((emacs (25 1)) (lsp-mode (6 0))) "Lsp client plugin for Python Jedi Language Server" tar ((:url . "https://github.com/fredcamps/lsp-jedi") (:commit . "3c828df8dd422dbb94856cc99db6f9acb52b871d") (:revdesc . "3c828df8dd42") (:keywords "language-server" "tools" "python" "jedi" "ide") (:authors ("Fred Campos" . "fred.tecnologia@gmail.com")))]) @@ -3178,7 +3181,7 @@ (lsp-latex . [(20241006 800) ((emacs (27 1)) (lsp-mode (6 0)) (consult (0 35))) "LSP-mode client for LaTeX, on texlab" tar ((:url . "https://github.com/ROCKTAKEY/lsp-latex") (:commit . "36a37a8e0a6b0edbea8e67dab89d12980d2a368f") (:revdesc . "36a37a8e0a6b") (:keywords "languages" "tex") (:authors ("ROCKTAKEY" . "rocktakey@gmail.com")) (:maintainers ("ROCKTAKEY" . "rocktakey@gmail.com")) (:maintainer "ROCKTAKEY" . "rocktakey@gmail.com"))]) (lsp-ltex . [(20240425 2049) ((emacs (27 1)) (lsp-mode (6 1))) "LSP Clients for LTEX" tar ((:url . "https://github.com/emacs-languagetool/lsp-ltex") (:commit . "c473ed37aa0f2769bb0b4c344cc28f95975dbc17") (:revdesc . "c473ed37aa0f") (:keywords "convenience" "lsp" "languagetool" "checker") (:authors ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Jen-Chieh" . "jcs090218@gmail.com"))]) (lsp-metals . [(20241112 1142) ((emacs (27 1)) (scala-mode (0 23)) (lsp-mode (7 0)) (lsp-treemacs (0 2)) (dap-mode (0 3)) (dash (2 18 0)) (f (0 20 0)) (ht (2 0)) (treemacs (3 1))) "Scala Client settings" tar ((:url . "https://github.com/emacs-lsp/lsp-metals") (:commit . "b5139c959336758a93d0e55458e6ca938d9fd16a") (:revdesc . "b5139c959336") (:keywords "languages" "extensions") (:authors ("Ross A. Baker" . "ross@rossabaker.com") ("Evgeny Kurnevsky" . "kurnevsky@gmail.com")) (:maintainers ("Ross A. Baker" . "ross@rossabaker.com") ("Evgeny Kurnevsky" . "kurnevsky@gmail.com")) (:maintainer "Ross A. Baker" . "ross@rossabaker.com"))]) - (lsp-mode . [(20241113 743) ((emacs (27 1)) (dash (2 18 0)) (f (0 20 0)) (ht (2 3)) (spinner (1 7 3)) (markdown-mode (2 3)) (lv (0)) (eldoc (1 11))) "LSP mode" tar ((:url . "https://github.com/emacs-lsp/lsp-mode") (:commit . "c41769e32c8db9bb7357bf078def7255477798ac") (:revdesc . "c41769e32c8d") (:keywords "languages"))]) + (lsp-mode . [(20241119 828) ((emacs (27 1)) (dash (2 18 0)) (f (0 20 0)) (ht (2 3)) (spinner (1 7 3)) (markdown-mode (2 3)) (lv (0)) (eldoc (1 11))) "LSP mode" tar ((:url . "https://github.com/emacs-lsp/lsp-mode") (:commit . "620bbd7163fa9d9281cd315ffa3ee29d83be8686") (:revdesc . "620bbd7163fa") (:keywords "languages"))]) (lsp-mssql . [(20230510 1124) ((emacs (25 1)) (lsp-mode (6 2)) (dash (2 14 1)) (f (0 20 0)) (ht (2 0)) (lsp-treemacs (0 1))) "MSSQL LSP bindings" tar ((:url . "https://github.com/emacs-lsp/lsp-mssql") (:commit . "a0dba8f86a2ace7e800a9dc8f814767625a509af") (:revdesc . "a0dba8f86a2a") (:keywords "data" "languages") (:authors ("Ivan Yonchovski" . "yyoncho@gmail.com")) (:maintainers ("Ivan Yonchovski" . "yyoncho@gmail.com")) (:maintainer "Ivan Yonchovski" . "yyoncho@gmail.com"))]) (lsp-origami . [(20230815 704) ((emacs (27 1)) (origami (1 0)) (lsp-mode (6 1))) "Origami.el support for lsp-mode" tar ((:url . "https://github.com/emacs-lsp/lsp-origami") (:commit . "86aa06517910141c3d5054eea5f7723461fce6a6") (:revdesc . "86aa06517910") (:keywords "languages" "lsp-mode"))]) (lsp-p4 . [(20190127 1049) ((lsp-mode (3 0))) "P4 support for lsp-mode" tar ((:url . "https://github.com/dmakarov/p4ls") (:commit . "084e33a5782f9153502d9b03e63d9cbbe81cdaeb") (:revdesc . "084e33a5782f") (:keywords "lsp" "p4"))]) @@ -3278,7 +3281,7 @@ (mark-tools . [(20130614 1025) nil "Some simple tools to access the mark-ring in Emacs" tar ((:url . "https://github.com/stsquad/emacs-mark-tools") (:commit . "a11b61effa90bd0abc876d12573674d36fc17f0c") (:revdesc . "a11b61effa90") (:authors ("Alex Bennée" . "alex@bennee.com")) (:maintainers ("Alex Bennée" . "alex@bennee.com")) (:maintainer "Alex Bennée" . "alex@bennee.com"))]) (mark-yank . [(20231105 2027) ((emacs (24 4))) "Set region to the last yank" tar ((:url . "https://github.com/mkleehammer/mark-yank") (:commit . "7207aabe9edd0872ec6d506a58b942b43926c122") (:revdesc . "7207aabe9edd") (:authors ("Michael Kleehammer" . "michael@kleehammer.com")) (:maintainers ("Michael Kleehammer" . "michael@kleehammer.com")) (:maintainer "Michael Kleehammer" . "michael@kleehammer.com"))]) (markdown-changelog . [(20230805 1720) ((emacs (26)) (dash (2 13 0))) "Maintain changelog entries" tar ((:url . "https://github.com/plandes/markdown-changelog") (:commit . "403d2cd1cff932ae135692d57062824892e01d13") (:revdesc . "403d2cd1cff9") (:keywords "markdown" "changelog" "files"))]) - (markdown-mode . [(20241117 307) ((emacs (27 1))) "Major mode for Markdown-formatted text" tar ((:url . "https://github.com/jrblevin/markdown-mode") (:commit . "1716694217bfb802f768d2353cb801459027c294") (:revdesc . "1716694217bf") (:keywords "markdown" "github flavored markdown" "itex") (:authors ("Jason R. Blevins" . "jblevins@xbeta.org")) (:maintainers ("Jason R. Blevins" . "jblevins@xbeta.org")) (:maintainer "Jason R. Blevins" . "jblevins@xbeta.org"))]) + (markdown-mode . [(20241117 1510) ((emacs (27 1))) "Major mode for Markdown-formatted text" tar ((:url . "https://github.com/jrblevin/markdown-mode") (:commit . "b8637bae075231d70fe7f845305eaba2c0240d89") (:revdesc . "b8637bae0752") (:keywords "markdown" "github flavored markdown" "itex") (:authors ("Jason R. Blevins" . "jblevins@xbeta.org")) (:maintainers ("Jason R. Blevins" . "jblevins@xbeta.org")) (:maintainer "Jason R. Blevins" . "jblevins@xbeta.org"))]) (markdown-preview-eww . [(20160111 1502) ((emacs (24 4))) "Realtime preview by eww" tar ((:url . "https://github.com/niku/markdown-preview-eww") (:commit . "5853f836425c877c8a956501f0adda137ef1d3b7") (:revdesc . "5853f836425c") (:authors ("niku" . "niku@niku.name")) (:maintainers ("niku" . "niku@niku.name")) (:maintainer "niku" . "niku@niku.name"))]) (markdown-preview-mode . [(20230707 803) ((emacs (24 4)) (websocket (1 6)) (markdown-mode (2 0)) (cl-lib (0 5)) (web-server (0 1 1))) "Markdown realtime preview minor mode" tar ((:url . "https://github.com/ancane/markdown-preview-mode") (:commit . "68242b3907dc065aa35412bfd928b43d8052d321") (:revdesc . "68242b3907dc") (:keywords "markdown" "gfm" "convenience") (:authors ("Igor Shymko" . "igor.shimko@gmail.com")) (:maintainers ("Igor Shymko" . "igor.shimko@gmail.com")) (:maintainer "Igor Shymko" . "igor.shimko@gmail.com"))]) (markdown-soma . [(20240215 228) ((emacs (25)) (s (1 11 0)) (dash (2 19 1)) (f (0 20 0))) "Live preview for Markdown" tar ((:url . "https://github.com/jasonm23/markdown-soma") (:commit . "ba30e609108d32fe6e1998490548b4631e3e48c3") (:revdesc . "ba30e609108d") (:keywords "wp" "docs" "text" "markdown") (:authors ("Jason Milkins" . "jasonm23@gmail.com")) (:maintainers ("Jason Milkins" . "jasonm23@gmail.com")) (:maintainer "Jason Milkins" . "jasonm23@gmail.com"))]) @@ -3299,7 +3302,7 @@ (math-symbol-lists . [(20220828 2047) nil "Lists of Unicode math symbols and latex commands" tar ((:url . "https://github.com/vspinu/math-symbol-lists") (:commit . "ac3eb053d3b576fcdd192b0ac6ad5090ea3a7079") (:revdesc . "ac3eb053d3b5") (:keywords "unicode" "symbols" "mathematics") (:authors ("Vitalie Spinu" . "spinuvit@gmail.com")) (:maintainers ("Vitalie Spinu" . "spinuvit@gmail.com")) (:maintainer "Vitalie Spinu" . "spinuvit@gmail.com"))]) (math-symbols . [(20201005 2313) nil "Math Symbol Input methods and conversion tools" tar ((:url . "https://github.com/kawabata/math-symbols") (:commit . "091b81cb40ceaff97614999ffe85b572ace182f0") (:revdesc . "091b81cb40ce") (:keywords "i18n" "languages" "tex") (:authors ("Taichi" . "kawabata.taichi_at_gmail.com")) (:maintainers ("Taichi" . "kawabata.taichi_at_gmail.com")) (:maintainer "Taichi" . "kawabata.taichi_at_gmail.com"))]) (math-tex-convert . [(20221210 1937) ((emacs (26 1)) (math-symbol-lists (1 3)) (auctex (12 1))) "Convert LaTeX macros to unicode and back" tar ((:url . "https://github.com/enricoflor/math-tex-convert") (:commit . "8b174d05e8e5269322a1ee90f94cf1ed018d4976") (:revdesc . "8b174d05e8e5") (:authors ("Enrico Flor" . "enrico@eflor.net")) (:maintainers ("Enrico Flor" . "enrico@eflor.net")) (:maintainer "Enrico Flor" . "enrico@eflor.net"))]) - (matlab-mode . [(20241115 753) ((emacs (27 2))) "Major mode for MATLAB(R) dot-m files" tar ((:url . "https://github.com/mathworks/Emacs-MATLAB-Mode") (:commit . "fd32f4acad18bb6e91b4d8cd39bf5353a6e308f4") (:revdesc . "fd32f4acad18") (:keywords "matlab(r)") (:authors ("Matt Wette" . "mwette@alumni.caltech.edu") ("Eric M. Ludlam" . "eludlam@mathworks.com")) (:maintainers ("Eric M. Ludlam" . "eludlam@mathworks.com")) (:maintainer "Eric M. Ludlam" . "eludlam@mathworks.com"))]) + (matlab-mode . [(20241117 1628) ((emacs (27 2))) "Major mode for MATLAB(R) dot-m files" tar ((:url . "https://github.com/mathworks/Emacs-MATLAB-Mode") (:commit . "390bca3fd9ac440e6c3dcdc524e77c7590423f08") (:revdesc . "390bca3fd9ac") (:keywords "matlab(r)") (:authors ("Matt Wette" . "mwette@alumni.caltech.edu") ("Eric M. Ludlam" . "eludlam@mathworks.com")) (:maintainers ("Eric M. Ludlam" . "eludlam@mathworks.com")) (:maintainer "Eric M. Ludlam" . "eludlam@mathworks.com"))]) (maude-mode . [(20230504 937) ((emacs (25))) "Emacs mode for the programming language Maude" tar ((:url . "https://github.com/rudi/maude-mode") (:commit . "2e1f68a890493d964f933d6e40b0ede047f70ede") (:revdesc . "2e1f68a89049") (:keywords "languages" "maude") (:authors ("Ellef Gjelstad" . "ellefg+maude*ifi.uio.no")) (:maintainers ("Rudi Schlatte" . "rudi@constantly.at")) (:maintainer "Rudi Schlatte" . "rudi@constantly.at"))]) (maven-test-mode . [(20141220 557) ((s (1 9)) (emacs (24))) "Utilities for navigating test files and running maven test tasks" tar ((:url . "https://github.com/rranelli/maven-test-mode") (:commit . "a19151861df2ad8ae4880a2e7c86ddf848cb569a") (:revdesc . "a19151861df2") (:keywords "java" "maven" "test"))]) (maxframe . [(20170120 1705) nil "Maximize the emacs frame based on display size" tar ((:url . "https://github.com/rmm5t/maxframe.el") (:commit . "13bda6dd9f1d96aa4b9dd9957a26cefd399a7772") (:revdesc . "13bda6dd9f1d") (:keywords "display" "frame" "window" "maximize"))]) @@ -3354,6 +3357,7 @@ (meyvn . [(20240905 43) ((emacs (25 1)) (cider (0 23)) (projectile (2 1)) (s (1 12)) (dash (2 17)) (parseedn (1 1 0)) (parseclj (1 1 0)) (geiser (0 12))) "Meyvn client" tar ((:url . "https://github.com/danielsz/meyvn-el") (:commit . "8d00ada6daa5617fa60f76e0be2cf2f5d1babcf9") (:revdesc . "8d00ada6daa5") (:authors ("Daniel Szmulewicz" . "daniel.szmulewicz@gmail.com")) (:maintainers ("Daniel Szmulewicz" . "daniel.szmulewicz@gmail.com")) (:maintainer "Daniel Szmulewicz" . "daniel.szmulewicz@gmail.com"))]) (mgmtconfig-mode . [(20240330 2205) ((emacs (24 3))) "Mgmt configuration management language" tar ((:url . "https://github.com/purpleidea/mgmt") (:commit . "1b00af6926d8699d9d04062f28fddd43c6340bac") (:revdesc . "1b00af6926d8") (:keywords "languages") (:authors ("Peter Oliver" . "mgmtconfig@mavit.org.uk")) (:maintainers ("Mgmt contributors" . "https://github.com/purpleidea/mgmt")) (:maintainer "Mgmt contributors" . "https://github.com/purpleidea/mgmt"))]) (mhc . [(20240419 10) ((calfw (20150703))) "Message Harmonized Calendaring system" tar ((:url . "https://github.com/yoshinari-nomura/mhc") (:commit . "b527a88748651d06222ad24f7417941088515275") (:revdesc . "b527a8874865") (:keywords "calendar") (:authors ("Yoshinari Nomura" . "nom@quickhack.net")) (:maintainers ("Yoshinari Nomura" . "nom@quickhack.net")) (:maintainer "Yoshinari Nomura" . "nom@quickhack.net"))]) + (miasma-theme . [(20241117 2101) nil "Miasma: color theme inspired by the woods" tar ((:url . "https://github.com/daut/miasma-theme.el") (:commit . "9212213d12d40c6631a30a407b1b981e1a1101f0") (:revdesc . "9212213d12d4"))]) (mic . [(20240806 1655) ((emacs (26 1))) "Minimal and combinable configuration manager" tar ((:url . "https://github.com/ROCKTAKEY/mic") (:commit . "f552ddf397e899e9c2b96ef4e56a08cc8804a1c5") (:revdesc . "f552ddf397e8") (:keywords "convenience") (:authors ("ROCKTAKEY" . "rocktakey@gmail.com")) (:maintainers ("ROCKTAKEY" . "rocktakey@gmail.com")) (:maintainer "ROCKTAKEY" . "rocktakey@gmail.com"))]) (mic-paren . [(20170731 1907) nil "Advanced highlighting of matching parentheses" tar ((:url . "https://github.com/emacsattic/mic-paren") (:commit . "d0410c7d805c9aaf51a1bcefaaef092bed5824c4") (:revdesc . "d0410c7d805c") (:keywords "languages" "faces" "parenthesis" "matching") (:authors ("Mikael Sjödin" . "(mic@docs.uu.se)") ("Klaus Berndl" . "berndl@sdm.de") ("Jonathan Kotta" . "jpkotta@gmail.com")))]) (micgoline . [(20160415 326) ((emacs (24 3)) (powerline (2 3))) "Powerline mode, color schemes from microsoft and google's logo" tar ((:url . "https://github.com/yzprofile/micgoline") (:commit . "e3e2effe4846175a3b52b4092c0c134ced5978d8") (:revdesc . "e3e2effe4846") (:keywords "mode-line" "powerline" "theme") (:authors ("yzprofile" . "yzprofiles@gmail.com")) (:maintainers ("yzprofile" . "yzprofiles@gmail.com")) (:maintainer "yzprofile" . "yzprofiles@gmail.com"))]) @@ -3385,7 +3389,7 @@ (mip-mode . [(20151127 617) nil "Virtual projects for emacs" tar ((:url . "https://gitlab.com/gaudecker/mip-mode") (:commit . "7c88c383b4c7ed0a4c1dc397735f365c1fcb461c") (:revdesc . "7c88c383b4c7") (:keywords "workspaces" "workspace" "project" "projects" "mip-mode") (:authors ("Eeli Reilin" . "gaudecker@fea.st")) (:maintainers ("Eeli Reilin" . "gaudecker@fea.st")) (:maintainer "Eeli Reilin" . "gaudecker@fea.st"))]) (mips-mode . [(20220608 1204) ((emacs (25 1))) "Major-mode for MIPS assembly" tar ((:url . "https://github.com/hlissner/emacs-mips-mode") (:commit . "98795cdc81979821ac35d9f94ce354cd99780c67") (:revdesc . "98795cdc8197") (:keywords "languages" "mips" "assembly") (:authors ("Henrik Lissner" . "http://github/hlissner")) (:maintainers ("Henrik Lissner" . "contact@henrik.io")) (:maintainer "Henrik Lissner" . "contact@henrik.io"))]) (mise . [(20241106 1515) ((emacs (29 1)) (inheritenv (0 2)) (dash (2 19 1))) "Support for `mise' cli" tar ((:url . "https://github.com/liuyinz/mise.el") (:commit . "6e32b3787dd926cc9d8e9202b5aaa82682398261") (:revdesc . "6e32b3787dd9") (:keywords "tools" "processes") (:authors ("liuyinz" . "liuyinz95@gmail.com")) (:maintainers ("Liuyinz" . "liuyinz95@gmail.com")) (:maintainer "Liuyinz" . "liuyinz95@gmail.com"))]) - (mistty . [(20241115 824) ((emacs (29 1))) "Shell/Comint alternative based on term.el" tar ((:url . "https://github.com/szermatt/mistty") (:commit . "d4732b30bc1757ace0cd0aa6bb2634024d9e5e06") (:revdesc . "d4732b30bc17") (:keywords "convenience" "unix") (:authors ("Stephane Zermatten" . "szermatt@gmx.net")) (:maintainers ("Stephane Zermatten" . "szermatt@gmx.net")) (:maintainer "Stephane Zermatten" . "szermatt@gmx.net"))]) + (mistty . [(20241115 1744) ((emacs (29 1))) "Shell/Comint alternative based on term.el" tar ((:url . "https://github.com/szermatt/mistty") (:commit . "046f79219d516e33d73b39b6f5779790cd814893") (:revdesc . "046f79219d51") (:keywords "convenience" "unix") (:authors ("Stephane Zermatten" . "szermatt@gmx.net")) (:maintainers ("Stephane Zermatten" . "szermatt@gmx.net")) (:maintainer "Stephane Zermatten" . "szermatt@gmx.net"))]) (mix . [(20240122 720) ((emacs (25 1))) "Mix Major Mode. Build Elixir using Mix" tar ((:url . "https://github.com/ayrat555/mix.el") (:commit . "16cc69cbf919769c191b1c49c1cab324fd0682a9") (:revdesc . "16cc69cbf919") (:keywords "tools") (:authors ("Ayrat Badykov" . "ayratin555@gmail.com")) (:maintainers ("Ayrat Badykov" . "ayratin555@gmail.com")) (:maintainer "Ayrat Badykov" . "ayratin555@gmail.com"))]) (mixed-pitch . [(20210304 1900) ((emacs (24 3))) "Use a variable pitch, keeping fixed pitch where it's sensible" tar ((:url . "https://gitlab.com/jabranham/mixed-pitch") (:commit . "519e05f74825abf04b7d2e0e38ec040d013a125a") (:revdesc . "519e05f74825") (:authors ("J. Alexander Branham" . "branham@utexas.edu")) (:maintainers ("J. Alexander Branham" . "branham@utexas.edu")) (:maintainer "J. Alexander Branham" . "branham@utexas.edu"))]) (mkdown . [(20140517 1418) ((markdown-mode (2 0))) "Pretty Markdown previews based on mkdown.com" tar ((:url . "https://github.com/ajtulloch/mkdown.el") (:commit . "8e23de82719af6c5b53b52b3308a02b3a1fb872e") (:revdesc . "8e23de82719a") (:keywords "markdown"))]) @@ -3411,7 +3415,7 @@ (modern-sh . [(20211101 1001) ((emacs (25 1)) (hydra (0 15 0)) (eval-in-repl (0 9 7))) "Minor mode for editing shell script" tar ((:url . "https://github.com/damon-kwok/modern-sh") (:commit . "8ebebe77304aa8170f7af809e7564c79d3bd45da") (:revdesc . "8ebebe77304a") (:keywords "languages" "programming"))]) (modtime-skip-mode . [(20140128 2201) nil "Minor mode for disabling modtime and supersession checks on files" tar ((:url . "https://github.com/jordonbiondo/modtime-skip-mode") (:commit . "c0e49523aa26b2263a8693691ac775988015f592") (:revdesc . "c0e49523aa26") (:authors ("Jordon Biondo" . "biondoj@mail.gvsu.edu")) (:maintainers ("Jordon Biondo" . "biondoj@mail.gvsu.edu")) (:maintainer "Jordon Biondo" . "biondoj@mail.gvsu.edu"))]) (modular-config . [(20210726 1614) ((emacs (25 1))) "Organize your config into small and loadable modules" tar ((:url . "https://github.com/SidharthArya/modular-config.el") (:commit . "043907d96efff70dfaea1e721de90bd35970e8bd") (:revdesc . "043907d96eff") (:keywords "startup" "lisp" "tools") (:authors ("Sidharth Arya" . "sidhartharya10@gmail.com")) (:maintainers ("Sidharth Arya" . "sidhartharya10@gmail.com")) (:maintainer "Sidharth Arya" . "sidhartharya10@gmail.com"))]) - (modus-themes . [(20241117 743) ((emacs (28 1))) "Elegant, highly legible and customizable themes" tar ((:url . "https://github.com/protesilaos/modus-themes") (:commit . "dc0d606e2a7058485913cbb33f27bad8e66c2d7b") (:revdesc . "dc0d606e2a70") (:keywords "faces" "theme" "accessibility") (:authors ("Protesilaos Stavrou" . "info@protesilaos.com")) (:maintainers ("Protesilaos Stavrou" . "info@protesilaos.com")) (:maintainer "Protesilaos Stavrou" . "info@protesilaos.com"))]) + (modus-themes . [(20241120 542) ((emacs (28 1))) "Elegant, highly legible and customizable themes" tar ((:url . "https://github.com/protesilaos/modus-themes") (:commit . "df1798234edd56678da975d0d65b64bdebafc314") (:revdesc . "df1798234edd") (:keywords "faces" "theme" "accessibility") (:authors ("Protesilaos Stavrou" . "info@protesilaos.com")) (:maintainers ("Protesilaos Stavrou" . "info@protesilaos.com")) (:maintainer "Protesilaos Stavrou" . "info@protesilaos.com"))]) (moe-theme . [(20240716 854) nil "A colorful eye-candy theme. Moe, moe, kyun!" tar ((:url . "https://github.com/kuanyui/moe-theme.el") (:commit . "4b3642157bfe9a9268310d321cfe67c8c236b5e1") (:revdesc . "4b3642157bfe") (:keywords "themes") (:authors ("kuanyui" . "azazabc123@gmail.com")) (:maintainers ("kuanyui" . "azazabc123@gmail.com")) (:maintainer "kuanyui" . "azazabc123@gmail.com"))]) (molar-mass . [(20220922 1752) ((emacs (24 3))) "Calculates molar mass of a molecule" tar ((:url . "https://github.com/sergiruiztrepat/molar-mass") (:commit . "c3b686c4b621b45fa4b17857b4934eb4487d74f5") (:revdesc . "c3b686c4b621") (:keywords "convenience" "chemistry"))]) (molecule . [(20180527 743) ((emacs (25 1))) "Simple wrapper for molecule" tar ((:url . "https://gitlab.com/drymerisnothere/molecule-el") (:commit . "2ef72b81d9aa24ea782b71a061a3abdad6cae162") (:revdesc . "2ef72b81d9aa") (:keywords ":" "languages" "terminals") (:authors ("drymer" . "drymer[AT]autistici.org")) (:maintainers ("drymer" . "drymer[AT]autistici.org")) (:maintainer "drymer" . "drymer[AT]autistici.org"))]) @@ -3444,7 +3448,7 @@ (mote-mode . [(20160123 29) ((ruby-mode (1 1))) "Mote minor mode" tar ((:url . "https://github.com/inkel/mote-mode") (:commit . "666c6641addbd3b337a7aa01fd2742ded2f41b83") (:revdesc . "666c6641addb") (:authors ("Leandro López" . "inkel.ar@gmail.com")) (:maintainers ("Leandro López" . "inkel.ar@gmail.com")) (:maintainer "Leandro López" . "inkel.ar@gmail.com"))]) (motion-mode . [(20140920 156) ((flymake-easy (0 7)) (flymake-cursor (1 0 2))) "Major mode for RubyMotion enviroment" tar ((:url . "https://github.com/ainame/motion-mode") (:commit . "4c94180e3ecea611a61240a0c0cd48f1032c4a55") (:revdesc . "4c94180e3ece"))]) (move-dup . [(20210127 1938) ((emacs (25 1))) "Eclipse-like moving and duplicating lines or rectangles" tar ((:url . "https://github.com/wyuenho/move-dup") (:commit . "bf2e578b89d7e7bf0b5500d9afcf49ac6ec2dcd1") (:revdesc . "bf2e578b89d7") (:keywords "convenience" "text" "edit") (:authors ("Jimmy Yuen Ho Wong" . "wyuenho@gmail.com")) (:maintainers ("Jimmy Yuen Ho Wong" . "wyuenho@gmail.com")) (:maintainer "Jimmy Yuen Ho Wong" . "wyuenho@gmail.com"))]) - (move-mode . [(20240409 2159) ((emacs (25 1))) "A major-mode for editing Move language" tar ((:url . "https://github.com/amnn/move-mode") (:commit . "f974cc69f279c45026f7386e0194be74779334a8") (:revdesc . "f974cc69f279") (:keywords "languages"))]) + (move-mode . [(20241118 1527) ((emacs (25 1))) "A major-mode for editing Move language" tar ((:url . "https://github.com/amnn/move-mode") (:commit . "6e4aaf6aae1e9b4aee096557c9f7b1f3550a1e59") (:revdesc . "6e4aaf6aae1e") (:keywords "languages"))]) (move-text . [(20231204 1514) nil "Move current line or region with M-up or M-down" tar ((:url . "https://github.com/emacsfodder/move-text") (:commit . "90ef0b078dbcb2dee47a15b0c6c6f417101e0c43") (:revdesc . "90ef0b078dbc") (:keywords "edit") (:authors ("Jason Milkins" . "jasonm23@gmail.com")) (:maintainers ("Jason Milkins" . "jasonm23@gmail.com")) (:maintainer "Jason Milkins" . "jasonm23@gmail.com"))]) (mowedline . [(20171218 237) nil "Elisp utilities for using mowedline" tar ((:url . "https://github.com/retroj/mowedline") (:commit . "c17501b48ded8261d815ab60bf14cddf7040be72") (:revdesc . "c17501b48ded") (:authors ("John Foerch" . "jjfoerch@earthlink.net")) (:maintainers ("John Foerch" . "jjfoerch@earthlink.net")) (:maintainer "John Foerch" . "jjfoerch@earthlink.net"))]) (mowie . [(20240626 717) ((emacs (28 1))) "Cycle Through Point-Moving Commands" tar ((:url . "https://codeberg.org/mekeor/mowie") (:commit . "5236a231c172ffe3a831bb649031f4a1aaec5b15") (:revdesc . "5236a231c172") (:keywords "convenience") (:authors ("Mekeor Melire" . "mekeor@posteo.de")) (:maintainers ("Mekeor Melire" . "mekeor@posteo.de")) (:maintainer "Mekeor Melire" . "mekeor@posteo.de"))]) @@ -3661,7 +3665,7 @@ (ob-blockdiag . [(20210412 1541) nil "Org-babel functions for blockdiag evaluation" tar ((:url . "https://github.com/corpix/ob-blockdiag.el") (:commit . "e997644e81cc67a7092e6e9bb13c66f160491efb") (:revdesc . "e997644e81cc") (:keywords "tools" "convenience"))]) (ob-browser . [(20170720 1918) ((org (8))) "Render HTML in org-mode blocks" tar ((:url . "https://github.com/krisajenkins/ob-browser") (:commit . "a347d9df1c87b7eb660be8723982c7ad2563631a") (:revdesc . "a347d9df1c87") (:keywords "org" "babel" "browser" "phantomjs") (:authors ("Kris Jenkins" . "krisajenkins@gmail.com")) (:maintainers ("Kris Jenkins" . "krisajenkins@gmail.com")) (:maintainer "Kris Jenkins" . "krisajenkins@gmail.com"))]) (ob-cfengine3 . [(20230226 1954) ((emacs (24 1))) "Org Babel functions for CFEngine 3" tar ((:url . "https://github.com/nickanderson/ob-cfengine3") (:commit . "52aa32fdfa412860837e795d17d50dac237e56e4") (:revdesc . "52aa32fdfa41") (:keywords "tools" "convenience") (:authors ("Nick Anderson" . "nick@cmdln.org")) (:maintainers ("Nick Anderson" . "nick@cmdln.org")) (:maintainer "Nick Anderson" . "nick@cmdln.org"))]) - (ob-chatgpt-shell . [(20241112 1848) ((emacs (27 1)) (chatgpt-shell (1 22 1))) "Org babel functions for ChatGPT evaluation" tar ((:url . "https://github.com/xenodium/ob-chatgpt-shell") (:commit . "a5ac132f8066a4029e72ba11267e6251de24c759") (:revdesc . "a5ac132f8066"))]) + (ob-chatgpt-shell . [(20241118 1001) ((emacs (27 1)) (chatgpt-shell (2 0 1))) "Org babel functions for ChatGPT evaluation" tar ((:url . "https://github.com/xenodium/ob-chatgpt-shell") (:commit . "754ddf54a99bd98427c91a6c7374757026f8bd45") (:revdesc . "754ddf54a99b"))]) (ob-clojurescript . [(20180406 1828) ((emacs (24 4)) (org (9 0))) "Org-babel functions for ClojureScript evaluation" tar ((:url . "https://gitlab.com/statonjr/ob-clojurescript") (:commit . "17ee1558aa94c7b0246fd03f684884122806cfe7") (:revdesc . "17ee1558aa94") (:keywords "literate programming" "reproducible research"))]) (ob-coffee . [(20170725 1424) ((org (8))) "Org-babel functions for coffee-script evaluation" tar ((:url . "https://github.com/zweifisch/ob-coffee") (:commit . "7f0b330273e8af7777de87a75fe52a89798e4548") (:revdesc . "7f0b330273e8") (:keywords "org" "babel" "coffee-script") (:authors ("ZHOU Feng" . "zf.pascal@gmail.com")) (:maintainers ("ZHOU Feng" . "zf.pascal@gmail.com")) (:maintainer "ZHOU Feng" . "zf.pascal@gmail.com"))]) (ob-coffeescript . [(20180126 719) ((emacs (24 4))) "Org-babel functions for coffee-script evaluation, and fully implementation!" tar ((:url . "https://github.com/brantou/ob-coffeescript") (:commit . "5a5bb04aea9c2a6eab5b05f90f5c7cb6de7b4261") (:revdesc . "5a5bb04aea9c") (:keywords "coffee-script" "literate programming" "reproducible research") (:authors ("Brantou" . "brantou89@gmail.com")) (:maintainers ("Brantou" . "brantou89@gmail.com")) (:maintainer "Brantou" . "brantou89@gmail.com"))]) @@ -3719,7 +3723,7 @@ (ob-sql-mode . [(20190421 1539) ((emacs (24 4))) "SQL code blocks evaluated by sql-mode" tar ((:url . "https://github.com/nikclayton/ob-sql-mode") (:commit . "b31a016585324ad91f1742ff6205bcb76f3ece6e") (:revdesc . "b31a01658532") (:keywords "languages" "org" "org-babel" "sql") (:authors (nil . "NikClaytonnik@google.com")) (:maintainers (nil . "NikClaytonnik@google.com")) (:maintainer nil . "NikClaytonnik@google.com"))]) (ob-svgbob . [(20190911 300) ((emacs (24))) "Babel Functions for svgbob" tar ((:url . "https://github.com/mgxm/ob-svgbob") (:commit . "5747f96fb4fdb8711546b3313df9412177eb3c1a") (:revdesc . "5747f96fb4fd") (:keywords "tools" "files") (:authors ("Marcio Giaxa" . "i@mgxm.me")) (:maintainers ("Marcio Giaxa" . "i@mgxm.me")) (:maintainer "Marcio Giaxa" . "i@mgxm.me"))]) (ob-swift . [(20170921 1325) ((org (8))) "Org-babel functions for swift evaluation" tar ((:url . "https://github.com/zweifisch/ob-swift") (:commit . "ed478ddbbe41ce5373efde06b4dd0c3663c9055f") (:revdesc . "ed478ddbbe41") (:keywords "org" "babel" "swift") (:authors ("Feng Zhou" . "zf.pascal@gmail.com")) (:maintainers ("Feng Zhou" . "zf.pascal@gmail.com")) (:maintainer "Feng Zhou" . "zf.pascal@gmail.com"))]) - (ob-swiftui . [(20231009 918) ((emacs (25 1)) (swift-mode (8 2 0)) (org (9 2 0))) "Org babel functions for SwiftUI evaluation" tar ((:url . "https://github.com/xenodium/ob-swiftui") (:commit . "af65a8e60602ca90ab3f61811190a3da67ac0414") (:revdesc . "af65a8e60602"))]) + (ob-swiftui . [(20241119 1735) ((emacs (25 1)) (swift-mode (8 2 0)) (org (9 2 0))) "Org babel functions for SwiftUI evaluation" tar ((:url . "https://github.com/xenodium/ob-swiftui") (:commit . "c16b4cddb5387fcebdd1d61a4c6c015f778d2d08") (:revdesc . "c16b4cddb538"))]) (ob-tmux . [(20221005 2025) ((emacs (25 1)) (seq (2 3)) (s (1 9 0))) "Babel Support for Interactive Terminal" tar ((:url . "https://github.com/ahendriksen/ob-tmux") (:commit . "e672ca5a9534b9f33ed7aa5cd21b88189ccc5697") (:revdesc . "e672ca5a9534") (:keywords "literate programming" "interactive shell" "tmux"))]) (ob-translate . [(20170720 1919) ((google-translate (0 11)) (org (8))) "Translation of text blocks in org-mode" tar ((:url . "https://github.com/krisajenkins/ob-translate") (:commit . "9d9054a51bafd5a29a8135964069b4fa3a80b169") (:revdesc . "9d9054a51baf") (:keywords "org" "babel" "translate" "translation") (:authors ("Kris Jenkins" . "krisajenkins@gmail.com")) (:maintainers ("Kris Jenkins" . "krisajenkins@gmail.com")) (:maintainer "Kris Jenkins" . "krisajenkins@gmail.com"))]) (ob-typescript . [(20231227 311) ((emacs (24)) (org (8 0))) "Org-babel functions for typescript evaluation" tar ((:url . "https://github.com/lurdan/ob-typescript") (:commit . "5fe1762f8d8692dd5b6f1697bedbbf4cae9ef036") (:revdesc . "5fe1762f8d86") (:keywords "literate programming" "reproducible research" "typescript"))]) @@ -3835,7 +3839,7 @@ (org-dashboard . [(20171223 1924) ((cl-lib (0 5))) "Visually summarize progress in org files" tar ((:url . "https://github.com/bard/org-dashboard") (:commit . "02c0699771d199075a286e4502340ca6e7c9e831") (:revdesc . "02c0699771d1") (:keywords "outlines" "calendar") (:authors ("Massimiliano Mirra" . "hyperstruct@gmail.com")) (:maintainers ("Massimiliano Mirra" . "hyperstruct@gmail.com")) (:maintainer "Massimiliano Mirra" . "hyperstruct@gmail.com"))]) (org-doing . [(20161017 1620) nil "Keep track of what you're doing" tar ((:url . "https://github.com/emacsattic/org-doing") (:commit . "4819e75c827c2115bd28f3b3148d846aa64ccd9b") (:revdesc . "4819e75c827c") (:keywords "tools" "org"))]) (org-dotemacs . [(20211126 2038) ((org (7 9 3)) (cl-lib (0 5))) "Store your emacs config as an org file, and choose which bits to load" tar ((:url . "https://github.com/vapniks/org-dotemacs") (:commit . "598759f4a139f94da62836e8f8064da6377536b2") (:revdesc . "598759f4a139") (:keywords "local") (:authors ("Joe Bloggs" . "vapniks@yahoo.com")) (:maintainers ("Joe Bloggs" . "vapniks@yahoo.com")) (:maintainer "Joe Bloggs" . "vapniks@yahoo.com"))]) - (org-download . [(20220906 1929) ((emacs (24 3)) (async (1 2))) "Image drag-and-drop for Org-mode" tar ((:url . "https://github.com/abo-abo/org-download") (:commit . "19e166f0a8c539b4144cfbc614309d47a9b2a9b7") (:revdesc . "19e166f0a8c5") (:keywords "multimedia" "images" "screenshots" "download"))]) + (org-download . [(20241118 1846) ((emacs (24 3)) (async (1 2))) "Image drag-and-drop for Org-mode" tar ((:url . "https://github.com/abo-abo/org-download") (:commit . "c8be2611786d1d8d666b7b4f73582de1093f25ac") (:revdesc . "c8be2611786d") (:keywords "multimedia" "images" "screenshots" "download"))]) (org-dp . [(20180311 923) ((cl-lib (0 5))) "Declarative Local Programming with Org Elements" tar ((:url . "https://github.com/tj64/org-dp") (:commit . "334fefd06eb925c86b1642787b2a088aa0932bab") (:revdesc . "334fefd06eb9") (:authors ("Thorsten Jolitz" . "tjolitzATgmailDOTcom")) (:maintainers ("Thorsten Jolitz" . "tjolitzATgmailDOTcom")) (:maintainer "Thorsten Jolitz" . "tjolitzATgmailDOTcom"))]) (org-drawio . [(20240213 38) ((org (9 6 6)) (emacs (28 1))) "Convert and include drawio image to orgmode" tar ((:url . "https://github.com/kimim/org-drawio") (:commit . "6b25d0ecf7de364da96c96da30a995df8a4cb835") (:revdesc . "6b25d0ecf7de") (:keywords "multimedia" "convenience") (:authors ("Kimi Ma" . "kimi.im@outlook.com")) (:maintainers ("Kimi Ma" . "kimi.im@outlook.com")) (:maintainer "Kimi Ma" . "kimi.im@outlook.com"))]) (org-drill . [(20210427 2003) ((emacs (25 3)) (seq (2 14)) (org (9 3)) (persist (0 3))) "Self-testing using spaced repetition" tar ((:url . "https://gitlab.com/phillord/org-drill") (:commit . "e55415221eedba2f2bd37a30cb71c842e344b5ee") (:revdesc . "e55415221eed") (:keywords "games" "outlines" "multimedia") (:authors ("Paul Sexton" . "eeeickythump@gmail.com")) (:maintainers ("Phillip Lord" . "phillip.lord@russet.org.uk")) (:maintainer "Phillip Lord" . "phillip.lord@russet.org.uk"))]) @@ -3890,15 +3894,15 @@ (org-mobile-sync . [(20180606 524) ((emacs (24 3 50)) (org (8 0))) "Automatically sync org-mobile on changes" tar ((:url . "https://framagit.org/steckerhalter/org-mobile-sync.git") (:commit . "06764b943a528827df1e2acc6bc7806cc2c1351f") (:revdesc . "06764b943a52") (:keywords "org-mode" "org" "mobile" "sync" "todo"))]) (org-modern . [(20240926 922) ((emacs (28 1)) (compat (30))) "Modern looks for Org" tar ((:url . "https://github.com/minad/org-modern") (:commit . "5b7e8195744f9b6a14a5c72bd13ae52e86952d72") (:revdesc . "5b7e8195744f") (:keywords "outlines" "hypermedia" "text") (:authors ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainers ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainer "Daniel Mendler" . "mail@daniel-mendler.de"))]) (org-movies . [(20210920 101) ((emacs (26 1)) (org (9 0)) (request (0 3 0))) "Manage watchlist with Org mode" tar ((:url . "https://github.com/teeann/org-movies") (:commit . "e96fecaffa2924de64a507aa31d2934e667ee1ea") (:revdesc . "e96fecaffa29") (:keywords "hypermedia" "outlines" "org"))]) - (org-mpv-notes . [(20240926 138) ((emacs (28 1))) "Take notes in org mode while watching videos in mpv" tar ((:url . "https://github.com/bpanthi977/org-mpv-notes") (:commit . "22b9ac4c0bf3144f0a8ac3fb370efe0ac074d128") (:revdesc . "22b9ac4c0bf3") (:authors ("Bibek Panthi" . "bpanthi977@gmail.com")) (:maintainers ("Bibek Panthi" . "bpanthi977@gmail.com")) (:maintainer "Bibek Panthi" . "bpanthi977@gmail.com"))]) + (org-mpv-notes . [(20241119 1627) ((emacs (28 1))) "Take notes in org mode while watching videos in mpv" tar ((:url . "https://github.com/bpanthi977/org-mpv-notes") (:commit . "f6c0fc5546cf7168d997a3605cce7c08714cb599") (:revdesc . "f6c0fc5546cf") (:authors ("Bibek Panthi" . "bpanthi977@gmail.com")) (:maintainers ("Bibek Panthi" . "bpanthi977@gmail.com")) (:maintainer "Bibek Panthi" . "bpanthi977@gmail.com"))]) (org-mru-clock . [(20240522 826) ((emacs (26 1))) "Clock in/out of tasks with completion and persistent history" tar ((:url . "https://github.com/unhammer/org-mru-clock") (:commit . "198beb2089ea5e457dd13e8ac64d775eeff8fd89") (:revdesc . "198beb2089ea") (:keywords "convenience" "calendar") (:authors ("Kevin Brubeck Unhammer" . "unhammer@fsfe.org")) (:maintainers ("Kevin Brubeck Unhammer" . "unhammer@fsfe.org")) (:maintainer "Kevin Brubeck Unhammer" . "unhammer@fsfe.org"))]) (org-msg . [(20240902 447) ((emacs (24 4)) (htmlize (1 54))) "Org mode to send and reply to email in HTML" tar ((:url . "https://github.com/jeremy-compostella/org-msg") (:commit . "59e2042e5f23e25f31c6aef0db1e70c6f54f117d") (:revdesc . "59e2042e5f23") (:keywords "extensions" "mail") (:authors ("Jérémy Compostella" . "jeremy.compostella@gmail.com")) (:maintainers ("Jérémy Compostella" . "jeremy.compostella@gmail.com")) (:maintainer "Jérémy Compostella" . "jeremy.compostella@gmail.com"))]) (org-multi-wiki . [(20210324 1820) ((emacs (26 1)) (dash (2 12)) (s (1 12)) (org-ql (0 5)) (org (9 3))) "Multiple wikis based on Org mode" tar ((:url . "https://github.com/akirak/org-multi-wiki") (:commit . "bf8039aadddaf02569fab473f766071ef7e63563") (:revdesc . "bf8039aaddda") (:keywords "org" "outlines" "files") (:authors ("Akira Komamura" . "akira.komamura@gmail.com")) (:maintainers ("Akira Komamura" . "akira.komamura@gmail.com")) (:maintainer "Akira Komamura" . "akira.komamura@gmail.com"))]) (org-multiple-keymap . [(20191017 1920) ((org (8 2 4)) (emacs (24)) (cl-lib (0 5))) "Set keymap to elements, such as timestamp and priority" tar ((:url . "https://github.com/emacsattic/org-multiple-keymap") (:commit . "4eb8aa0aada012b2346cc7f0c55e07783141a2c3") (:revdesc . "4eb8aa0aada0") (:keywords "convenience" "org-mode") (:authors ("myuhe" . "yuhei.maeda_at_gmail.com")))]) (org-newtab . [(20240227 155) ((emacs (27 1)) (websocket (1 14)) (async (1 9 7))) "Supercharge your browser's new tab page" tar ((:url . "https://github.com/Zweihander-Main/org-newtab") (:commit . "eca494a43e242558bd8db24d321ad62a8ec86c02") (:revdesc . "eca494a43e24") (:keywords "outlines") (:authors ("Zweihänder" . "zweidev@zweihander.me")) (:maintainers ("Zweihänder" . "zweidev@zweihander.me")) (:maintainer "Zweihänder" . "zweidev@zweihander.me"))]) (org-nix-shell . [(20240603 859) ((emacs (27 1)) (org (9 4))) "Org local nix-shell" tar ((:url . "https://github.com/AntonHakansson/org-nix-shell") (:commit . "f359d9e1053fadee86dd668f4789ae2e700d8e8a") (:revdesc . "f359d9e1053f") (:keywords "processes" "outlines") (:maintainers ("Anton Hakansson" . "anton@hakanssn.com")) (:maintainer "Anton Hakansson" . "anton@hakanssn.com"))]) - (org-node . [(20241116 320) ((emacs (28 1)) (compat (30)) (el-job (0 3 2)) (llama (0))) "Link org-id entries into a network" tar ((:url . "https://github.com/meedstrom/org-node") (:commit . "ba89d1b2c6f4f13a4fac3ca94491ee43116d39d9") (:revdesc . "ba89d1b2c6f4") (:keywords "org" "hypermedia") (:authors ("Martin Edström" . "meedstrom91@gmail.com")) (:maintainers ("Martin Edström" . "meedstrom91@gmail.com")) (:maintainer "Martin Edström" . "meedstrom91@gmail.com"))]) - (org-node-fakeroam . [(20241103 2000) ((emacs (28 1)) (compat (30)) (org-node (1 7 0)) (org-roam (2 2 2)) (emacsql (4 0 3))) "Stand-ins for org-roam-autosync-mode" tar ((:url . "https://github.com/meedstrom/org-node-fakeroam") (:commit . "d77d7c4e1570b7d0cda05a944df6ffe9b78630c8") (:revdesc . "d77d7c4e1570") (:keywords "org" "hypermedia") (:authors ("Martin Edström" . "meedstrom91@gmail.com")) (:maintainers ("Martin Edström" . "meedstrom91@gmail.com")) (:maintainer "Martin Edström" . "meedstrom91@gmail.com"))]) + (org-node . [(20241119 2031) ((emacs (28 1)) (compat (30)) (el-job (0 3 4)) (llama (0 4 0))) "Link org-id entries into a network" tar ((:url . "https://github.com/meedstrom/org-node") (:commit . "14c72ee069605d953d9e8f077391ff036aeb0a27") (:revdesc . "14c72ee06960") (:keywords "org" "hypermedia") (:authors ("Martin Edström" . "meedstrom91@gmail.com")) (:maintainers ("Martin Edström" . "meedstrom91@gmail.com")) (:maintainer "Martin Edström" . "meedstrom91@gmail.com"))]) + (org-node-fakeroam . [(20241119 1324) ((emacs (28 1)) (org-node (1 9 0)) (compat (30)) (org-roam (2 2 2)) (emacsql (4 0 3))) "Stand-ins for org-roam-autosync-mode" tar ((:url . "https://github.com/meedstrom/org-node-fakeroam") (:commit . "b7900c0d9c2623d96b35f6649da6380dcf89d93d") (:revdesc . "b7900c0d9c26") (:keywords "org" "hypermedia") (:authors ("Martin Edström" . "meedstrom91@gmail.com")) (:maintainers ("Martin Edström" . "meedstrom91@gmail.com")) (:maintainer "Martin Edström" . "meedstrom91@gmail.com"))]) (org-notebook . [(20170322 452) ((emacs (24)) (org (8)) (cl-lib (0 5))) "Ease the use of org-mode as a notebook" tar ((:url . "https://github.com/Rahi374/org-notebook") (:commit . "d90c4aeca2442161e6dd89de175561af85aace03") (:revdesc . "d90c4aeca244") (:keywords "convenience" "tools") (:authors ("Paul Elder" . "paul.elder@amanokami.net")) (:maintainers ("Paul Elder" . "paul.elder@amanokami.net")) (:maintainer "Paul Elder" . "paul.elder@amanokami.net"))]) (org-noter . [(20240918 1703) ((emacs (24 4)) (cl-lib (0 6)) (org (9 4))) "A synchronized, Org-mode, document annotator" tar ((:url . "https://github.com/org-noter/org-noter") (:commit . "691efc3ed4a2828d791a148e53851365c2eb380f") (:revdesc . "691efc3ed4a2") (:keywords "lisp" "pdf" "interleave" "annotate" "external" "sync" "notes" "documents" "org-mode") (:authors ("Gonçalo Santos" . "in@bsentia") ("Maintainer Dmitry M" . "dmitrym@gmail.com")) (:maintainers ("Peter Mao" . "peter.mao@gmail.com") ("Dmitry M" . "dmitrym@gmail.com")) (:maintainer "Peter Mao" . "peter.mao@gmail.com"))]) (org-noter-pdftools . [(20230725 1433) ((emacs (26 1)) (org (9 4)) (pdf-tools (0 8)) (org-pdftools (1 0)) (org-noter (1 4 1))) "Integration between org-pdftools and org-noter" tar ((:url . "https://github.com/fuxialexander/org-pdftools") (:commit . "4e420233a153a9c4ab3d1a7e1d7d3211c836f0ac") (:revdesc . "4e420233a153") (:keywords "convenience") (:authors ("Alexander Fu Xi" . "fuxialexander@gmail.com")) (:maintainers ("Alexander Fu Xi" . "fuxialexnader@gmail.com")) (:maintainer "Alexander Fu Xi" . "fuxialexnader@gmail.com"))]) @@ -4025,7 +4029,7 @@ (orthodox-christian-new-calendar-holidays . [(20210830 1657) nil "Feasts (NS)" tar ((:url . "https://github.com/cmchittom/orthodox-christian-new-calendar-holidays") (:commit . "6869024ecd45eefd0ec648979c6a59d7c79770e0") (:revdesc . "6869024ecd45") (:keywords "calendar") (:authors ("Carson Chittom" . "carson@wistly.net")) (:maintainers ("Carson Chittom" . "carson@wistly.net")) (:maintainer "Carson Chittom" . "carson@wistly.net"))]) (osa . [(20200522 2103) ((emacs (25 1))) "OSA (JavaScript / AppleScript) bridge" tar ((:url . "https://github.com/atomontage/osa") (:commit . "615ca9eef4131a23d9971691fa0d0f20fe59d01b") (:revdesc . "615ca9eef413") (:keywords "extensions") (:authors ("xristos" . "xristos@sdf.org")) (:maintainers ("xristos" . "xristos@sdf.org")) (:maintainer "xristos" . "xristos@sdf.org"))]) (osa-chrome . [(20230515 237) ((emacs (25 1)) (osa (1 0))) "Google Chrome remote tab control" tar ((:url . "https://github.com/atomontage/osa-chrome") (:commit . "981c35136102eeca77d0e1a41e7c95e8486a1dce") (:revdesc . "981c35136102") (:keywords "comm") (:authors ("xristos" . "xristos@sdf.org")) (:maintainers ("xristos" . "xristos@sdf.org")) (:maintainer "xristos" . "xristos@sdf.org"))]) - (osm . [(20241105 2132) ((emacs (28 1)) (compat (30))) "OpenStreetMap viewer" tar ((:url . "https://github.com/minad/osm") (:commit . "b17f4824fce86937dff956d4daf3b62849b27fa7") (:revdesc . "b17f4824fce8") (:keywords "network" "multimedia" "hypermedia" "mouse") (:authors ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainers ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainer "Daniel Mendler" . "mail@daniel-mendler.de"))]) + (osm . [(20241119 2137) ((emacs (28 1)) (compat (30))) "OpenStreetMap viewer" tar ((:url . "https://github.com/minad/osm") (:commit . "ab76f8a9e79e0ec6330071b4aed974270b6f2a15") (:revdesc . "ab76f8a9e79e") (:keywords "network" "multimedia" "hypermedia" "mouse") (:authors ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainers ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainer "Daniel Mendler" . "mail@daniel-mendler.de"))]) (osx-browse . [(20140508 2041) ((string-utils (0 3 2)) (browse-url-dwim (0 6 6))) "Web browsing helpers for OS X" tar ((:url . "https://github.com/rolandwalker/osx-browse") (:commit . "838b81625853e04919fbb56fd21f387762b2e3f5") (:revdesc . "838b81625853") (:keywords "hypermedia" "external") (:authors ("Roland Walker" . "walker@pobox.com")) (:maintainers ("Roland Walker" . "walker@pobox.com")) (:maintainer "Roland Walker" . "walker@pobox.com"))]) (osx-clipboard . [(20141012 717) nil "Use the OS X clipboard from terminal Emacs" tar ((:url . "https://github.com/joddie/osx-clipboard-mode") (:commit . "e46dd31327a3f92f77b013b4c9b1e5fdd0e5c73d") (:revdesc . "e46dd31327a3") (:authors ("Jon Oddie" . "jonxfieldatgmail.com")) (:maintainers ("Jon Oddie" . "jonxfieldatgmail.com")) (:maintainer "Jon Oddie" . "jonxfieldatgmail.com"))]) (osx-dictionary . [(20240330 942) ((cl-lib (0 5))) "Interface for OSX Dictionary.app" tar ((:url . "https://github.com/xuchunyang/osx-dictionary.el") (:commit . "6abfd6908b0dc773020466225c908000870b383b") (:revdesc . "6abfd6908b0d") (:keywords "mac" "dictionary") (:authors ("Chunyang Xu" . "mail@xuchunyang.me")) (:maintainers ("Chunyang Xu" . "mail@xuchunyang.me")) (:maintainer "Chunyang Xu" . "mail@xuchunyang.me"))]) @@ -4039,7 +4043,7 @@ (other-emacs-eval . [(20180408 1348) ((emacs (25 1)) (async (1 9 2))) "Evaluate the Emacs Lisp expression in other Emacs" tar ((:url . "https://github.com/xuchunyang/other-emacs-eval") (:commit . "8ace5acafef65daabf0c6619eff60733d7f5d792") (:revdesc . "8ace5acafef6") (:keywords "tools") (:authors ("Xu Chunyang" . "mail@xuchunyang.me")) (:maintainers ("Xu Chunyang" . "mail@xuchunyang.me")) (:maintainer "Xu Chunyang" . "mail@xuchunyang.me"))]) (otpp . [(20241115 2256) ((emacs (28 1)) (compat (29 1))) "One tab per project, with unique names" tar ((:url . "https://github.com/abougouffa/one-tab-per-project") (:commit . "6507da9014b6d4b76925c089cafa62f1cb0b4500") (:revdesc . "6507da9014b6") (:keywords "convenience") (:authors ("Abdelhak Bougouffa (rot13" . "\"nobhtbhssn@srqbencebwrpg.bet\")")) (:maintainers ("Abdelhak Bougouffa (rot13" . "\"nobhtbhssn@srqbencebwrpg.bet\")")) (:maintainer "Abdelhak Bougouffa (rot13" . "\"nobhtbhssn@srqbencebwrpg.bet\")"))]) (ouroboros . [(20230606 1150) ((emacs (27 1)) (dash (2 19 0)) (cbor (0 2 5)) (bech32 (0 2 1))) "Ouroboros network mini-protocol" tar ((:url . "https://github.com/Titan-C/cardano.el") (:commit . "cf85424b305e8f89debb756dc67eebc84639f711") (:revdesc . "cf85424b305e") (:authors ("Oscar Najera" . "https://oscarnajera.com")) (:maintainers ("Oscar Najera" . "hi@oscarnajera.com")) (:maintainer "Oscar Najera" . "hi@oscarnajera.com"))]) - (outline-indent . [(20241018 1531) ((emacs (26 1))) "Fold text using indentation" tar ((:url . "https://github.com/jamescherti/outline-indent.el") (:commit . "fdfcdf4ee456f0bd58e374de45267305c982526c") (:revdesc . "fdfcdf4ee456") (:keywords "outlines"))]) + (outline-indent . [(20241119 1447) ((emacs (26 1))) "Folding text based on indentation (origami alternative)" tar ((:url . "https://github.com/jamescherti/outline-indent.el") (:commit . "60f0786a6ede572fd3dfe0bc05597f1a24fef5da") (:revdesc . "60f0786a6ede") (:keywords "outlines"))]) (outline-magic . [(20180619 1819) nil "Outline mode extensions for Emacs" tar ((:url . "https://github.com/tj64/outline-magic") (:commit . "2a5f07417b696cf7541d435c43bafcc64817636b") (:revdesc . "2a5f07417b69") (:keywords "outlines") (:authors ("Carsten Dominik" . "dominik@science.uva.nl")) (:maintainers ("Thorsten Jolitz" . "tjolitzATgmailDOTcom")) (:maintainer "Thorsten Jolitz" . "tjolitzATgmailDOTcom"))]) (outline-minor-faces . [(20240831 2209) ((emacs (26 1)) (compat (30 0 0 0))) "Highlight only section headings" tar ((:url . "https://github.com/tarsius/outline-minor-faces") (:commit . "4628613f3570b865b2c22b750ebd41443c1848c2") (:revdesc . "4628613f3570") (:keywords "faces" "outlines") (:authors ("Jonas Bernoulli" . "emacs.outline-minor-faces@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.outline-minor-faces@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.outline-minor-faces@jonas.bernoulli.dev"))]) (outline-toc . [(20200401 1208) nil "Sidebar showing a \"table of contents\"" tar ((:url . "https://github.com/abingham/outline-toc.el") (:commit . "81d373633b40628cc3a6b6fb534fd7730076bcdb") (:revdesc . "81d373633b40") (:keywords "convenience" "outlines") (:authors ("Austin Bingham" . "austin.bingham@gmail.com")) (:maintainers ("Austin Bingham" . "austin.bingham@gmail.com")) (:maintainer "Austin Bingham" . "austin.bingham@gmail.com"))]) @@ -4227,7 +4231,7 @@ (php-refactor-mode . [(20171124 635) nil "Minor mode to quickly and safely perform common refactorings" tar ((:url . "https://github.com/keelerm84/php-refactor-mode.el") (:commit . "d06dabd9ca743a04067e02282b69d7b7467fb4b7") (:revdesc . "d06dabd9ca74") (:keywords "php" "refactor") (:authors ("Matthew M. Keeler" . "keelerm84@gmail.com")) (:maintainers ("Matthew M. Keeler" . "keelerm84@gmail.com")) (:maintainer "Matthew M. Keeler" . "keelerm84@gmail.com"))]) (php-runtime . [(20241024 1622) ((emacs (25 1)) (compat (29))) "Language binding bridge to PHP" tar ((:url . "https://github.com/emacs-php/php-runtime.el") (:commit . "37beef404c70d7b80dc085b1ee1e13fd9c375fe6") (:revdesc . "37beef404c70") (:keywords "processes" "php" "lisp") (:authors ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainers ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainer "USAMI Kenta" . "tadsan@zonu.me"))]) (php-scratch . [(20210706 459) ((emacs (24 3)) (s (1 11 0)) (php-mode (1 17 0))) "A scratch buffer to interactively evaluate php code" tar ((:url . "https://github.com/mallt/php-scratch") (:commit . "b6bfd279da8a8ac7fc30459485956f3fd5d02573") (:revdesc . "b6bfd279da8a") (:authors ("Tijs Mallaerts" . "tijs.mallaerts@gmail.com")) (:maintainers ("Tijs Mallaerts" . "tijs.mallaerts@gmail.com")) (:maintainer "Tijs Mallaerts" . "tijs.mallaerts@gmail.com"))]) - (phpactor . [(20241015 1105) ((emacs (25 1)) (f (0 17)) (php-runtime (0 2)) (composer (0 2 0)) (async (1 9 3))) "Interface to Phpactor" tar ((:url . "https://github.com/emacs-php/phpactor.el") (:commit . "47c4311843dd523f0409016a1f2c93c9d13b213a") (:revdesc . "47c4311843dd") (:keywords "tools" "php") (:authors ("USAMI Kenta" . "tadsan@zonu.me") ("Mikael Kermorgant" . "mikael@kgtech.fi")) (:maintainers ("USAMI Kenta" . "tadsan@zonu.me") ("Mikael Kermorgant" . "mikael@kgtech.fi")) (:maintainer "USAMI Kenta" . "tadsan@zonu.me"))]) + (phpactor . [(20241120 1122) ((emacs (25 1)) (f (0 17)) (php-runtime (0 2)) (composer (0 2 0)) (async (1 9 3))) "Interface to Phpactor" tar ((:url . "https://github.com/emacs-php/phpactor.el") (:commit . "47fe67c450ef73dc27e009d765b67b2b3911633e") (:revdesc . "47fe67c450ef") (:keywords "tools" "php") (:authors ("USAMI Kenta" . "tadsan@zonu.me") ("Mikael Kermorgant" . "mikael@kgtech.fi")) (:maintainers ("USAMI Kenta" . "tadsan@zonu.me") ("Mikael Kermorgant" . "mikael@kgtech.fi")) (:maintainer "USAMI Kenta" . "tadsan@zonu.me"))]) (phpstan . [(20241107 408) ((emacs (25 1)) (compat (29)) (php-mode (1 22 3)) (php-runtime (0 2))) "Interface to PHPStan" tar ((:url . "https://github.com/emacs-php/phpstan.el") (:commit . "b616f5fa5f8aff9aa220c7fe63b39df6d10588a5") (:revdesc . "b616f5fa5f8a") (:keywords "tools" "php") (:authors ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainers ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainer "USAMI Kenta" . "tadsan@zonu.me"))]) (phpt-mode . [(20190512 1809) ((emacs (25)) (polymode (0 1 5)) (php-mode (1 21 2))) "Major mode for editing PHPT test code" tar ((:url . "https://github.com/emacs-php/phpt-mode") (:commit . "deb386f1a81003074c476f15e1975d445ff6df01") (:revdesc . "deb386f1a810") (:keywords "languages" "php") (:authors ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainers ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainer "USAMI Kenta" . "tadsan@zonu.me"))]) (phpunit . [(20230801 1523) ((s (1 12 0)) (f (0 19 0)) (pkg-info (0 6)) (cl-lib (0 5)) (emacs (24 3))) "Launch PHP unit tests using phpunit" tar ((:url . "https://github.com/nlamirault/phpunit.el") (:commit . "e5baa445363942fbd9898ac3cb91eea64b69d316") (:revdesc . "e5baa4453639") (:keywords "tools" "php" "tests" "phpunit") (:authors ("Nicolas Lamirault" . "nicolas.lamirault@gmail.com") ("Eric Hansen" . "hansen.c.eric@gmail.com")) (:maintainers ("Nicolas Lamirault" . "nicolas.lamirault@gmail.com") ("Eric Hansen" . "hansen.c.eric@gmail.com")) (:maintainer "Nicolas Lamirault" . "nicolas.lamirault@gmail.com"))]) @@ -4277,6 +4281,7 @@ (plisp-mode . [(20221130 524) nil "Major mode for PicoLisp programming" tar ((:url . "https://github.com/flexibeast/plisp-mode") (:commit . "3a0ec9741ae7ca67852022c6fa85519fcb4b69ba") (:revdesc . "3a0ec9741ae7") (:keywords "picolisp" "lisp" "programming") (:authors ("Alexis Guillermo R. Palavecine" . "grpala@gmail.com") ("Thorsten Jolitz" . "tjolitz@gmail.com") ("Alexis" . "flexibeast@gmail.com")) (:maintainers ("Alexis" . "flexibeast@gmail.com")) (:maintainer "Alexis" . "flexibeast@gmail.com"))]) (plsense . [(20151104 1445) ((auto-complete (1 4 0)) (log4e (0 2 0)) (yaxception (0 2 0))) "Provide interface for PlSense that is a development tool for Perl" tar ((:url . "https://github.com/aki2o/emacs-plsense") (:commit . "d50f9dccc98f42bdb42f1d1c8142246e03879218") (:revdesc . "d50f9dccc98f") (:keywords "perl" "completion") (:authors ("Hiroaki Otsu" . "ootsuhiroaki@gmail.com")) (:maintainers ("Hiroaki Otsu" . "ootsuhiroaki@gmail.com")) (:maintainer "Hiroaki Otsu" . "ootsuhiroaki@gmail.com"))]) (plsense-direx . [(20140520 2008) ((direx (0 1 -3)) (plsense (0 3 2)) (log4e (0 2 0)) (yaxception (0 3 2))) "Perl Package Explorer" tar ((:url . "https://github.com/aki2o/plsense-direx") (:commit . "8a2f465264c74e04524cc789cdad0190ace43f6c") (:revdesc . "8a2f465264c7") (:keywords "perl" "convenience") (:authors ("Hiroaki Otsu" . "ootsuhiroaki@gmail.com")) (:maintainers ("Hiroaki Otsu" . "ootsuhiroaki@gmail.com")) (:maintainer "Hiroaki Otsu" . "ootsuhiroaki@gmail.com"))]) + (plumber . [(20241110 2234) ((emacs (25 1)) (compat (28 1 2 2))) "Run different commands depending on the text format" tar ((:url . "https://github.com/8dcc/plumber.el") (:commit . "7655ed6d6d69249488abf57a3b39fc762792be6f") (:revdesc . "7655ed6d6d69") (:keywords "convenience" "matching" "tools") (:authors ("8dcc" . "8dcc.git@gmail.com")) (:maintainers ("8dcc" . "8dcc.git@gmail.com")) (:maintainer "8dcc" . "8dcc.git@gmail.com"))]) (plur . [(20160504 924) ((emacs (24 4))) "Easily search and replace multiple variants of a word" tar ((:url . "https://github.com/xuchunyang/plur") (:commit . "5bdd3b9a2f0624414bd596e798644713cd1545f0") (:revdesc . "5bdd3b9a2f06") (:authors ("Chunyang Xu" . "xuchunyang.me@gmail.com")) (:maintainers ("Chunyang Xu" . "xuchunyang.me@gmail.com")) (:maintainer "Chunyang Xu" . "xuchunyang.me@gmail.com"))]) (pmdm . [(20191101 2346) nil "Poor man's desktop-mode alternative" tar ((:url . "https://hg.serna.eu/emacs/pmdm") (:commit . "6d2af9f9e88e6c91eb74dafaddb5f009e1de4907") (:revdesc . "6d2af9f9e88e6c91eb74dafaddb5f009e1de4907") (:authors ("Iñigo Serna" . "inigoserna@gmx.com")) (:maintainers ("Iñigo Serna" . "inigoserna@gmx.com")) (:maintainer "Iñigo Serna" . "inigoserna@gmx.com"))]) (pnpm-mode . [(20200527 557) ((emacs (24 1))) "Minor mode for working with pnpm projects" tar ((:url . "https://github.com/rajasegar/pnpm-mode") (:commit . "ec66ba36ba6e07883b029569c33fd461d28eed75") (:revdesc . "ec66ba36ba6e") (:keywords "convenience" "project" "javascript" "node" "npm" "pnpm") (:authors ("Rajasegar Chandran" . "rajasegar.c@gmail.com")) (:maintainers ("Rajasegar Chandran" . "rajasegar.c@gmail.com")) (:maintainer "Rajasegar Chandran" . "rajasegar.c@gmail.com"))]) @@ -4430,7 +4435,7 @@ (puni . [(20241007 1609) ((emacs (26 1))) "Parentheses Universalistic" tar ((:url . "https://github.com/AmaiKinono/puni") (:commit . "f430f5b0a14c608176e3376058eb380ab0824621") (:revdesc . "f430f5b0a14c") (:keywords "convenience" "lisp" "tools") (:authors ("Hao Wang" . "amaikinono@gmail.com")) (:maintainers ("Hao Wang" . "amaikinono@gmail.com")) (:maintainer "Hao Wang" . "amaikinono@gmail.com"))]) (punpun-themes . [(20240929 2238) ((emacs (24 1))) "A set of bleak themes" tar ((:url . "https://depp.brause.cc/punpun-themes.git") (:commit . "a0b26442293e7afc6fd2ba9be199fc7b4f5138e3") (:revdesc . "a0b26442293e") (:authors ("Vasilij Schneidermann" . "mail@vasilij.de")) (:maintainers ("Vasilij Schneidermann" . "mail@vasilij.de")) (:maintainer "Vasilij Schneidermann" . "mail@vasilij.de"))]) (puppet-mode . [(20210305 645) ((emacs (24 1)) (pkg-info (0 4))) "Major mode for Puppet manifests" tar ((:url . "https://github.com/voxpupuli/puppet-mode") (:commit . "ab25cf379236f4e1bd4bc9c1d77a93c95800e9bf") (:revdesc . "ab25cf379236") (:keywords "languages") (:authors ("Vox Pupuli" . "voxpupuli@groups.io") ("Bozhidar Batsov" . "bozhidar@batsov.com") ("Sebastian Wiesner" . "swiesner@lunaryorn.com") ("Russ Allbery" . "rra@stanford.edu")) (:maintainers ("Vox Pupuli" . "voxpupuli@groups.io") ("Bozhidar Batsov" . "bozhidar@batsov.com") ("Sebastian Wiesner" . "swiesner@lunaryorn.com") ("Tim Meusel" . "tim@bastelfreak.de")) (:maintainer "Vox Pupuli" . "voxpupuli@groups.io"))]) - (puppet-ts-mode . [(20241116 1119) ((emacs (29 1))) "Major mode for Puppet using Tree-sitter" tar ((:url . "https://github.com/smoeding/puppet-ts-mode") (:commit . "80712560587967eeea5bd891a7d75291d63664e1") (:revdesc . "807125605879") (:keywords "languages") (:authors ("Stefan Möding" . "stm@kill-9.net")) (:maintainers ("Stefan Möding" . "stm@kill-9.net")) (:maintainer "Stefan Möding" . "stm@kill-9.net"))]) + (puppet-ts-mode . [(20241118 1820) ((emacs (29 1))) "Major mode for Puppet using Tree-sitter" tar ((:url . "https://github.com/smoeding/puppet-ts-mode") (:commit . "b3740fa22e4259a9ee8cac98c151e1f3323b87e4") (:revdesc . "b3740fa22e42") (:keywords "languages") (:authors ("Stefan Möding" . "stm@kill-9.net")) (:maintainers ("Stefan Möding" . "stm@kill-9.net")) (:maintainer "Stefan Möding" . "stm@kill-9.net"))]) (purescript-mode . [(20240930 737) ((emacs (25 1))) "A PureScript editing mode" tar ((:url . "https://github.com/purescript-emacs/purescript-mode") (:commit . "d187b3d4bbb4d9cb36a4c6c55f35d63d159a26e8") (:revdesc . "d187b3d4bbb4") (:keywords "faces" "files" "purescript") (:authors ("1997-1998 Graeme E Moss and" . "gem@cs.york.ac.uk") ("Tommy Thorn" . "thorn@irisa.fr") ("2003 Dave Love" . "fx@gnu.org") ("2014 Tim Dysinger" . "tim@dysinger.net")) (:maintainers ("1997-1998 Graeme E Moss and" . "gem@cs.york.ac.uk") ("Tommy Thorn" . "thorn@irisa.fr") ("2003 Dave Love" . "fx@gnu.org") ("2014 Tim Dysinger" . "tim@dysinger.net")) (:maintainer "1997-1998 Graeme E Moss and" . "gem@cs.york.ac.uk"))]) (purp-theme . [(20210912 1940) nil "A dark color theme with few colors" tar ((:url . "https://github.com/gnuvince/purp") (:commit . "8d3510e1ed995b8323cd5205626ddde6386a76ca") (:revdesc . "8d3510e1ed99") (:keywords "faces") (:authors ("Vincent Foley" . "vfoley@gmail.com")) (:maintainers ("Vincent Foley" . "vfoley@gmail.com")) (:maintainer "Vincent Foley" . "vfoley@gmail.com"))]) (purple-haze-theme . [(20141015 229) ((emacs (24 0))) "An overtly purple color theme for Emacs24" tar ((:url . "https://github.com/emacsfodder/emacs-purple-haze-theme") (:commit . "3e245cbef7cd09e6b3ee124963e372a04e9a6485") (:revdesc . "3e245cbef7cd") (:authors ("Jason Milkins" . "jasonm23@gmail.com")) (:maintainers ("Jason Milkins" . "jasonm23@gmail.com")) (:maintainer "Jason Milkins" . "jasonm23@gmail.com"))]) @@ -4501,6 +4506,7 @@ (quick-buffer-switch . [(20221220 1142) nil "Quick switch to file or dir buffers" tar ((:url . "https://github.com/renard/quick-buffer-switch") (:commit . "280f67f1a5e02533573b45d585c222c937f11f81") (:revdesc . "280f67f1a5e0") (:keywords "emacs" "configuration") (:authors ("Sebastien Gross" . "seb•ɑƬ•chezwam•ɖɵʈ•org")) (:maintainers ("Sebastien Gross" . "seb•ɑƬ•chezwam•ɖɵʈ•org")) (:maintainer "Sebastien Gross" . "seb•ɑƬ•chezwam•ɖɵʈ•org"))]) (quick-peek . [(20200130 2059) ((emacs (24 3))) "Inline quick-peek windows" tar ((:url . "https://github.com/cpitclaudel/quick-peek") (:commit . "03a276086795faad46a142454fc3e28cab058b70") (:revdesc . "03a276086795") (:keywords "tools" "help" "doc" "convenience") (:authors ("Clément Pit-Claudel" . "clement.pitclaudel@live.com")) (:maintainers ("Clément Pit-Claudel" . "clement.pitclaudel@live.com")) (:maintainer "Clément Pit-Claudel" . "clement.pitclaudel@live.com"))]) (quick-preview . [(20191017 1920) nil "Quick preview using GNOME sushi, gloobus or quick look" tar ((:url . "https://github.com/emacsattic/quick-preview") (:commit . "a312ab5539b9a362da9d305e4da814e17c5721c9") (:revdesc . "a312ab5539b9") (:keywords "files" "hypermedia") (:authors ("myuhe" . "yuhei.maeda_at_gmail.com")))]) + (quick-sdcv . [(20241119 1657) ((emacs (25 1))) "Offline dictionary using 'sdcv' (StartDict cli dictionary)" tar ((:url . "https://github.com/jamescherti/quick-sdcv.el") (:commit . "852fa91e5d8231b5118b7997a329074b5e08c5b9") (:revdesc . "852fa91e5d82") (:keywords "docs" "startdict" "sdcv"))]) (quick-shell-keybind . [(20230927 1036) ((emacs (24))) "Interactively bind a key to shell commands" tar ((:url . "https://github.com/eyeinsky/quick-shell-keybind") (:commit . "be830a69cf7eec92d4ea269fd389ac39b0c162f1") (:revdesc . "be830a69cf7e") (:keywords "maint" "convenience" "processes") (:authors ("eyeinsky" . "eyeinsky9@gmail.com")) (:maintainers ("eyeinsky" . "eyeinsky9@gmail.com")) (:maintainer "eyeinsky" . "eyeinsky9@gmail.com"))]) (quickref . [(20170817 1232) ((dash (1 0 3)) (s (1 0 0))) "Display relevant notes-to-self in the echo area" tar ((:url . "https://github.com/pd/quickref.el") (:commit . "f368c8b8219bb90498c5ab84e26f00eedaa234cf") (:revdesc . "f368c8b8219b"))]) (quickrun . [(20240924 2359) ((emacs (26 1)) (ht (2 0))) "Run commands quickly" tar ((:url . "https://github.com/emacsorphanage/quickrun") (:commit . "bb0f7580cd95022c4f8d016700a73260687c9722") (:revdesc . "bb0f7580cd95") (:keywords "tools") (:authors ("Syohei YOSHIDA" . "syohex@gmail.com")) (:maintainers ("Jen-Chieh Shen" . "jcs090218@gmail.com")) (:maintainer "Jen-Chieh Shen" . "jcs090218@gmail.com"))]) @@ -4552,7 +4558,7 @@ (realgud-byebug . [(20190520 1140) ((realgud (1 4 5)) (load-relative (1 2)) (cl-lib (0 5)) (emacs (24))) "Realgud front-end to the Ruby byebug debugger" tar ((:url . "https://github.com/realgud/realgud-byebug") (:commit . "f8f20b92c6b13f75cc9797921c0e28d3def48b1c") (:revdesc . "f8f20b92c6b1"))]) (realgud-ipdb . [(20200722 1116) ((realgud (1 5 0)) (load-relative (1 3 1)) (emacs (25))) "Realgud front-end to ipdb" tar ((:url . "https://github.com/realgud/realgud-ipdb") (:commit . "f18f907aa4ddd3e59dc19ca296d4ee2dc5e436b0") (:revdesc . "f18f907aa4dd") (:authors ("Rocky Bernstein" . "rocky@gnu.org")) (:maintainers ("Rocky Bernstein" . "rocky@gnu.org")) (:maintainer "Rocky Bernstein" . "rocky@gnu.org"))]) (realgud-jdb . [(20200722 1120) ((realgud (1 5 0)) (load-relative (1 3 1)) (emacs (25))) "Realgud front-end to Java's jdb debugger\"" tar ((:url . "https://github.com/realgud/realgud-jdb") (:commit . "1c183b2f8aae0de60942ea01444b896bf182c66a") (:revdesc . "1c183b2f8aae") (:authors ("Rocky Bernstein" . "rocky@gnu.org")) (:maintainers ("Rocky Bernstein" . "rocky@gnu.org")) (:maintainer "Rocky Bernstein" . "rocky@gnu.org"))]) - (realgud-lldb . [(20230201 948) ((load-relative (1 3 1)) (realgud (1 5 0)) (emacs (25))) "Realgud front-end to lldb" tar ((:url . "https://github.com/realgud/realgud-lldb") (:commit . "74d442abc8469bb6277702f9c60fa479848009b2") (:revdesc . "74d442abc846") (:authors ("Rocky Bernstein" . "rocky@gnu.org")) (:maintainers ("Rocky Bernstein" . "rocky@gnu.org")) (:maintainer "Rocky Bernstein" . "rocky@gnu.org"))]) + (realgud-lldb . [(20241119 209) ((load-relative (1 3 1)) (realgud (1 5 0)) (emacs (25))) "Realgud front-end to lldb" tar ((:url . "https://github.com/realgud/realgud-lldb") (:commit . "deacd070e8ab8830f4d577fee37136ad89183d13") (:revdesc . "deacd070e8ab") (:authors ("Rocky Bernstein" . "rocky@gnu.org")) (:maintainers ("Rocky Bernstein" . "rocky@gnu.org")) (:maintainer "Rocky Bernstein" . "rocky@gnu.org"))]) (realgud-node-debug . [(20190525 1634) ((realgud (1 4 5)) (load-relative (1 2)) (cl-lib (0 5)) (emacs (25))) "Realgud front-end to older \"node debug\"" tar ((:url . "https://github.com/realgud/realgud-node-debug") (:commit . "72e786359ce9dace1796b0d81a00e9340e9c90ad") (:revdesc . "72e786359ce9") (:authors ("Rocky Bernstein" . "rocky@gnu.org")) (:maintainers ("Rocky Bernstein" . "rocky@gnu.org")) (:maintainer "Rocky Bernstein" . "rocky@gnu.org"))]) (realgud-node-inspect . [(20190523 1251) ((realgud (1 4 5)) (load-relative (1 2)) (cl-lib (0 5)) (emacs (24))) "Realgud front-end to newer \"node inspect\"" tar ((:url . "https://github.com/realgud/realgud-node-inspect") (:commit . "e0f18442d759b8ce4479c01e090975b62270257d") (:revdesc . "e0f18442d759") (:authors ("Rocky Bernstein" . "rocky@gnu.org")) (:maintainers ("Rocky Bernstein" . "rocky@gnu.org")) (:maintainer "Rocky Bernstein" . "rocky@gnu.org"))]) (realgud-old-debuggers . [(20190520 1150) ((realgud (1 4 5)) (load-relative (1 2)) (cl-lib (0 5)) (emacs (24))) "Realgud front-end to older lesser-used debuggers" tar ((:url . "https://github.com/realgud/realgud-old-debuggers") (:commit . "0fad38283e885c452160232e01adf3f6ae51983b") (:revdesc . "0fad38283e88"))]) @@ -4821,7 +4827,7 @@ (shell-current-directory . [(20140101 2354) nil "Create new shell based on buffer directory" tar ((:url . "https://github.com/metaperl/shell-current-directory") (:commit . "bf843771bf9a4aa05e054ade799eb8862f3be89a") (:revdesc . "bf843771bf9a") (:keywords "shell" "comint"))]) (shell-here . [(20220102 1703) nil "Open a shell relative to the working directory" tar ((:url . "https://codeberg.org/emacs-weirdware/shell-here") (:commit . "eeb437ff26d62a5009046b1b3b4503b768e3131a") (:revdesc . "eeb437ff26d6") (:keywords "unix" "tools" "processes") (:authors ("Ian Eure" . "ian.eure@gmail.com")) (:maintainers ("Ian Eure" . "ian.eure@gmail.com")) (:maintainer "Ian Eure" . "ian.eure@gmail.com"))]) (shell-history . [(20100505 839) nil "Integration with shell history" tar ((:url . "https://github.com/emacsorphanage/shell-history") (:commit . "ee371a81f2d2bf5a308344078329ca1e9b5ed38c") (:revdesc . "ee371a81f2d2") (:keywords "processes" "convenience") (:authors ("rubikitch" . "rubikitch@ruby-lang.org")) (:maintainers ("rubikitch" . "rubikitch@ruby-lang.org")) (:maintainer "rubikitch" . "rubikitch@ruby-lang.org"))]) - (shell-maker . [(20241112 1906) ((emacs (27 1))) "Interaction mode for making comint shells" tar ((:url . "https://github.com/xenodium/shell-maker") (:commit . "a0452a1c832a7ca6ecfa3e5a34d695a25b2a22a4") (:revdesc . "a0452a1c832a"))]) + (shell-maker . [(20241119 1109) ((emacs (27 1))) "Interaction mode for making comint shells" tar ((:url . "https://github.com/xenodium/shell-maker") (:commit . "d90ec9ad3f83d381de65159043318f3381bb3a36") (:revdesc . "d90ec9ad3f83"))]) (shell-pop . [(20231228 612) ((emacs (24 1)) (cl-lib (0 5))) "Helps you to use shell easily on Emacs. Only one key action to work" tar ((:url . "https://github.com/kyagi/shell-pop-el") (:commit . "ff3dc705ee1c7bc566b35c17e4635c57061fe3ae") (:revdesc . "ff3dc705ee1c") (:keywords "shell" "terminal" "tools") (:authors ("Kazuo YAGI" . "kazuo.yagi@gmail.com")) (:maintainers ("Kazuo YAGI" . "kazuo.yagi@gmail.com")) (:maintainer "Kazuo YAGI" . "kazuo.yagi@gmail.com"))]) (shell-split-string . [(20151224 1008) nil "Split strings using shell-like syntax" tar ((:url . "https://github.com/10sr/shell-split-string-el") (:commit . "19f6f999c33cc66a4c91bacdcc3697c25d97bf5a") (:revdesc . "19f6f999c33c") (:keywords "utility" "library" "shell" "string") (:authors ("10sr" . "8.slashes+el[at]gmail[dot]com")) (:maintainers ("10sr" . "8.slashes+el[at]gmail[dot]com")) (:maintainer "10sr" . "8.slashes+el[at]gmail[dot]com"))]) (shell-switcher . [(20210509 1045) ((emacs (24))) "Provide fast switching between shell buffers" tar ((:url . "https://github.com/DamienCassou/shell-switcher") (:commit . "ed74b20fa12935be0068765f5bc8de97b92a8020") (:revdesc . "ed74b20fa129") (:keywords "emacs" "package" "elisp" "shell" "eshell" "term" "switcher") (:authors ("Damien Cassou" . "damien.cassou@gmail.com")) (:maintainers ("Damien Cassou" . "damien.cassou@gmail.com")) (:maintainer "Damien Cassou" . "damien.cassou@gmail.com"))]) @@ -4856,7 +4862,7 @@ (side-hustle . [(20240625 1228) ((emacs (24 4)) (seq (2 20))) "Hustle through Imenu in a side window" tar ((:url . "https://github.com/rnkn/side-hustle") (:commit . "94450b58cec1b809afe08d0754a6662839efbc9d") (:revdesc . "94450b58cec1") (:keywords "convenience") (:authors ("Paul W. Rankin" . "rnkn@rnkn.xyz")) (:maintainers ("Paul W. Rankin" . "rnkn@rnkn.xyz")) (:maintainer "Paul W. Rankin" . "rnkn@rnkn.xyz"))]) (side-notes . [(20240629 1008) ((emacs (24 4))) "Easy access to a directory notes file" tar ((:url . "https://github.com/rnkn/side-notes") (:commit . "96a142dfd5768d66b1d574027e13c572e4c82a87") (:revdesc . "96a142dfd576") (:keywords "convenience") (:authors ("Paul W. Rankin" . "rnkn@rnkn.xyz")) (:maintainers ("Paul W. Rankin" . "rnkn@rnkn.xyz")) (:maintainer "Paul W. Rankin" . "rnkn@rnkn.xyz"))]) (sidecar-locals . [(20240421 655) ((emacs (27 1))) "A flexible alternative to built-in dir-locals" tar ((:url . "https://codeberg.org/ideasman42/emacs-sidecar-locals") (:commit . "3daf8c07fac7c4ada7a02a1edad2f64894463614") (:revdesc . "3daf8c07fac7") (:keywords "convenience") (:authors ("Campbell Barton" . "ideasman42@gmail.com")) (:maintainers ("Campbell Barton" . "ideasman42@gmail.com")) (:maintainer "Campbell Barton" . "ideasman42@gmail.com"))]) - (sideline . [(20241104 701) ((emacs (27 1)) (ht (2 4))) "Show information on the side" tar ((:url . "https://github.com/emacs-sideline/sideline") (:commit . "476804d2f21481608957b54b523d487d591cdd93") (:revdesc . "476804d2f214") (:keywords "convenience") (:authors ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Jen-Chieh" . "jcs090218@gmail.com"))]) + (sideline . [(20241117 1845) ((emacs (27 1)) (ht (2 4))) "Show information on the side" tar ((:url . "https://github.com/emacs-sideline/sideline") (:commit . "56d4a8558870546516523bf08d35a6859f632855") (:revdesc . "56d4a8558870") (:keywords "convenience") (:authors ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Jen-Chieh" . "jcs090218@gmail.com"))]) (sideline-blame . [(20240906 1906) ((emacs (27 1)) (sideline (0 1 0)) (vc-msg (1 1 1))) "Show blame messages with sideline" tar ((:url . "https://github.com/emacs-sideline/sideline-blame") (:commit . "48288bc77a90b58c7609598d0a129ba1638d0098") (:revdesc . "48288bc77a90") (:keywords "convenience" "blame") (:authors ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Jen-Chieh" . "jcs090218@gmail.com"))]) (sideline-flycheck . [(20240629 840) ((emacs (27 1)) (sideline (0 1 1)) (flycheck (0 14)) (ht (2 4))) "Show flycheck errors with sideline" tar ((:url . "https://github.com/emacs-sideline/sideline-flycheck") (:commit . "4147f2754c353e0b7920caf385b8dccc5e6301f7") (:revdesc . "4147f2754c35") (:keywords "convenience" "flycheck") (:authors ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Jen-Chieh" . "jcs090218@gmail.com"))]) (sideline-flymake . [(20240509 742) ((emacs (27 1)) (sideline (0 1 0))) "Show flymake errors with sideline" tar ((:url . "https://github.com/emacs-sideline/sideline-flymake") (:commit . "06e84875022a5645ece8f4c2c8b56aa5f003c65d") (:revdesc . "06e84875022a") (:keywords "convenience" "flymake") (:authors ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Jen-Chieh" . "jcs090218@gmail.com"))]) @@ -4882,7 +4888,7 @@ (simplicity-theme . [(20221016 1444) ((emacs (24 1))) "A minimalist dark theme" tar ((:url . "https://github.com/smallwat3r/emacs-simplicity-theme") (:commit . "f4aab6aa07b536688eb62355b83dde5fcd16e049") (:revdesc . "f4aab6aa07b5") (:keywords "faces" "theme" "minimal") (:authors ("Matthieu Petiteau" . "mpetiteau.pro@gmail.com")) (:maintainers ("Matthieu Petiteau" . "mpetiteau.pro@gmail.com")) (:maintainer "Matthieu Petiteau" . "mpetiteau.pro@gmail.com"))]) (sink . [(20240523 747) ((emacs (25 1))) "Receive messages from the plan9 plumber" tar ((:url . "https://github.com/alcah/sink.el") (:commit . "a14e1cc0a051543723c043a5ece081ce9a567ddd") (:revdesc . "a14e1cc0a051"))]) (siri-shortcuts . [(20211229 1833) ((emacs (25 2))) "Interact with Siri Shortcuts" tar ((:url . "https://github.com/DaniruKun/siri-shortcuts.el") (:commit . "190f242f71e071adfd89fa1f2f6ea22b62afd133") (:revdesc . "190f242f71e0") (:keywords "convenience" "multimedia") (:authors ("Daniils Petrovs" . "thedanpetrov@gmail.com")) (:maintainers ("Daniils Petrovs" . "thedanpetrov@gmail.com")) (:maintainer "Daniils Petrovs" . "thedanpetrov@gmail.com"))]) - (sis . [(20241106 755) ((emacs (27 1))) "Less manual switch for native or OS input source (input method)" tar ((:url . "https://github.com/laishulu/emacs-smart-input-source") (:commit . "a356acf5018856b50474803bb9af3b633302f5cb") (:revdesc . "a356acf50188") (:keywords "convenience"))]) + (sis . [(20241118 308) ((emacs (27 1))) "Less manual switch for native or OS input source (input method)" tar ((:url . "https://github.com/laishulu/emacs-smart-input-source") (:commit . "8fc274d937573577aa99aff7da7442f68d598f4a") (:revdesc . "8fc274d93757") (:keywords "convenience"))]) (sisyphus . [(20241015 1351) ((emacs (27 1)) (compat (30 0 0 0)) (elx (2 0 3)) (llama (0 3 1)) (magit (4 1 1))) "Create releases of Emacs packages" tar ((:url . "https://github.com/magit/sisyphus") (:commit . "e6ec5d8687f34644b4d049a6be463269792c9fd6") (:revdesc . "e6ec5d8687f3") (:keywords "git" "tools" "vc") (:authors ("Jonas Bernoulli" . "emacs.sisyphus@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.sisyphus@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.sisyphus@jonas.bernoulli.dev"))]) (sixcolors-mode . [(20230406 1031) ((emacs (27 1))) "A customizable horizontal scrollbar" tar ((:url . "https://github.com/mastro35/sixcolors-mode") (:commit . "4124a8cf664b04a4bf4c39f7c3b7da3e480b99c8") (:revdesc . "4124a8cf664b") (:keywords "convenience" "colors") (:authors ("Davide Mastromatteo" . "mastro35@gmail.com")) (:maintainers ("Davide Mastromatteo" . "mastro35@gmail.com")) (:maintainer "Davide Mastromatteo" . "mastro35@gmail.com"))]) (skeletor . [(20210129 239) ((s (1 7 0)) (f (0 14 0)) (dash (2 2 0)) (cl-lib (0 3)) (let-alist (1 0 3)) (emacs (24 1))) "Provides project skeletons for Emacs" tar ((:url . "https://github.com/chrisbarrett/skeletor.el") (:commit . "f6e560a0bfe459e0b8a268047920ce1148f2ebf6") (:revdesc . "f6e560a0bfe4") (:authors ("Chris Barrett" . "chris.d.barrett@me.com")) (:maintainers ("Chris Barrett" . "chris.d.barrett@me.com")) (:maintainer "Chris Barrett" . "chris.d.barrett@me.com"))]) @@ -4893,10 +4899,10 @@ (skewer-reload-stylesheets . [(20160725 1220) ((skewer-mode (1 5 3))) "Live-edit CSS, SCSS, Less, and friends" tar ((:url . "https://github.com/NateEag/skewer-reload-stylesheets") (:commit . "3207abca9551660407a6b009cb40fb32bbb550da") (:revdesc . "3207abca9551") (:authors ("Nate Eagleson" . "nate@nateeag.com")) (:maintainers ("Nate Eagleson" . "nate@nateeag.com")) (:maintainer "Nate Eagleson" . "nate@nateeag.com"))]) (skype . [(20160711 824) nil "Skype UI for emacs users." tar ((:url . "https://github.com/kiwanami/emacs-skype") (:commit . "8e3b33e620ed355522aa36434ff41e3ced080629") (:revdesc . "8e3b33e620ed") (:keywords "skype" "chat") (:authors ("SAKURAI Masashi" . "m.sakurai@kiwanami.net")) (:maintainers ("SAKURAI Masashi" . "m.sakurai@kiwanami.net")) (:maintainer "SAKURAI Masashi" . "m.sakurai@kiwanami.net"))]) (sl . [(20161217 1404) ((cl-lib (0 5))) "An Emacs clone of sl(1)" tar ((:url . "https://github.com/xuchunyang/sl.el") (:commit . "0882117728be91276b815e18c2a66106bf9d69d3") (:revdesc . "0882117728be") (:authors ("Chunyang Xu" . "mail@xuchunyang.me")) (:maintainers ("Chunyang Xu" . "mail@xuchunyang.me")) (:maintainer "Chunyang Xu" . "mail@xuchunyang.me"))]) - (slack . [(20211129 310) ((websocket (1 8)) (request (0 2 0)) (oauth2 (0 10)) (circe (2 2)) (alert (1 2)) (emojify (0 2))) "Slack client for Emacs" tar ((:url . "https://github.com/yuya373/emacs-slack") (:commit . "ff46d88726482211e3ac3d0b9c95dd4fdffe11c2") (:revdesc . "ff46d8872648") (:keywords "tools") (:authors ("yuya.minami" . "yuya.minami@yuyaminami-no-MacBook-Pro.local")) (:maintainers ("yuya.minami" . "yuya.minami@yuyaminami-no-MacBook-Pro.local")) (:maintainer "yuya.minami" . "yuya.minami@yuyaminami-no-MacBook-Pro.local"))]) + (slack . [(20241119 2336) ((websocket (1 8)) (request (0 2 0)) (oauth2 (0 10)) (circe (2 2)) (alert (1 2)) (emojify (0 2)) (emacs (25 1)) (dash (2 19 1)) (s (1 13 1))) "Slack client for Emacs" tar ((:url . "https://github.com/emacs-slack/emacs-slack") (:commit . "113cb87e0a0a3daeae4f1c587fe7c1a0b66cdb61") (:revdesc . "113cb87e0a0a") (:keywords "tools") (:authors ("yuya.minami" . "yuya.minami@yuyaminami-no-MacBook-Pro.local")) (:maintainers ("yuya.minami" . "yuya.minami@yuyaminami-no-MacBook-Pro.local")) (:maintainer "yuya.minami" . "yuya.minami@yuyaminami-no-MacBook-Pro.local"))]) (slideview . [(20150324 2240) ((cl-lib (0 3))) "File slideshow" tar ((:url . "https://github.com/mhayashi1120/Emacs-slideview") (:commit . "b6d170bda139aedf81b47dc55cbd1a3af512fb4c") (:revdesc . "b6d170bda139") (:keywords "files") (:authors ("Masahiro Hayashi" . "mhayashi1120@gmail.com")) (:maintainers ("Masahiro Hayashi" . "mhayashi1120@gmail.com")) (:maintainer "Masahiro Hayashi" . "mhayashi1120@gmail.com"))]) (slim-mode . [(20240513 2118) nil "Major mode for editing Slim files" tar ((:url . "https://github.com/slim-template/emacs-slim") (:commit . "8c92169817f2fa59255f547f0a9fb4fbb8309db9") (:revdesc . "8c92169817f2") (:keywords "markup" "language"))]) - (slime . [(20241112 1544) ((emacs (24 3)) (macrostep (0 9))) "Superior Lisp Interaction Mode for Emacs" tar ((:url . "https://github.com/slime/slime") (:commit . "bcbac8322244265037dd57d885485a0b6ff1f60d") (:revdesc . "bcbac8322244") (:keywords "languages" "lisp" "slime"))]) + (slime . [(20241118 1544) ((emacs (24 3)) (macrostep (0 9))) "Superior Lisp Interaction Mode for Emacs" tar ((:url . "https://github.com/slime/slime") (:commit . "929753a0dfb04832e3e358e5c83a90086111aedf") (:revdesc . "929753a0dfb0") (:keywords "languages" "lisp" "slime"))]) (slime-company . [(20210124 1627) ((emacs (24 4)) (slime (2 13)) (company (0 9 0))) "Slime completion backend for company mode" tar ((:url . "https://github.com/anwyn/slime-company") (:commit . "f20ecc4104d4c35052696e7e760109fb02060e72") (:revdesc . "f20ecc4104d4") (:keywords "convenience" "lisp" "abbrev") (:authors ("Ole Arndt" . "anwyn@sugarshark.com")) (:maintainers ("Ole Arndt" . "anwyn@sugarshark.com")) (:maintainer "Ole Arndt" . "anwyn@sugarshark.com"))]) (slime-docker . [(20210426 1422) ((emacs (24 4)) (slime (2 16)) (docker-tramp (0 1))) "Integration of SLIME with Docker containers" tar ((:url . "https://github.com/cl-docker-images/slime-docker") (:commit . "c7d073720f2bd8e9f72a20309fff2afa4c4e798d") (:revdesc . "c7d073720f2b") (:keywords "docker" "lisp" "slime"))]) (slime-repl-ansi-color . [(20230214 1453) ((emacs (24)) (slime (2 3 1))) "Turn on ANSI colors in REPL output;" tar ((:url . "https://gitlab.com/augfab/slime-repl-ansi-color") (:commit . "9e8af90490332217e45d7568f1690df3f4e25d4b") (:revdesc . "9e8af9049033") (:keywords "lisp") (:authors ("Max Mikhanosha" . "max@openchat.com")) (:maintainers ("Augustin Fabre" . "augustin@augfab.fr")) (:maintainer "Augustin Fabre" . "augustin@augfab.fr"))]) @@ -5054,14 +5060,14 @@ (ssh . [(20120904 2042) nil "Support for remote logins using ssh" tar ((:url . "https://codeberg.org/emacs-weirdware-abandoned/ssh") (:commit . "c17cf5b43df8ac4662a0580f85898e1f078df0d1") (:revdesc . "c17cf5b43df8") (:keywords "unix" "comm") (:authors ("Noah Friedman" . "friedman@splode.com")) (:maintainers ("Ian Eure" . "ian.eure@gmail.com")) (:maintainer "Ian Eure" . "ian.eure@gmail.com"))]) (ssh-agency . [(20200329 1558) ((emacs (24 4)) (dash (2 10 0))) "Manage ssh-agent from Emacs" tar ((:url . "https://github.com/magit/ssh-agency") (:commit . "a5377e4317365a3d5442e06d5c255d4a7c7618db") (:revdesc . "a5377e431736") (:authors ("Noam Postavsky" . "npostavs@user.sourceforge.net")) (:maintainers ("Noam Postavsky" . "npostavs@user.sourceforge.net")) (:maintainer "Noam Postavsky" . "npostavs@user.sourceforge.net"))]) (ssh-config-mode . [(20240901 2018) ((emacs (24 3))) "Mode for fontification of ~/.ssh/config" tar ((:url . "https://github.com/peterhoeg/ssh-config-mode-el") (:commit . "2d8e321c34a7535ae6dd0f6a1b0fd54e47aba612") (:revdesc . "2d8e321c34a7") (:keywords "comm" "files") (:authors ("Harley Gorrell" . "harley@panix.com")) (:maintainers ("Peter Hoeg" . "peter@hoeg.com")) (:maintainer "Peter Hoeg" . "peter@hoeg.com"))]) - (ssh-deploy . [(20230702 928) ((emacs (25))) "Deployment via Tramp, global or per directory" tar ((:url . "https://github.com/cjohansson/emacs-ssh-deploy") (:commit . "95fb076c9b657c5f1bfad3ee5bf1f8691c50d428") (:revdesc . "95fb076c9b65") (:keywords "tools" "convenience") (:authors ("Christian Johansson" . "christian@cvj.se")) (:maintainers ("Christian Johansson" . "christian@cvj.se")) (:maintainer "Christian Johansson" . "christian@cvj.se"))]) + (ssh-deploy . [(20241117 1850) ((emacs (25))) "Deployment via Tramp, global or per directory" tar ((:url . "https://github.com/cjohansson/emacs-ssh-deploy") (:commit . "dc8882d1806c0fdd635bc625b109179dfa3c929c") (:revdesc . "dc8882d1806c") (:keywords "tools" "convenience") (:authors ("Christian Johansson" . "christian@cvj.se")) (:maintainers ("Christian Johansson" . "christian@cvj.se")) (:maintainer "Christian Johansson" . "christian@cvj.se"))]) (ssh-tunnels . [(20220721 1242) ((cl-lib (0 5)) (emacs (24))) "Manage SSH tunnels" tar ((:url . "https://github.com/death/ssh-tunnels") (:commit . "5010d779edef33f869065231b99d74723c9c7eaf") (:revdesc . "5010d779edef") (:keywords "tools" "convenience") (:authors ("death" . "github.com/death")) (:maintainers ("death" . "github.com/death")) (:maintainer "death" . "github.com/death"))]) (stan-mode . [(20211129 2051) ((emacs (24 4))) "Major mode for editing Stan files" tar ((:url . "https://github.com/stan-dev/stan-mode") (:commit . "150bbbe5fd3ad2b5a3dbfba9d291e66eeea1a581") (:revdesc . "150bbbe5fd3a") (:keywords "languages" "c") (:authors ("Jeffrey Arnold" . "jeffrey.arnold@gmail.com") ("Daniel Lee" . "bearlee@alum.mit.edu") ("Kazuki Yoshida" . "kazukiyoshida@mail.harvard.edu")) (:maintainers ("Kazuki Yoshida" . "kazukiyoshida@mail.harvard.edu")) (:maintainer "Kazuki Yoshida" . "kazukiyoshida@mail.harvard.edu"))]) (stan-snippets . [(20211129 2051) ((emacs (24 3)) (stan-mode (10 3 0)) (yasnippet (0 8 0))) "Yasnippets for Stan" tar ((:url . "https://github.com/stan-dev/stan-mode") (:commit . "150bbbe5fd3ad2b5a3dbfba9d291e66eeea1a581") (:revdesc . "150bbbe5fd3a") (:keywords "languages" "tools") (:authors ("Jeffrey Arnold" . "jeffrey.arnold@gmail.com") ("Kazuki Yoshida" . "kazukiyoshida@mail.harvard.edu")) (:maintainers ("Kazuki Yoshida" . "kazukiyoshida@mail.harvard.edu")) (:maintainer "Kazuki Yoshida" . "kazukiyoshida@mail.harvard.edu"))]) (standard-dirs . [(20200621 1603) ((emacs (26 1)) (f (0 20 0)) (s (1 7 0))) "Platform-specific paths for config, cache, and other data" tar ((:url . "https://github.com/lafrenierejm/standard-dirs.el") (:commit . "e37b7e1c714c7798cd8e3a6569e4d71b96718a60") (:revdesc . "e37b7e1c714c") (:keywords "files") (:authors ("Joseph M LaFreniere" . "joseph@lafreniere.xyz")) (:maintainers ("Joseph M LaFreniere" . "joseph@lafreniere.xyz")) (:maintainer "Joseph M LaFreniere" . "joseph@lafreniere.xyz"))]) (standoff-mode . [(20210810 1814) nil "Create stand-off markup, also called external markup" tar ((:url . "https://github.com/lueck/standoff-mode") (:commit . "5e603092410d9c393d19050bcbed3014a379f0e6") (:revdesc . "5e603092410d") (:keywords "text" "annotations" "ner" "humanities") (:authors ("Christian Lück" . "christian.lueck@ruhr-uni-bochum.de")) (:maintainers ("Christian Lück" . "christian.lueck@ruhr-uni-bochum.de")) (:maintainer "Christian Lück" . "christian.lueck@ruhr-uni-bochum.de"))]) (starhugger . [(20240731 347) ((emacs (28 2)) (compat (29 1 4 0)) (dash (2 18 0)) (s (1 13 1)) (spinner (1 7 4)) (request (0 3 2))) "Hugging Face/AI-powered text & code completion client" tar ((:url . "https://gitlab.com/daanturo/starhugger.el") (:commit . "22eceb806947edc1ad35e10fb99bdfc65fe26ca3") (:revdesc . "22eceb806947") (:keywords "completion" "convenience" "languages"))]) - (starlit-theme . [(20240223 1728) ((emacs (25 1))) "Deep blue dark theme with bright colors from the starlit sky" tar ((:url . "https://github.com/SFTtech/starlit-emacs") (:commit . "136bbc4fc4961c5b2cd0824eb0762e672322fbd1") (:revdesc . "136bbc4fc496") (:keywords "faces") (:authors ("Jonas Jelten" . "jj@sft.lol")) (:maintainers ("Jonas Jelten" . "jj@sft.lol")) (:maintainer "Jonas Jelten" . "jj@sft.lol"))]) + (starlit-theme . [(20241118 1811) ((emacs (25 1))) "Deep blue dark theme with bright colors from the starlit sky" tar ((:url . "https://github.com/SFTtech/starlit-emacs") (:commit . "080ea5c7770ca91111605cb7d2e94c37c5dab31a") (:revdesc . "080ea5c7770c") (:keywords "faces") (:authors ("Jonas Jelten" . "jj@sft.lol")) (:maintainers ("Jonas Jelten" . "jj@sft.lol")) (:maintainer "Jonas Jelten" . "jj@sft.lol"))]) (start-menu . [(20160426 1225) ((cl-lib (0 5)) (config-parser (0 1))) "Start-menu for executing external program like in windows" tar ((:url . "https://github.com/lujun9972/el-start-menu") (:commit . "f7d33fed7ad2dc61156f1c1cff9e1805366fbd69") (:revdesc . "f7d33fed7ad2") (:keywords "convenience" "menu") (:authors ("DarkSun" . "lujun9972@gmail.com")) (:maintainers ("DarkSun" . "lujun9972@gmail.com")) (:maintainer "DarkSun" . "lujun9972@gmail.com"))]) (stash . [(20151117 1427) nil "Lightweight persistent caching" tar ((:url . "https://github.com/vermiculus/stash.el") (:commit . "c2e494d20c752b80ebbdffbf66687b3cdfc425ad") (:revdesc . "c2e494d20c75") (:keywords "extensions" "data" "internal" "lisp") (:authors ("Sean Allred" . "code@seanallred.com")) (:maintainers ("Sean Allred" . "code@seanallred.com")) (:maintainer "Sean Allred" . "code@seanallred.com"))]) (state . [(20200727 1227) ((emacs (24))) "Quick navigation between workspaces" tar ((:url . "https://github.com/thisirs/state") (:commit . "8cd9210f17c1b134274a7352b996839aed9a7d8c") (:revdesc . "8cd9210f17c1") (:keywords "convenience" "workspaces") (:authors ("Sylvain Rousseau" . "thisirsatgmaildotcom")) (:maintainers ("Sylvain Rousseau" . "thisirsatgmaildotcom")) (:maintainer "Sylvain Rousseau" . "thisirsatgmaildotcom"))]) @@ -5158,7 +5164,6 @@ (syntree . [(20230621 2048) ((emacs (27 1)) (org (9 2))) "Draw plain text constituency trees" tar ((:url . "https://github.com/enricoflor/syntree") (:commit . "7bbbd4904b0ffe452ec39630042dbc85a7a0b233") (:revdesc . "7bbbd4904b0f") (:authors ("Enrico Flor" . "enrico@eflor.net")) (:maintainers ("Enrico Flor" . "enrico@eflor.net")) (:maintainer "Enrico Flor" . "enrico@eflor.net"))]) (sysctl . [(20200615 1824) ((emacs (26))) "Manage sysctl though org-mode" tar ((:url . "https://github.com/dantecatalfamo/sysctl.el") (:commit . "d8c2e18de1d7a3b2999a4d5054c0bbf30cb10fed") (:revdesc . "d8c2e18de1d7") (:keywords "sysctl" "tools" "unix"))]) (syslog-mode . [(20240818 2215) ((hide-lines (20130623)) (ov (20150311)) (hsluv (20181127))) "Major-mode for viewing log files & strace output" tar ((:url . "https://github.com/vapniks/syslog-mode") (:commit . "3972f7e6697c052b293a8b090f08a94bf7296729") (:revdesc . "3972f7e6697c") (:keywords "unix") (:authors ("Harley Gorrell" . "harley@panix.com")) (:maintainers ("Joe Bloggs" . "vapniks@yahoo.com")) (:maintainer "Joe Bloggs" . "vapniks@yahoo.com"))]) - (system-packages . [(20220409 1023) ((emacs (24 3))) "Functions to manage system packages" tar ((:url . "https://gitlab.com/jabranham/system-packages") (:commit . "c087d2c6e598f85fc2760324dce20104ea442fa3") (:revdesc . "c087d2c6e598") (:authors ("J. Alexander Branham" . "alex.branham@gmail.com")) (:maintainers ("J. Alexander Branham" . "alex.branham@gmail.com")) (:maintainer "J. Alexander Branham" . "alex.branham@gmail.com"))]) (system-specific-settings . [(20140818 1457) nil "Apply settings only on certain systems" tar ((:url . "https://github.com/DarwinAwardWinner/emacs-system-specific-settings") (:commit . "0050d85b2175095aa5ecf580a2fe43c069b0eef3") (:revdesc . "0050d85b2175") (:keywords "configuration"))]) (systemd . [(20230201 302) ((emacs (24 4))) "Major mode for editing systemd units" tar ((:url . "https://github.com/holomorph/systemd-mode") (:commit . "8742607120fbc440821acbc351fda1e8e68a8806") (:revdesc . "8742607120fb") (:keywords "tools" "unix") (:authors ("Mark Oteiza" . "mvoteiza@udel.edu")) (:maintainers ("Mark Oteiza" . "mvoteiza@udel.edu")) (:maintainer "Mark Oteiza" . "mvoteiza@udel.edu"))]) (systemtap-mode . [(20151122 1940) nil "A mode for SystemTap" tar ((:url . "https://github.com/ruediger/systemtap-mode") (:commit . "8b5086d6b0050a12bb37e33c24c24d1f420afd3b") (:revdesc . "8b5086d6b005") (:keywords "tools" "languages") (:maintainers (nil . "ruediger@c-plusplus.de")) (:maintainer nil . "ruediger@c-plusplus.de"))]) @@ -5197,7 +5202,7 @@ (tea-time . [(20120331 820) nil "Simple timer package, useful to make perfect tea" tar ((:url . "https://github.com/konzeptual/tea-time") (:commit . "1f6cf0bdd27c5eb3508989c5095427781f858eca") (:revdesc . "1f6cf0bdd27c") (:keywords "timer" "tea-time") (:authors ("konsty" . "antipin.konstantin@googlemail.com")) (:maintainers ("Gabriel Saldana" . "gsaldana@gmail.com")) (:maintainer "Gabriel Saldana" . "gsaldana@gmail.com"))]) (teacode-expand . [(20181231 640) ((emacs (24 4))) "Expansion of text by TeaCode program" tar ((:url . "https://github.com/raguay/TeaCode-Expand") (:commit . "7df6f9ec95da1fb47bbae489bb3f2c27ed3a9b3a") (:revdesc . "7df6f9ec95da") (:keywords "lisp") (:authors ("Richard Guay" . "raguay@customct.com")) (:maintainers ("Richard Guay" . "raguay@customct.com")) (:maintainer "Richard Guay" . "raguay@customct.com"))]) (teco . [(20200707 2309) nil "Teco interpreter" tar ((:url . "https://github.com/mtk/teco") (:commit . "2529eb0f7f35c526c1b6fca5250399718ff5138a") (:revdesc . "2529eb0f7f35") (:keywords "convenience" "emulations" "files") (:authors ("Dale R. Worley" . "worley@alum.mit.edu")) (:maintainers ("Mark T. Kennedy" . "mtk@acm.org")) (:maintainer "Mark T. Kennedy" . "mtk@acm.org"))]) - (telega . [(20241115 1854) ((emacs (27 1)) (visual-fill-column (1 9)) (transient (0 3 0))) "Telegram client (unofficial)" tar ((:url . "https://github.com/zevlg/telega.el") (:commit . "6ff8203a2f208c0d0cd070e07f785f62f438aeae") (:revdesc . "6ff8203a2f20") (:keywords "comm") (:authors ("Zajcev Evgeny" . "zevlg@yandex.ru")) (:maintainers ("Zajcev Evgeny" . "zevlg@yandex.ru")) (:maintainer "Zajcev Evgeny" . "zevlg@yandex.ru"))]) + (telega . [(20241118 1404) ((emacs (27 1)) (visual-fill-column (1 9)) (transient (0 3 0))) "Telegram client (unofficial)" tar ((:url . "https://github.com/zevlg/telega.el") (:commit . "f4f957253093a449c806397fd6157e19d84a7c02") (:revdesc . "f4f957253093") (:keywords "comm") (:authors ("Zajcev Evgeny" . "zevlg@yandex.ru")) (:maintainers ("Zajcev Evgeny" . "zevlg@yandex.ru")) (:maintainer "Zajcev Evgeny" . "zevlg@yandex.ru"))]) (telepathy . [(20131209 1258) nil "Access Telepathy from Emacs" tar ((:url . "https://github.com/NicolasPetton/telepathy.el") (:commit . "211d785b02a29ddc254422fdcc3db45262582f8c") (:revdesc . "211d785b02a2") (:keywords "telepathy" "tools") (:authors ("Nicolas Petton" . "petton.nicolas@gmail.com")) (:maintainers ("Nicolas Petton" . "petton.nicolas@gmail.com")) (:maintainer "Nicolas Petton" . "petton.nicolas@gmail.com"))]) (telephone-line . [(20240109 2021) ((emacs (24 4)) (cl-lib (0 5)) (cl-generic (0 2)) (seq (1 8))) "Rewrite of Powerline" tar ((:url . "https://github.com/dbordak/telephone-line") (:commit . "6016418a5e1e8e006cc202eff50ff28b594eeca4") (:revdesc . "6016418a5e1e") (:keywords "mode-line") (:authors ("Daniel Bordak" . "dbordak@fastmail.fm")) (:maintainers ("Daniel Bordak" . "dbordak@fastmail.fm")) (:maintainer "Daniel Bordak" . "dbordak@fastmail.fm"))]) (teleport . [(20240718 652) ((emacs (28 1)) (dash (2 18 0))) "Integration for tsh (goteleport.com)" tar ((:url . "https://github.com/caramelhooves/teleport.el") (:commit . "929f87990a6ee83dfcb7ebf9f8580828f1281ebb") (:revdesc . "929f87990a6e") (:keywords "tools") (:authors ("Caramel Hooves" . "caramel.hooves@protonmail.com")) (:maintainers ("Caramel Hooves" . "caramel.hooves@protonmail.com")) (:maintainer "Caramel Hooves" . "caramel.hooves@protonmail.com"))]) @@ -5254,7 +5259,7 @@ (third-time . [(20240207 1621) ((emacs (27 1))) "Third Time: A Better Way to Work" tar ((:url . "https://git.sr.ht/~swflint/third-time") (:commit . "093b74be860fac389fb173caef5fabf61e417eef") (:revdesc . "093b74be860f") (:authors ("Samuel W. Flint" . "swflint@flintfam.org")) (:maintainers ("Samuel W. Flint" . "swflint@flintfam.org")) (:maintainer "Samuel W. Flint" . "swflint@flintfam.org"))]) (thread-dump . [(20170816 1850) nil "Java thread dump viewer" tar ((:url . "https://github.com/nd/thread-dump.el") (:commit . "204c9600242756d4b514bb5ff6293e052bf4b49d") (:revdesc . "204c96002427"))]) (threes . [(20160820 1242) ((emacs (24)) (seq (1 11))) "A clone of Threes (a tiny puzzle game)" tar ((:url . "https://github.com/xuchunyang/threes.el") (:commit . "6981acb30b856c77cba6aba63fefbf102cbdfbb2") (:revdesc . "6981acb30b85") (:keywords "games") (:authors ("Chunyang Xu" . "xuchunyang.me@gmail.com")) (:maintainers ("Chunyang Xu" . "xuchunyang.me@gmail.com")) (:maintainer "Chunyang Xu" . "xuchunyang.me@gmail.com"))]) - (thrift . [(20241110 2344) ((emacs (24))) "Major mode for fbthrift and Apache Thrift files" tar ((:url . "https://github.com/facebook/fbthrift") (:commit . "9261033de40d40e14c460eafd4149097ef1664fb") (:revdesc . "9261033de40d") (:keywords "languages"))]) + (thrift . [(20241118 1100) ((emacs (24))) "Major mode for fbthrift and Apache Thrift files" tar ((:url . "https://github.com/facebook/fbthrift") (:commit . "566ddea9148df9fc49b7fa17799609b3ca530c79") (:revdesc . "566ddea9148d") (:keywords "languages"))]) (thumb-through . [(20120119 534) nil "Plain text reader of HTML documents" tar ((:url . "https://github.com/apg/thumb-through") (:commit . "08d8fb720f93c6172653e035191a8fa9c3305e63") (:revdesc . "08d8fb720f93") (:keywords "html"))]) (tickscript-mode . [(20171219 203) ((emacs (24 1))) "A major mode for Tickscript files" tar ((:url . "https://github.com/msherry/tickscript-mode") (:commit . "f0579f38ff14954df5002ce30ae6d4a2c978d461") (:revdesc . "f0579f38ff14") (:keywords "languages") (:authors ("Marc Sherry" . "msherry@gmail.com")) (:maintainers ("Marc Sherry" . "msherry@gmail.com")) (:maintainer "Marc Sherry" . "msherry@gmail.com"))]) (tidal . [(20240407 1952) ((haskell-mode (16)) (emacs (25 1))) "Interact with TidalCycles for live coding patterns" tar ((:url . "https://github.com/tidalcycles/Tidal") (:commit . "88f09edf6bef2228d5f530dea872b08a9d803066") (:revdesc . "88f09edf6bef") (:keywords "tools") (:authors (nil . "alex@slab.org")) (:maintainers (nil . "alex@slab.org")) (:maintainer nil . "alex@slab.org"))]) @@ -5345,10 +5350,10 @@ (tree-edit . [(20231124 1712) ((emacs (29 1)) (dash (2 19)) (reazon (0 4 0)) (s (0 0 0))) "A library for structural refactoring and editing" tar ((:url . "https://github.com/ethan-leba/tree-edit") (:commit . "3e71d276e7369ff4525f0e2b84356a31fe6b7782") (:revdesc . "3e71d276e736") (:authors ("Ethan Leba" . "ethanleba5@gmail.com")) (:maintainers ("Ethan Leba" . "ethanleba5@gmail.com")) (:maintainer "Ethan Leba" . "ethanleba5@gmail.com"))]) (tree-mode . [(20151104 1331) nil "A mode to manage tree widgets" tar ((:url . "https://github.com/emacsorphanage/tree-mode") (:commit . "b06078826d5875d74b0e7b7ac47b0d0917610534") (:revdesc . "b06078826d58") (:keywords "help" "convenience" "widget") (:authors (nil . "wenbinye@163.com")) (:maintainers (nil . "wenbinye@163.com")) (:maintainer nil . "wenbinye@163.com"))]) (tree-sitter . [(20220212 1632) ((emacs (25 1)) (tsc (0 18 0))) "Incremental parsing system" tar ((:url . "https://github.com/emacs-tree-sitter/elisp-tree-sitter") (:commit . "909717c685ff5a2327fa2ca8fb8a25216129361c") (:revdesc . "909717c685ff") (:keywords "languages" "tools" "parsers" "tree-sitter") (:authors ("Tuấn-Anh Nguyễn" . "ubolonton@gmail.com")) (:maintainers ("Tuấn-Anh Nguyễn" . "ubolonton@gmail.com")) (:maintainer "Tuấn-Anh Nguyễn" . "ubolonton@gmail.com"))]) - (tree-sitter-ess-r . [(20221012 855) ((emacs (26 1)) (ess (18 10 1)) (tree-sitter (0 12 1)) (tree-sitter-langs (0 12 0))) "R with tree-sitter" tar ((:url . "https://github.com/ShuguangSun/tree-sitter-ess-r") (:commit . "9669c00f3d3463e6769725af74c392891e269eed") (:revdesc . "9669c00f3d34") (:keywords "tools") (:authors ("Shuguang Sun" . "shuguang79@qq.com")) (:maintainers ("Shuguang Sun" . "shuguang79@qq.com")) (:maintainer "Shuguang Sun" . "shuguang79@qq.com"))]) + (tree-sitter-ess-r . [(20241120 757) ((emacs (26 1)) (ess (18 10 1)) (tree-sitter (0 12 1)) (tree-sitter-langs (0 12 0))) "R with tree-sitter" tar ((:url . "https://github.com/ShuguangSun/tree-sitter-ess-r") (:commit . "895846900530017e91f95374a125c66b01d8925c") (:revdesc . "895846900530") (:keywords "tools") (:authors ("Shuguang Sun" . "shuguang79@qq.com")) (:maintainers ("Shuguang Sun" . "shuguang79@qq.com")) (:maintainer "Shuguang Sun" . "shuguang79@qq.com"))]) (tree-sitter-indent . [(20220411 1439) ((emacs (26 1)) (tree-sitter (0 12 1)) (seq (2 20))) "Provide indentation with a Tree-sitter backend" tar ((:url . "https://codeberg.org/FelipeLema/tree-sitter-indent.el") (:commit . "4ef246db3e4ff99f672fe5e4b416c890f885c09e") (:revdesc . "4ef246db3e4f") (:keywords "convenience" "internal") (:authors ("Felipe Lema" . "felipelema@mortemale.org")) (:maintainers ("Felipe Lema" . "felipelema@mortemale.org")) (:maintainer "Felipe Lema" . "felipelema@mortemale.org"))]) (tree-sitter-ispell . [(20240610 2252) ((emacs (26 1)) (tree-sitter (0 15 0))) "Run ispell on tree-sitter text nodes" tar ((:url . "https://github.com/erickgnavar/tree-sitter-ispell.el") (:commit . "a06eff00affff85992d2a8ad0019034747ffeb70") (:revdesc . "a06eff00afff") (:authors ("Erick Navarro" . "erick@navarro.io")) (:maintainers ("Erick Navarro" . "erick@navarro.io")) (:maintainer "Erick Navarro" . "erick@navarro.io"))]) - (tree-sitter-langs . [(20241110 1307) ((emacs (25 1)) (tree-sitter (0 15 0))) "Grammar bundle for tree-sitter" tar ((:url . "https://github.com/emacs-tree-sitter/tree-sitter-langs") (:commit . "213b1c4db852a97480e029453af869ff1a0764e0") (:revdesc . "213b1c4db852") (:keywords "languages" "tools" "parsers" "tree-sitter") (:authors ("Tuấn-Anh Nguyễn" . "ubolonton@gmail.com")) (:maintainers ("Tuấn-Anh Nguyễn" . "ubolonton@gmail.com")) (:maintainer "Tuấn-Anh Nguyễn" . "ubolonton@gmail.com"))]) + (tree-sitter-langs . [(20241118 451) ((emacs (25 1)) (tree-sitter (0 15 0))) "Grammar bundle for tree-sitter" tar ((:url . "https://github.com/emacs-tree-sitter/tree-sitter-langs") (:commit . "b955ffbe26b3a7e931f116720efa7dee9de35174") (:revdesc . "b955ffbe26b3") (:keywords "languages" "tools" "parsers" "tree-sitter") (:authors ("Tuấn-Anh Nguyễn" . "ubolonton@gmail.com")) (:maintainers ("Tuấn-Anh Nguyễn" . "ubolonton@gmail.com")) (:maintainer "Tuấn-Anh Nguyễn" . "ubolonton@gmail.com"))]) (treebundel . [(20240531 2321) ((emacs (27 1)) (compat (29 1 4 2))) "Bundle related git-worktrees together" tar ((:url . "https://github.com/purplg/treebundel") (:commit . "b0a5d1bf924d8cadde5bae50b8d9ac131279b828") (:revdesc . "b0a5d1bf924d") (:keywords "convenience" "vc"))]) (treefactor . [(20200516 1631) ((emacs (26 1)) (dash (2 16 0)) (f (0 20 0)) (org (9 2 6)) (avy (0 5 0))) "Restructure your messy Org documents" tar ((:url . "https://github.com/cyberthal/treefactor") (:commit . "75357757022a4399ab772ff0d92065bd114dabe9") (:revdesc . "75357757022a") (:keywords "outlines" "files" "convenience") (:authors ("Leo Littlebook" . "Leo.Littlebook@gmail.com")) (:maintainers ("Leo Littlebook" . "Leo.Littlebook@gmail.com")) (:maintainer "Leo Littlebook" . "Leo.Littlebook@gmail.com"))]) (treemacs . [(20241113 2139) ((emacs (26 1)) (cl-lib (0 5)) (dash (2 11 0)) (s (1 12 0)) (ace-window (0 9 0)) (pfuture (1 7)) (hydra (0 13 2)) (ht (2 2)) (cfrs (1 3 2))) "A tree style file explorer package" tar ((:url . "https://github.com/Alexander-Miller/treemacs") (:commit . "2fd7745f1bc446fc590dc7ba2eb4e062a51fbb3e") (:revdesc . "2fd7745f1bc4") (:authors ("Alexander Miller" . "alexanderm@web.de")) (:maintainers ("Alexander Miller" . "alexanderm@web.de")) (:maintainer "Alexander Miller" . "alexanderm@web.de"))]) @@ -5538,7 +5543,7 @@ (visual-fill-column . [(20240411 656) ((emacs (25 1))) "Fill-column for visual-line-mode" tar ((:url . "https://codeberg.org/joostkremers/visual-fill-column") (:commit . "e04d3521b6dc2435de4c4a4b9cac5feb194f0d5b") (:revdesc . "e04d3521b6dc") (:authors ("Joost Kremers" . "joostkremers@fastmail.fm")) (:maintainers ("Joost Kremers" . "joostkremers@fastmail.fm")) (:maintainer "Joost Kremers" . "joostkremers@fastmail.fm"))]) (visual-regexp . [(20210502 2019) ((cl-lib (0 2))) "A regexp/replace command for Emacs with interactive visual feedback" tar ((:url . "https://github.com/benma/visual-regexp.el") (:commit . "48457d42a5e0fe10fa3a9c15854f1f127ade09b5") (:revdesc . "48457d42a5e0") (:keywords "regexp" "replace" "visual" "feedback") (:authors ("Marko Bencun" . "mbencun@gmail.com")) (:maintainers ("Marko Bencun" . "mbencun@gmail.com")) (:maintainer "Marko Bencun" . "mbencun@gmail.com"))]) (visual-regexp-steroids . [(20170222 253) ((visual-regexp (1 1))) "Extends visual-regexp to support other regexp engines" tar ((:url . "https://github.com/benma/visual-regexp-steroids.el") (:commit . "a6420b25ec0fbba43bf57875827092e1196d8a9e") (:revdesc . "a6420b25ec0f") (:keywords "external" "foreign" "regexp" "replace" "python" "visual" "feedback") (:authors ("Marko Bencun" . "mbencun@gmail.com")) (:maintainers ("Marko Bencun" . "mbencun@gmail.com")) (:maintainer "Marko Bencun" . "mbencun@gmail.com"))]) - (visual-replace . [(20241112 1826) ((emacs (26 1))) "A prompt for replace-string and query-replace" tar ((:url . "https://github.com/szermatt/visual-replace") (:commit . "f659e56ccafc19bef35ba0418f51527b5cc18455") (:revdesc . "f659e56ccafc") (:keywords "convenience" "matching" "replace") (:authors ("Stephane Zermatten" . "szermatt@gmail.com")) (:maintainers ("Stephane Zermatten" . "szermatt@gmail.com")) (:maintainer "Stephane Zermatten" . "szermatt@gmail.com"))]) + (visual-replace . [(20241118 2004) ((emacs (26 1))) "A prompt for replace-string and query-replace" tar ((:url . "https://github.com/szermatt/visual-replace") (:commit . "ef41f40371974e8c13dbd82f2fd11fdee98d99a1") (:revdesc . "ef41f4037197") (:keywords "convenience" "matching" "replace") (:authors ("Stephane Zermatten" . "szermatt@gmail.com")) (:maintainers ("Stephane Zermatten" . "szermatt@gmail.com")) (:maintainer "Stephane Zermatten" . "szermatt@gmail.com"))]) (vlc . [(20200328 1143) ((emacs (25 1))) "VideoLAN VLC Media Player Control" tar ((:url . "https://github.com/xuchunyang/vlc.el") (:commit . "07c4a12904f2700fb8420c4e71395fd59a5e6faa") (:revdesc . "07c4a12904f2") (:keywords "tools"))]) (vlf . [(20191126 2250) nil "View Large Files" tar ((:url . "https://github.com/m00natic/vlfi") (:commit . "cc02f2533782d6b9b628cec7e2dcf25b2d05a27c") (:revdesc . "cc02f2533782") (:keywords "large files" "utilities") (:maintainers ("Andrey Kotlarski" . "m00naticus@gmail.com")) (:maintainer "Andrey Kotlarski" . "m00naticus@gmail.com"))]) (vline . [(20210805 1528) ((emacs (24 3))) "Column highlighting (vertical line displaying) mode" tar ((:url . "https://github.com/buzztaiki/vline") (:commit . "f5d7b5743dceca75b81c8c95287cd5b0341debf9") (:revdesc . "f5d7b5743dce") (:keywords "faces" "editing" "emulating") (:authors ("Taiki SUGAWARA" . "buzz.taiki@gmail.com")) (:maintainers ("Taiki SUGAWARA" . "buzz.taiki@gmail.com")) (:maintainer "Taiki SUGAWARA" . "buzz.taiki@gmail.com"))]) @@ -5552,7 +5557,7 @@ (vscode-dark-plus-theme . [(20230725 1703) nil "Default Visual Studio Code Dark+ theme" tar ((:url . "https://github.com/ianyepan/vscode-dark-plus-emacs-theme") (:commit . "65420ca73b543e1e7955905bea1a8d7e5fe6c5ff") (:revdesc . "65420ca73b54"))]) (vscode-icon . [(20230330 2206) ((emacs (25 1))) "Utility package to provide Vscode style icons" tar ((:url . "https://github.com/jojojames/vscode-icon-emacs") (:commit . "3976bc2e7e2fe0068ae59c11d226f67e0e87aaea") (:revdesc . "3976bc2e7e2f") (:keywords "files" "tools") (:authors ("James Nguyen" . "james@jojojames.com")) (:maintainers ("James Nguyen" . "james@jojojames.com")) (:maintainer "James Nguyen" . "james@jojojames.com"))]) (vsh-mode . [(20240820 1320) ((emacs (30 0))) "Alternate PTY interface for complex terminal sessions" tar ((:url . "https://github.com/hardenedapple/vsh") (:commit . "40daabb4b05e1dce8bc9b68cb437d9aff3cfa7d0") (:revdesc . "40daabb4b05e") (:keywords "processes") (:authors ("Matthew Malcomson" . "hardenedapple@gmail.com")) (:maintainers ("Matthew Malcomson" . "hardenedapple@gmail.com")) (:maintainer "Matthew Malcomson" . "hardenedapple@gmail.com"))]) - (vterm . [(20240825 133) ((emacs (25 1))) "Fully-featured terminal emulator" tar ((:url . "https://github.com/akermu/emacs-libvterm") (:commit . "988279316fc89e6d78947b48513f248597ba969a") (:revdesc . "988279316fc8") (:keywords "terminals") (:authors ("Lukas Fürmetz" . "fuermetz@mailbox.org")) (:maintainers ("Lukas Fürmetz" . "fuermetz@mailbox.org")) (:maintainer "Lukas Fürmetz" . "fuermetz@mailbox.org"))]) + (vterm . [(20241118 1627) ((emacs (25 1))) "Fully-featured terminal emulator" tar ((:url . "https://github.com/akermu/emacs-libvterm") (:commit . "fd50624723200f4ac261f122f6332f57796c782f") (:revdesc . "fd5062472320") (:keywords "terminals") (:authors ("Lukas Fürmetz" . "fuermetz@mailbox.org")) (:maintainers ("Lukas Fürmetz" . "fuermetz@mailbox.org")) (:maintainer "Lukas Fürmetz" . "fuermetz@mailbox.org"))]) (vterm-hotkey . [(20240702 1445) ((emacs (29 4)) (vterm (0 0))) "Control vterm buffers with hotkeys" tar ((:url . "https://github.com/rootatpixel/vterm-hotkey") (:commit . "039033a4c30dabca625d6924d1796bb9e13d85c7") (:revdesc . "039033a4c30d") (:keywords "terminals" "processes" "hotkeys"))]) (vterm-toggle . [(20230912 246) ((emacs (25 1)) (vterm (0 0 1))) "Toggles between the vterm buffer and other buffers" tar ((:url . "https://github.com/jixiuf/vterm-toggle") (:commit . "06cb4f3c565e46470a3c4505c11e26066d869715") (:revdesc . "06cb4f3c565e") (:keywords "vterm" "terminals") (:authors (nil . "jixiufjixiuf@qq.com")) (:maintainers (nil . "jixiufjixiuf@qq.com")) (:maintainer nil . "jixiufjixiuf@qq.com"))]) (vtm . [(20200921 338) nil "Manages vterm buffers with configuration files" tar ((:url . "https://github.com/laishulu/emacs-vterm-manager") (:commit . "d770fd8cff7c24688199392ad93c01485c6a9569") (:revdesc . "d770fd8cff7c") (:keywords "convenience"))]) @@ -5696,7 +5701,7 @@ (wwtime . [(20151122 1610) nil "Insert a time of day with appropriate world-wide localization" tar ((:url . "https://github.com/ndw/wwtime") (:commit . "d04d8fa814b5d3644efaeb28f25520ada69acbbd") (:revdesc . "d04d8fa814b5") (:keywords "time") (:authors ("Norman Walsh" . "ndw@nwalsh.com")) (:maintainers ("Norman Walsh" . "ndw@nwalsh.com")) (:maintainer "Norman Walsh" . "ndw@nwalsh.com"))]) (www-synonyms . [(20170128 2251) ((request (0 2 0)) (cl-lib (0 5))) "Insert synonym for a word" tar ((:url . "https://github.com/spebern/www-synonyms") (:commit . "7e37ea35064ff31c9945f0198a653647d408c936") (:revdesc . "7e37ea35064f") (:keywords "lisp") (:authors ("Bernhard Specht" . "bernhard@specht.net")) (:maintainers ("Bernhard Specht" . "bernhard@specht.net")) (:maintainer "Bernhard Specht" . "bernhard@specht.net"))]) (x-path-walker . [(20220714 1056) ((helm-core (3 6 0))) "Navigation feature for JSON/XML/HTML based on path (imenu like)" tar ((:url . "https://github.com/Lompik/x-path-walker") (:commit . "c91deaaba0d5cc9018008a39c96222deacba3868") (:revdesc . "c91deaaba0d5") (:keywords "convenience") (:authors (nil . "lompik@ArchOrion")) (:maintainers (nil . "lompik@ArchOrion")) (:maintainer nil . "lompik@ArchOrion"))]) - (x509-mode . [(20241116 1230) ((emacs (25 1)) (compat (29 1 4 2))) "View certificates, CRLs and keys using OpenSSL" tar ((:url . "https://github.com/jobbflykt/x509-mode") (:commit . "b30bc5e91b28ade6802d80513954a7ec4f025db2") (:revdesc . "b30bc5e91b28") (:authors ("Fredrik Axelsson" . "f.axelsson@gmail.com")) (:maintainers ("Fredrik Axelsson" . "f.axelsson@gmail.com")) (:maintainer "Fredrik Axelsson" . "f.axelsson@gmail.com"))]) + (x509-mode . [(20241119 1907) ((emacs (25 1)) (compat (29 1 4 2))) "View certificates, CRLs and keys using OpenSSL" tar ((:url . "https://github.com/jobbflykt/x509-mode") (:commit . "b4dc55ee6f9e22e6558fe72a0c350b2c3a771f66") (:revdesc . "b4dc55ee6f9e") (:authors ("Fredrik Axelsson" . "f.axelsson@gmail.com")) (:maintainers ("Fredrik Axelsson" . "f.axelsson@gmail.com")) (:maintainer "Fredrik Axelsson" . "f.axelsson@gmail.com"))]) (x86-lookup . [(20240823 1135) ((emacs (24 3)) (cl-lib (0 3))) "Jump to x86 instruction documentation" tar ((:url . "https://github.com/skeeto/x86-lookup") (:commit . "0a6e4faceb3c313c3ee0ac4b086326a7553c1d8b") (:revdesc . "0a6e4faceb3c") (:authors ("Christopher Wellons" . "wellons@nullprogram.com")) (:maintainers ("Christopher Wellons" . "wellons@nullprogram.com")) (:maintainer "Christopher Wellons" . "wellons@nullprogram.com"))]) (xbm-life . [(20210508 1640) ((emacs (24 1))) "A XBM version of Conway's Game of Life" tar ((:url . "https://depp.brause.cc/xbm-life.git") (:commit . "ec6abb0182068294a379cb49ad5346b1d757457d") (:revdesc . "ec6abb018206") (:keywords "games") (:authors ("Vasilij Schneidermann" . "mail@vasilij.de")) (:maintainers ("Vasilij Schneidermann" . "mail@vasilij.de")) (:maintainer "Vasilij Schneidermann" . "mail@vasilij.de"))]) (xcode-mode . [(20160907 1208) ((emacs (24 4)) (s (1 10 0)) (dash (2 11 0)) (multiple-cursors (1 0 0))) "A minor mode for emacs to perform Xcode like actions" tar ((:url . "https://github.com/nicklanasa/xcode-mode") (:commit . "5b5f0a4f505d44840a4924b24e3ef73b8528d98b") (:revdesc . "5b5f0a4f505d") (:keywords "conveniences") (:authors ("Nickolas Lanasa" . "nick@nytekproductions.com")) (:maintainers ("Nickolas Lanasa" . "nick@nytekproductions.com")) (:maintainer "Nickolas Lanasa" . "nick@nytekproductions.com"))]) diff --git a/emacs/elpa/archives/nongnu/archive-contents b/emacs/elpa/archives/nongnu/archive-contents @@ -1418,13 +1418,13 @@ ((:url . "https://elpa.nongnu.org/nongnu/jinja2-mode.html") (:commit . "a598357069a68b0ac2bf128c19edd8e899084cdc"))]) (julia-mode . - [(1 0 0) + [(1 0 1) ((emacs (26 1))) "Major mode for editing Julia source code" tar ((:url . "https://github.com/JuliaEditorSupport/julia-emacs") (:keywords "languages") - (:commit . "ee086a779b80f2fab83db484f453c7d41509e73e"))]) + (:commit . "6283427deefa02e6b87b28efa18a66dcbe50317f"))]) (keycast . [(1 4 1) ((emacs @@ -2262,14 +2262,14 @@ ("John Olsson" . "john@cryon.se")) (:commit . "2d5acd143a153e16372d59000e57d76291ab81dd"))]) (subed . - [(1 2 19) + [(1 2 21) ((emacs (25 1))) "A major mode for editing subtitles" tar ((:url . "https://github.com/sachac/subed") (:keywords "convenience" "files" "hypermedia" "multimedia") (:maintainer "Sacha Chua" . "sacha@sachachua.com") - (:commit . "a8b755bbfd6f0bbffcff361531cd36bc842dd733"))]) + (:commit . "ace4b62fd06554fad1e2ae62339b448c30c9ae70"))]) (sweeprolog . [(0 27 6) ((emacs @@ -2617,14 +2617,14 @@ ((:url . "https://github.com/lewang/ws-butler") (:commit . "d3927f6131f215e9cd3e1f747be5a91e5be8ca9a"))]) (xah-fly-keys . - [(26 7 20241109085947) + [(26 8 20241118173945) ((emacs (27))) "ergonomic modal keybinding minor mode." tar ((:url . "http://xahlee.info/emacs/misc/xah-fly-keys.html") (:keywords "convenience" "vi" "vim" "ergoemacs" "keybinding") (:maintainer "Xah Lee" . "xah@xahlee.org") - (:commit . "be3260765c6891dcbdffbcdb85359288e87ddb3b"))]) + (:commit . "6ef7d2cc36a3f1a69edda0b431d20d1752b53e95"))]) (xkcd . [(1 1) ((json diff --git a/emacs/elpa/archives/nongnu/archive-contents.signed b/emacs/elpa/archives/nongnu/archive-contents.signed @@ -1 +1 @@ -Good signature from 645357D2883A0966 GNU ELPA Signing Agent (2023) <elpasign@elpa.gnu.org> (trust undefined) created at 2024-11-17T10:05:05+0000 using EDDSA -\ No newline at end of file +Good signature from 645357D2883A0966 GNU ELPA Signing Agent (2023) <elpasign@elpa.gnu.org> (trust undefined) created at 2024-11-20T10:10:03+0000 using EDDSA +\ No newline at end of file diff --git a/emacs/elpa/consult-20241115.517/consult-pkg.el b/emacs/elpa/consult-20241115.517/consult-pkg.el @@ -1,10 +0,0 @@ -;; -*- no-byte-compile: t; lexical-binding: nil -*- -(define-package "consult" "20241115.517" - "Consulting completing-read." - '((emacs "28.1") - (compat "30")) - :url "https://github.com/minad/consult" - :commit "554c21567a05e367a0daf60a199ba1db6ba09eca" - :revdesc "554c21567a05" - :keywords '("matching" "files" "completion") - :maintainers '(("Daniel Mendler" . "mail@daniel-mendler.de"))) diff --git a/emacs/elpa/consult-20241115.517/consult.el b/emacs/elpa/consult-20241115.517/consult.el @@ -1,5254 +0,0 @@ -;;; consult.el --- Consulting completing-read -*- lexical-binding: t -*- - -;; Copyright (C) 2021-2024 Free Software Foundation, Inc. - -;; Author: Daniel Mendler and Consult contributors -;; Maintainer: Daniel Mendler <mail@daniel-mendler.de> -;; Created: 2020 -;; Package-Version: 20241115.517 -;; Package-Revision: 554c21567a05 -;; Package-Requires: ((emacs "28.1") (compat "30")) -;; URL: https://github.com/minad/consult -;; Keywords: matching, files, completion - -;; This file is 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 this program. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Consult implements a set of `consult-<thing>' commands, which aim to -;; improve the way you use Emacs. The commands are founded on -;; `completing-read', which selects from a list of candidate strings. -;; Consult provides an enhanced buffer switcher `consult-buffer' and -;; search and navigation commands like `consult-imenu' and -;; `consult-line'. Searching through multiple files is supported by the -;; asynchronous `consult-grep' command. Many Consult commands support -;; previewing candidates. If a candidate is selected in the completion -;; view, the buffer shows the candidate immediately. - -;; The Consult commands are compatible with multiple completion systems -;; based on the Emacs `completing-read' API, including the default -;; completion system, Vertico, Mct and Icomplete. - -;; See the README for an overview of the available Consult commands and -;; the documentation of the configuration and installation of the -;; package. - -;; The full list of contributors can be found in the acknowledgments -;; section of the README. - -;;; Code: - -(eval-when-compile - (require 'cl-lib) - (require 'subr-x)) -(require 'compat) -(require 'bookmark) - -(defgroup consult nil - "Consulting `completing-read'." - :link '(info-link :tag "Info Manual" "(consult)") - :link '(url-link :tag "Website" "https://github.com/minad/consult") - :link '(url-link :tag "Wiki" "https://github.com/minad/consult/wiki") - :link '(emacs-library-link :tag "Library Source" "consult.el") - :group 'files - :group 'outlines - :group 'minibuffer - :prefix "consult-") - -;;;; Customization - -(defcustom consult-narrow-key nil - "Prefix key for narrowing during completion. - -Good choices for this key are \"<\" and \"C-+\" for example. The -key must be a string accepted by `key-valid-p'." - :type '(choice key (const :tag "None" nil))) - -(defcustom consult-widen-key nil - "Key used for widening during completion. - -If this key is unset, defaults to twice the `consult-narrow-key'. -The key must be a string accepted by `key-valid-p'." - :type '(choice key (const :tag "None" nil))) - -(defcustom consult-project-function - #'consult--default-project-function - "Function which returns project root directory. -The function takes one boolean argument MAY-PROMPT. If -MAY-PROMPT is non-nil, the function may ask the prompt the user -for a project directory. The root directory is used by -`consult-buffer' and `consult-grep'." - :type `(choice - (const :tag "Default project function" ,#'consult--default-project-function) - (function :tag "Custom function") - (const :tag "No project integration" nil))) - -(defcustom consult-async-refresh-delay 0.2 - "Refreshing delay of the completion UI for asynchronous commands. - -The completion UI is only updated every -`consult-async-refresh-delay' seconds. This applies to -asynchronous commands like for example `consult-grep'." - :type '(float :tag "Delay in seconds")) - -(defcustom consult-async-input-throttle 0.5 - "Input throttle for asynchronous commands. - -The asynchronous process is started only every -`consult-async-input-throttle' seconds. This applies to asynchronous -commands, e.g., `consult-grep'." - :type '(float :tag "Delay in seconds")) - -(defcustom consult-async-input-debounce 0.2 - "Input debounce for asynchronous commands. - -The asynchronous process is started only when there has not been new -input for `consult-async-input-debounce' seconds. This applies to -asynchronous commands, e.g., `consult-grep'." - :type '(float :tag "Delay in seconds")) - -(defcustom consult-async-min-input 3 - "Minimum number of characters needed, before asynchronous process is called. - -This applies to asynchronous commands, e.g., `consult-grep'." - :type '(natnum :tag "Number of characters")) - -(defcustom consult-async-split-style 'perl - "Async splitting style, see `consult-async-split-styles-alist'." - :type '(choice (const :tag "No splitting" nil) - (const :tag "Comma" comma) - (const :tag "Semicolon" semicolon) - (const :tag "Perl" perl))) - -(defcustom consult-async-split-styles-alist - `((nil :function ,#'consult--split-nil) - (comma :separator ?, :function ,#'consult--split-separator) - (semicolon :separator ?\; :function ,#'consult--split-separator) - (perl :initial "#" :function ,#'consult--split-perl)) - "Async splitting styles." - :type '(alist :key-type symbol :value-type plist)) - -(defcustom consult-mode-histories - '((eshell-mode eshell-history-ring eshell-history-index eshell-bol) - (comint-mode comint-input-ring comint-input-ring-index comint-bol) - (term-mode term-input-ring term-input-ring-index term-bol)) - "Alist of mode histories (mode history index bol). -The histories can be rings or lists. Index, if provided, is a -variable to set to the index of the selection within the ring or -list. Bol, if provided is a function which jumps to the beginning -of the line after the prompt." - :type '(alist :key-type symbol - :value-type (group :tag "Include Index" - (symbol :tag "List/Ring") - (symbol :tag "Index Variable") - (symbol :tag "Bol Function")))) - -(defcustom consult-themes nil - "List of themes (symbols or regexps) to be presented for selection. -nil shows all `custom-available-themes'." - :type '(repeat (choice symbol regexp))) - -(defcustom consult-after-jump-hook (list #'recenter) - "Function called after jumping to a location. - -Commonly used functions for this hook are `recenter' and -`reposition-window'. You may want to add a function which pulses the -current line, e.g., `pulse-momentary-highlight-one-line'. The hook -called during preview and for the jump after selection." - :type 'hook) - -(defcustom consult-line-start-from-top nil - "Start search from the top if non-nil. -Otherwise start the search at the current line and wrap around." - :type 'boolean) - -(defcustom consult-point-placement 'match-beginning - "Where to leave point when jumping to a match. -This setting affects the command `consult-line' and the `consult-grep' variants." - :type '(choice (const :tag "Beginning of the line" line-beginning) - (const :tag "Beginning of the match" match-beginning) - (const :tag "End of the match" match-end))) - -(defcustom consult-line-numbers-widen t - "Show absolute line numbers when narrowing is active. - -See also `display-line-numbers-widen'." - :type 'boolean) - -(defcustom consult-goto-line-numbers t - "Show line numbers for `consult-goto-line'." - :type 'boolean) - -(defcustom consult-fontify-preserve t - "Preserve fontification for line-based commands." - :type 'boolean) - -(defcustom consult-fontify-max-size 1048576 - "Buffers larger than this byte limit are not fontified. - -This is necessary in order to prevent a large startup time -for navigation commands like `consult-line'." - :type '(natnum :tag "Buffer size in bytes")) - -(defcustom consult-buffer-filter - '("\\` " - "\\`\\*Completions\\*\\'" - "\\`\\*Flymake log\\*\\'" - "\\`\\*Semantic SymRef\\*\\'" - "\\`\\*vc\\*\\'" - "\\`newsrc-dribble\\'" ;; Gnus - "\\`\\*tramp/.*\\*\\'") - "Filter regexps for `consult-buffer'. - -The default setting is to filter ephemeral buffer names beginning -with a space character, the *Completions* buffer and a few log -buffers. The regular expressions are matched case sensitively." - :type '(repeat regexp)) - -(defcustom consult-buffer-sources - '(consult--source-hidden-buffer - consult--source-modified-buffer - consult--source-buffer - consult--source-recent-file - consult--source-file-register - consult--source-bookmark - consult--source-project-buffer-hidden - consult--source-project-recent-file-hidden) - "Sources used by `consult-buffer'. -See also `consult-project-buffer-sources'. -See `consult--multi' for a description of the source data structure." - :type '(repeat symbol)) - -(defcustom consult-project-buffer-sources - '(consult--source-project-buffer - consult--source-project-recent-file) - "Sources used by `consult-project-buffer'. -See also `consult-buffer-sources'. -See `consult--multi' for a description of the source data structure." - :type '(repeat symbol)) - -(defcustom consult-mode-command-filter - '(;; Filter commands - "-mode\\'" "--" - ;; Filter whole features - simple mwheel time so-long recentf tab-bar tab-line) - "Filter commands for `consult-mode-command'." - :type '(repeat (choice symbol regexp))) - -(defcustom consult-grep-max-columns 300 - "Maximal number of columns of grep output. -If set to nil, do not truncate candidates. This can have negative -performance implications but helps if you want to export long lines via -`embark-export'." - :type '(choice natnum (const nil))) - -(defconst consult--grep-match-regexp - "\\`\\(?:\\./\\)?\\([^\n\0]+\\)\0\\([0-9]+\\)\\([-:\0]\\)" - "Regexp used to match file and line of grep output.") - -(defcustom consult-grep-args - '("grep" (consult--grep-exclude-args) - "--null --line-buffered --color=never --ignore-case\ - --with-filename --line-number -I -r") - "Command line arguments for grep, see `consult-grep'. -The dynamically computed arguments are appended. -Can be either a string, or a list of strings or expressions." - :type '(choice string (repeat (choice string sexp)))) - -(defcustom consult-git-grep-args - "git --no-pager grep --null --color=never --ignore-case\ - --extended-regexp --line-number -I" - "Command line arguments for git-grep, see `consult-git-grep'. -The dynamically computed arguments are appended. -Can be either a string, or a list of strings or expressions." - :type '(choice string (repeat (choice string sexp)))) - -(defcustom consult-ripgrep-args - "rg --null --line-buffered --color=never --max-columns=1000 --path-separator /\ - --smart-case --no-heading --with-filename --line-number --search-zip" - "Command line arguments for ripgrep, see `consult-ripgrep'. -The dynamically computed arguments are appended. -Can be either a string, or a list of strings or expressions." - :type '(choice string (repeat (choice string sexp)))) - -(defcustom consult-find-args - "find . -not ( -path */.[A-Za-z]* -prune )" - "Command line arguments for find, see `consult-find'. -The dynamically computed arguments are appended. -Can be either a string, or a list of strings or expressions." - :type '(choice string (repeat (choice string sexp)))) - -(defcustom consult-fd-args - '((if (executable-find "fdfind" 'remote) "fdfind" "fd") - "--full-path --color=never") - "Command line arguments for fd, see `consult-fd'. -The dynamically computed arguments are appended. -Can be either a string, or a list of strings or expressions." - :type '(choice string (repeat (choice string sexp)))) - -(defcustom consult-locate-args - "locate --ignore-case" ;; --existing not supported by Debian plocate - "Command line arguments for locate, see `consult-locate'. -The dynamically computed arguments are appended. -Can be either a string, or a list of strings or expressions." - :type '(choice string (repeat (choice string sexp)))) - -(defcustom consult-man-args - "man -k" - "Command line arguments for man, see `consult-man'. -The dynamically computed arguments are appended. -Can be either a string, or a list of strings or expressions." - :type '(choice string (repeat (choice string sexp)))) - -(defcustom consult-preview-key 'any - "Preview trigger keys, can be nil, `any', a single key or a list of keys. -Debouncing can be specified via the `:debounce' attribute. The -individual keys must be strings accepted by `key-valid-p'." - :type '(choice (const :tag "Any key" any) - (list :tag "Debounced" - (const :debounce) - (float :tag "Seconds" 0.1) - (const any)) - (const :tag "No preview" nil) - (key :tag "Key") - (repeat :tag "List of keys" key))) - -(defcustom consult-preview-partial-size 1048576 - "Files larger than this byte limit are previewed partially." - :type '(natnum :tag "File size in bytes")) - -(defcustom consult-preview-partial-chunk 102400 - "Partial preview chunk size in bytes. -If a file is larger than `consult-preview-partial-size' only the -chunk from the beginning of the file is previewed." - :type '(natnum :tag "Chunk size in bytes")) - -(defcustom consult-preview-max-count 10 - "Number of file buffers to keep open temporarily during preview." - :type '(natnum :tag "Number of buffers")) - -(defcustom consult-preview-excluded-buffers nil - "Buffers excluded from preview. -The value should conform to the predicate format demanded by the -function `buffer-match-p'." - :type 'sexp) - -(defcustom consult-preview-excluded-files - '("\\`/[^/|:]+:") ;; Do not preview remote files - "List of regexps matched against names of files, which are not previewed." - :type '(repeat regexp)) - -(defcustom consult-preview-allowed-hooks - '(global-font-lock-mode - save-place-find-file-hook) - "List of hooks, which should be executed during file preview. -This variable applies to `find-file-hook', `change-major-mode-hook' and -mode hooks, e.g., `prog-mode-hook'." - :type '(repeat symbol)) - -(defcustom consult-preview-variables - '((inhibit-message . t) - (enable-dir-local-variables . nil) - (enable-local-variables . :safe) - (non-essential . t) - (delay-mode-hooks . t)) - "Variables which are bound for file preview." - :type '(alist :key-type symbol)) - -(defcustom consult-bookmark-narrow - `((?f "File" bookmark-default-handler) - (?h "Help" help-bookmark-jump Info-bookmark-jump - Man-bookmark-jump woman-bookmark-jump) - (?p "Picture" image-bookmark-jump) - (?d "Docview" doc-view-bookmark-jump) - (?m "Mail" gnus-summary-bookmark-jump) - (?s "Eshell" eshell-bookmark-jump) - (?w "Web" eww-bookmark-jump xwidget-webkit-bookmark-jump-handler) - (?v "VC Directory" vc-dir-bookmark-jump) - (nil "Other")) - "Bookmark narrowing configuration. - -Each element of the list must have the form (char name handlers...)." - :type '(alist :key-type character :value-type (cons string (repeat function)))) - -(define-obsolete-variable-alias - 'consult-yank-rotate 'yank-from-kill-ring-rotate "1.8") - -;;;; Faces - -(defgroup consult-faces nil - "Faces used by Consult." - :group 'consult - :group 'faces) - -(defface consult-preview-line - '((t :inherit consult-preview-insertion :extend t)) - "Face used for line previews.") - -(defface consult-highlight-match - '((t :inherit match)) - "Face used to highlight matches in the completion candidates. -Used for example by `consult-grep'.") - -(defface consult-highlight-mark - '((t :inherit consult-highlight-match)) - "Face used for mark positions in completion candidates. -Used for example by `consult-mark'. The face should be different -than the `cursor' face to avoid confusion.") - -(defface consult-preview-match - '((t :inherit isearch)) - "Face used for match previews, e.g., in `consult-line'.") - -(defface consult-preview-insertion - '((t :inherit region)) - "Face used for previews of text to be inserted. -Used by `consult-completion-in-region', `consult-yank' and `consult-history'.") - -(defface consult-narrow-indicator - '((t :inherit warning)) - "Face used for the narrowing indicator.") - -(defface consult-async-running - '((t :inherit consult-narrow-indicator)) - "Face used if asynchronous process is running.") - -(defface consult-async-finished - '((t :inherit success)) - "Face used if asynchronous process has finished.") - -(defface consult-async-failed - '((t :inherit error)) - "Face used if asynchronous process has failed.") - -(defface consult-async-split - '((t :inherit font-lock-negation-char-face)) - "Face used to highlight punctuation character.") - -(defface consult-help - '((t :inherit shadow)) - "Face used to highlight help, e.g., in `consult-register-store'.") - -(defface consult-key - '((t :inherit font-lock-keyword-face)) - "Face used to highlight keys, e.g., in `consult-register'.") - -(defface consult-line-number - '((t :inherit consult-key)) - "Face used to highlight location line in `consult-global-mark'.") - -(defface consult-file - '((t :inherit font-lock-function-name-face)) - "Face used to highlight files in `consult-buffer'.") - -(defface consult-grep-context - '((t :inherit shadow)) - "Face used to highlight grep context in `consult-grep'.") - -(defface consult-bookmark - '((t :inherit font-lock-constant-face)) - "Face used to highlight bookmarks in `consult-buffer'.") - -(defface consult-buffer - '((t)) - "Face used to highlight buffers in `consult-buffer'.") - -(defface consult-line-number-prefix - '((t :inherit line-number)) - "Face used to highlight line number prefixes.") - -(defface consult-line-number-wrapped - '((t :inherit consult-line-number-prefix :inherit font-lock-warning-face)) - "Face used to highlight line number prefixes after wrap around.") - -(defface consult-separator - '((((class color) (min-colors 88) (background light)) - :foreground "#ccc") - (((class color) (min-colors 88) (background dark)) - :foreground "#333")) - "Face used for thin line separators in `consult-register-window'.") - -;;;; Input history variables - -(defvar consult--path-history nil) -(defvar consult--grep-history nil) -(defvar consult--find-history nil) -(defvar consult--man-history nil) -(defvar consult--line-history nil) -(defvar consult--line-multi-history nil) -(defvar consult--theme-history nil) -(defvar consult--minor-mode-menu-history nil) -(defvar consult--buffer-history nil) - -;;;; Internal variables - -(defvar consult--regexp-compiler - #'consult--default-regexp-compiler - "Regular expression compiler used by `consult-grep' and other commands. -The function must return a list of regular expressions and a highlighter -function.") - -(defvar consult--customize-alist - ;; Disable preview in frames, since `consult--jump-preview' does not properly - ;; clean up. See gh:minad/consult#593. This issue should better be fixed in - ;; `consult--jump-preview'. - `((,#'consult-buffer-other-frame :preview-key nil) - (,#'consult-buffer-other-tab :preview-key nil)) - "Command configuration alist for fine-grained configuration. - -Each element of the list must have the form (command-name plist...). The -options set here will be evaluated and passed to `consult--read', when -called from the corresponding command. Note that the options depend on -the private `consult--read' API and should not be considered as stable -as the public API.") - -(defvar consult--buffer-display #'switch-to-buffer - "Buffer display function.") - -(defvar consult--completion-candidate-hook - (list #'consult--default-completion-minibuffer-candidate - #'consult--default-completion-list-candidate) - "Get candidate from completion system.") - -(defvar consult--completion-refresh-hook nil - "Refresh completion system.") - -(defvar-local consult--preview-function nil - "Minibuffer-local variable which exposes the current preview function. -This function can be called by custom completion systems from -outside the minibuffer.") - -(defvar consult--annotate-align-step 10 - "Round candidate width.") - -(defvar consult--annotate-align-width 0 - "Maximum candidate width used for annotation alignment.") - -(defconst consult--tofu-char #x200000 - "Special character used to encode line prefixes for disambiguation. -We use invalid characters outside the Unicode range.") - -(defconst consult--tofu-range #x100000 - "Special character range.") - -(defvar-local consult--narrow nil - "Current narrowing key.") - -(defvar-local consult--narrow-keys nil - "Narrowing prefixes of the current completion.") - -(defvar-local consult--narrow-predicate nil - "Narrowing predicate of the current completion.") - -(defvar-local consult--narrow-overlay nil - "Narrowing indicator overlay.") - -(defvar consult--gc-threshold (* 64 1024 1024) - "Large GC threshold for temporary increase.") - -(defvar consult--gc-percentage 0.5 - "Large GC percentage for temporary increase.") - -(defvar consult--process-chunk (* 1024 1024) - "Increase process output chunk size.") - -(defvar consult--async-log - " *consult-async*" - "Buffer for async logging output used by `consult--async-process'.") - -(defvar-local consult--focus-lines-overlays nil - "Overlays used by `consult-focus-lines'.") - -(defvar-local consult--org-fold-regions nil - "Stored regions for the org-fold API.") - -;;;; Miscellaneous helper functions - -(defun consult--key-parse (key) - "Parse KEY or signal error if invalid." - (unless (key-valid-p key) - (error "%S is not a valid key definition; see `key-valid-p'" key)) - (key-parse key)) - -(defun consult--in-buffer (fun &optional buffer) - "Ensure that FUN is executed inside BUFFER." - (unless buffer (setq buffer (current-buffer))) - (lambda (&rest args) - (with-current-buffer buffer - (apply fun args)))) - -(defun consult--completion-table-in-buffer (table &optional buffer) - "Ensure that completion TABLE is executed inside BUFFER." - (if (functionp table) - (consult--in-buffer - (lambda (str pred action) - (let ((result (funcall table str pred action))) - (pcase action - ('metadata - (setq result - (mapcar - (lambda (x) - (if (and (string-suffix-p "-function" (symbol-name (car-safe x))) (cdr x)) - (cons (car x) (consult--in-buffer (cdr x))) - x)) - result))) - ((and 'completion--unquote (guard (functionp (cadr result)))) - (cl-callf consult--in-buffer (cadr result) buffer) - (cl-callf consult--in-buffer (cadddr result) buffer))) - result)) - buffer) - table)) - -(defun consult--build-args (arg) - "Return ARG as a flat list of split strings. - -Turn ARG into a list, and for each element either: -- split it if it a string. -- eval it if it is an expression." - (seq-mapcat (lambda (x) - (if (stringp x) - (split-string-and-unquote x) - (ensure-list (eval x 'lexical)))) - (ensure-list arg))) - -(defun consult--command-split (str) - "Return command argument and options list given input STR." - (save-match-data - (let ((opts (when (string-match " +--\\( +\\|\\'\\)" str) - (prog1 (substring str (match-end 0)) - (setq str (substring str 0 (match-beginning 0))))))) - ;; split-string-and-unquote fails if the quotes are invalid. Ignore it. - (cons str (and opts (ignore-errors (split-string-and-unquote opts))))))) - -(defmacro consult--keep! (list form) - "Evaluate FORM for every element of LIST and keep the non-nil results." - (declare (indent 1)) - (cl-with-gensyms (head prev result) - `(let* ((,head (cons nil ,list)) - (,prev ,head)) - (while (cdr ,prev) - (if-let (,result (let ((it (cadr ,prev))) ,form)) - (progn - (pop ,prev) - (setcar ,prev ,result)) - (setcdr ,prev (cddr ,prev)))) - (setq ,list (cdr ,head)) - nil))) - -(defun consult--completion-filter (pattern cands category _highlight) - "Filter CANDS with PATTERN. - -CATEGORY is the completion category, used to find the completion style via -`completion-category-defaults' and `completion-category-overrides'. -HIGHLIGHT must be non-nil if the resulting strings should be highlighted." - ;; Ensure that the global completion style settings are used for - ;; `consult-line', `consult-focus-lines' and `consult-keep-lines' filtering. - ;; This override is necessary since users may want to override the settings - ;; buffer-locally for in-buffer completion via Corfu. - (let ((completion-styles (default-value 'completion-styles)) - (completion-category-defaults (default-value 'completion-category-defaults)) - (completion-category-overrides (default-value 'completion-category-overrides))) - ;; `completion-all-completions' returns an improper list where the last link - ;; is not necessarily nil. - (nconc (completion-all-completions pattern cands nil (length pattern) - `(metadata (category . ,category))) - nil))) - -(defun consult--completion-filter-complement (pattern cands category _highlight) - "Filter CANDS with complement of PATTERN. -See `consult--completion-filter' for the arguments CATEGORY and HIGHLIGHT." - (let ((ht (consult--string-hash (consult--completion-filter pattern cands category nil)))) - (seq-remove (lambda (x) (gethash x ht)) cands))) - -(defun consult--completion-filter-dispatch (pattern cands category highlight) - "Filter CANDS with PATTERN with optional complement. -Either using `consult--completion-filter' or -`consult--completion-filter-complement', depending on if the pattern starts -with a bang. See `consult--completion-filter' for the arguments CATEGORY and -HIGHLIGHT." - (cond - ((string-match-p "\\`!? ?\\'" pattern) cands) ;; empty pattern - ((string-prefix-p "! " pattern) (consult--completion-filter-complement - (substring pattern 2) cands category nil)) - (t (consult--completion-filter pattern cands category highlight)))) - -(defmacro consult--each-line (beg end &rest body) - "Iterate over each line. - -The line beginning/ending BEG/END is bound in BODY." - (declare (indent 2)) - (cl-with-gensyms (max) - `(save-excursion - (let ((,beg (point-min)) (,max (point-max)) ,end) - (while (< ,beg ,max) - (goto-char ,beg) - (setq ,end (pos-eol)) - ,@body - (setq ,beg (1+ ,end))))))) - -(defun consult--display-width (string) - "Compute width of STRING taking display and invisible properties into account." - (let ((pos 0) (width 0) (end (length string))) - (while (< pos end) - (let ((nextd (next-single-property-change pos 'display string end)) - (display (get-text-property pos 'display string))) - (if (stringp display) - (setq width (+ width (string-width display)) - pos nextd) - (while (< pos nextd) - (let ((nexti (next-single-property-change pos 'invisible string nextd))) - (unless (get-text-property pos 'invisible string) - (setq width (+ width (string-width string pos nexti)))) - (setq pos nexti)))))) - width)) - -(defun consult--string-hash (strings) - "Create hash table from STRINGS." - (let ((ht (make-hash-table :test #'equal :size (length strings)))) - (dolist (str strings) - (puthash str t ht)) - ht)) - -(defmacro consult--local-let (binds &rest body) - "Buffer local let BINDS of dynamic variables in BODY." - (declare (indent 1)) - (let ((buffer (gensym "buffer")) - (local (mapcar (lambda (x) (cons (gensym "local") (car x))) binds))) - `(let ((,buffer (current-buffer)) - ,@(mapcar (lambda (x) `(,(car x) (local-variable-p ',(cdr x)))) local)) - (unwind-protect - (progn - ,@(mapcar (lambda (x) `(make-local-variable ',(car x))) binds) - (let (,@binds) - ,@body)) - (when (buffer-live-p ,buffer) - (with-current-buffer ,buffer - ,@(mapcar (lambda (x) - `(unless ,(car x) - (kill-local-variable ',(cdr x)))) - local))))))) - -(defvar consult--fast-abbreviate-file-name nil) -(defun consult--fast-abbreviate-file-name (name) - "Return abbreviate file NAME. -This function is a pure variant of `abbreviate-file-name', which -does not access the file system. This is important if we require -that the operation is fast, even for remote paths or paths on -network file systems." - (save-match-data - (let (case-fold-search) ;; Assume that file system is case sensitive. - (setq name (directory-abbrev-apply name)) - (if (string-match (with-memoization consult--fast-abbreviate-file-name - (directory-abbrev-make-regexp (expand-file-name "~"))) - name) - (concat "~" (substring name (match-beginning 1))) - name)))) - -(defun consult--left-truncate-file (file) - "Return abbreviated file name of FILE for use in `completing-read' prompt." - (save-match-data - (let ((file (directory-file-name (abbreviate-file-name file))) - (prefix nil)) - (when (string-match "\\`/\\([^/|:]+:\\)" file) - (setq prefix (propertize (match-string 1 file) 'face 'error) - file (substring file (match-end 0)))) - (when (and (string-match "/\\([^/]+\\)/\\([^/]+\\)\\'" file) - (< (- (match-end 0) (match-beginning 0) -3) (length file))) - (setq file (format "…/%s/%s" (match-string 1 file) (match-string 2 file)))) - (concat prefix file)))) - -(defun consult--directory-prompt (prompt dir) - "Return prompt, paths and default directory. - -PROMPT is the prompt prefix. The directory is appended to the -prompt prefix. For projects only the project name is shown. The -`default-directory' is not shown. Other directories are -abbreviated and only the last two path components are shown. - -If DIR is a string, it is returned as default directory. If DIR -is a list of strings, the list is returned as search paths. If -DIR is nil the `consult-project-function' is tried to retrieve -the default directory. If no project is found the -`default-directory' is returned as is. Otherwise the user is -asked for the directories or files to search via -`completing-read-multiple'." - (let* ((paths nil) - (dir - (pcase dir - ((pred stringp) dir) - ((or 'nil '(16)) (or (consult--project-root dir) default-directory)) - (_ - (pcase (if (stringp (car-safe dir)) - dir - ;; Preserve this-command across `completing-read-multiple' call, - ;; such that `consult-customize' continues to work. - (let ((this-command this-command) - (def (abbreviate-file-name default-directory)) - ;; TODO: `minibuffer-completing-file-name' is - ;; mostly deprecated, but still in use. Packages - ;; should instead use the completion metadata. - (minibuffer-completing-file-name t) - (ignore-case read-file-name-completion-ignore-case)) - (minibuffer-with-setup-hook - (lambda () - (setq-local completion-ignore-case ignore-case) - (set-syntax-table minibuffer-local-filename-syntax)) - (completing-read-multiple "Directories or files: " - #'completion-file-name-table - nil t def 'consult--path-history def)))) - ((and `(,p) (guard (file-directory-p p))) p) - (ps (setq paths (mapcar (lambda (p) - (file-relative-name (expand-file-name p))) - ps)) - default-directory))))) - (edir (file-name-as-directory (expand-file-name dir))) - (pdir (let ((default-directory edir)) - ;; Bind default-directory in order to find the project - (consult--project-root)))) - (list - (format "%s (%s): " prompt - (pcase paths - ((guard (<= 1 (length paths) 2)) - (string-join (mapcar #'consult--left-truncate-file paths) ", ")) - (`(,p . ,_) - (format "%d paths, %s, …" (length paths) (consult--left-truncate-file p))) - ((guard (equal edir pdir)) (concat "Project " (consult--project-name pdir))) - (_ (consult--left-truncate-file edir)))) - (or paths '(".")) - edir))) - -(declare-function project-current "project") -(declare-function project-root "project") - -(defun consult--default-project-function (may-prompt) - "Return project root directory. -When no project is found and MAY-PROMPT is non-nil ask the user." - (when-let (proj (project-current may-prompt)) - (project-root proj))) - -(defun consult--project-root (&optional may-prompt) - "Return project root as absolute path. -When no project is found and MAY-PROMPT is non-nil ask the user." - ;; Preserve this-command across project selection, - ;; such that `consult-customize' continues to work. - (let ((this-command this-command)) - (when-let (root (and consult-project-function - (funcall consult-project-function may-prompt))) - (expand-file-name root)))) - -(defun consult--project-name (dir) - "Return the project name for DIR." - (if (string-match "/\\([^/]+\\)/\\'" dir) - (propertize (match-string 1 dir) 'help-echo (abbreviate-file-name dir)) - dir)) - -(defun consult--format-file-line-match (file line match) - "Format string FILE:LINE:MATCH with faces." - (setq line (number-to-string line) - match (concat file ":" line ":" match) - file (length file)) - (put-text-property 0 file 'face 'consult-file match) - (put-text-property (1+ file) (+ 1 file (length line)) 'face 'consult-line-number match) - match) - -(defun consult--make-overlay (beg end &rest props) - "Make consult overlay between BEG and END with PROPS." - (let ((ov (make-overlay beg end))) - (while props - (overlay-put ov (car props) (cadr props)) - (setq props (cddr props))) - ov)) - -(defun consult--remove-dups (list) - "Remove duplicate strings from LIST." - (delete-dups (copy-sequence list))) - -(defsubst consult--in-range-p (pos) - "Return t if position POS lies in range `point-min' to `point-max'." - (<= (point-min) pos (point-max))) - -(defun consult--completion-window-p () - "Return non-nil if the selected window belongs to the completion UI." - (or (eq (selected-window) (active-minibuffer-window)) - (eq #'completion-list-mode (buffer-local-value 'major-mode (window-buffer))))) - -(defun consult--original-window () - "Return window which was just selected just before the minibuffer was entered. -In contrast to `minibuffer-selected-window' never return nil and -always return an appropriate non-minibuffer window." - (or (minibuffer-selected-window) - (if (window-minibuffer-p (selected-window)) - (next-window) - (selected-window)))) - -(defun consult--forbid-minibuffer () - "Raise an error if executed from the minibuffer." - (when (minibufferp) - (user-error "`%s' called inside the minibuffer" this-command))) - -(defun consult--require-minibuffer () - "Raise an error if executed outside the minibuffer." - (unless (minibufferp) - (user-error "`%s' must be called inside the minibuffer" this-command))) - -(defun consult--fontify-all () - "Ensure that the whole buffer is fontified." - ;; Font-locking is lazy, i.e., if a line has not been looked at yet, the line - ;; is not font-locked. We would observe this if consulting an unfontified - ;; line. Therefore we have to enforce font-locking now, which is slow. In - ;; order to prevent is hang-up we check the buffer size against - ;; `consult-fontify-max-size'. - (when (and consult-fontify-preserve jit-lock-mode - (< (buffer-size) consult-fontify-max-size)) - (jit-lock-fontify-now))) - -(defun consult--fontify-region (start end) - "Ensure that region between START and END is fontified." - (when (and consult-fontify-preserve jit-lock-mode) - (jit-lock-fontify-now start end))) - -(defmacro consult--with-increased-gc (&rest body) - "Temporarily increase the GC limit in BODY to optimize for throughput." - (cl-with-gensyms (overwrite) - `(let* ((,overwrite (> consult--gc-threshold gc-cons-threshold)) - (gc-cons-threshold (if ,overwrite consult--gc-threshold gc-cons-threshold)) - (gc-cons-percentage (if ,overwrite consult--gc-percentage gc-cons-percentage))) - ,@body))) - -(defmacro consult--slow-operation (message &rest body) - "Show delayed MESSAGE if BODY takes too long. -Also temporarily increase the GC limit via `consult--with-increased-gc'." - (declare (indent 1)) - `(with-delayed-message (1 ,message) - (consult--with-increased-gc ,@body))) - -(defun consult--count-lines (pos) - "Move to position POS and return number of lines." - (let ((line 1)) - (while (< (point) pos) - (forward-line) - (when (<= (point) pos) - (cl-incf line))) - (goto-char pos) - line)) - -(defun consult--marker-from-line-column (buffer line column) - "Get marker in BUFFER from LINE and COLUMN." - (when (buffer-live-p buffer) - (with-current-buffer buffer - (save-excursion - (without-restriction - (goto-char (point-min)) - ;; Location data might be invalid by now! - (ignore-errors - (forward-line (1- line)) - (goto-char (min (+ (point) column) (pos-eol)))) - (point-marker)))))) - -(defun consult--line-prefix (&optional curr-line) - "Annotate `consult-location' candidates with line numbers. -CURR-LINE is the current line number." - (setq curr-line (or curr-line -1)) - (let* ((width (length (number-to-string (line-number-at-pos - (point-max) - consult-line-numbers-widen)))) - (before (format #("%%%dd " 0 6 (face consult-line-number-wrapped)) width)) - (after (format #("%%%dd " 0 6 (face consult-line-number-prefix)) width))) - (lambda (cand) - (let ((line (cdr (get-text-property 0 'consult-location cand)))) - (list cand (format (if (< line curr-line) before after) line) ""))))) - -(defsubst consult--location-candidate (cand marker line tofu &rest props) - "Add MARKER and LINE as `consult-location' text property to CAND. -Furthermore add the additional text properties PROPS, and append -TOFU suffix for disambiguation." - (setq cand (concat cand (consult--tofu-encode tofu))) - (add-text-properties 0 1 `(consult-location (,marker . ,line) ,@props) cand) - cand) - -;; There is a similar variable `yank-excluded-properties'. Unfortunately -;; we cannot use it here since it excludes too much (e.g., invisible) -;; and at the same time not enough (e.g., cursor-sensor-functions). -(defconst consult--remove-text-properties - '( category cursor cursor-intangible cursor-sensor-functions field follow-link - fontified front-sticky help-echo insert-behind-hooks insert-in-front-hooks - intangible keymap local-map modification-hooks mouse-face pointer read-only - rear-nonsticky yank-handler) - "List of text properties to remove from buffer strings.") - -(defsubst consult--buffer-substring (beg end &optional fontify) - "Return buffer substring between BEG and END. -If FONTIFY and `consult-fontify-preserve' are non-nil, first ensure that the -region has been fontified." - (if consult-fontify-preserve - (let (str) - (when fontify (consult--fontify-region beg end)) - (setq str (buffer-substring beg end)) - ;; TODO Propose the upstream addition of a function - ;; `preserve-list-of-text-properties', which should be as efficient as - ;; `remove-list-of-text-properties'. - (remove-list-of-text-properties - 0 (- end beg) consult--remove-text-properties str) - str) - (buffer-substring-no-properties beg end))) - -(defun consult--line-with-mark (marker) - "Current line string where the MARKER position is highlighted." - (let* ((beg (pos-bol)) - (end (pos-eol)) - (str (consult--buffer-substring beg end 'fontify))) - (if (>= marker end) - (concat str #(" " 0 1 (face consult-highlight-mark))) - (put-text-property (- marker beg) (- (1+ marker) beg) - 'face 'consult-highlight-mark str) - str))) - -;;;; Tofu cooks - -(defsubst consult--tofu-p (char) - "Return non-nil if CHAR is a tofu." - (<= consult--tofu-char char (+ consult--tofu-char consult--tofu-range -1))) - -(defun consult--tofu-hide (str) - "Hide the tofus in STR." - (let* ((max (length str)) - (end max)) - (while (and (> end 0) (consult--tofu-p (aref str (1- end)))) - (cl-decf end)) - (when (< end max) - (setq str (copy-sequence str)) - (put-text-property end max 'invisible t str)) - str)) - -(defsubst consult--tofu-append (cand id) - "Append tofu-encoded ID to CAND. -The ID must fit within a single character. It must be smaller -than `consult--tofu-range'." - (setq id (char-to-string (+ consult--tofu-char id))) - (add-text-properties 0 1 '(invisible t consult-strip t) id) - (concat cand id)) - -(defsubst consult--tofu-get (cand) - "Extract tofu-encoded ID from CAND. -See `consult--tofu-append'." - (- (aref cand (1- (length cand))) consult--tofu-char)) - -;; We must disambiguate the lines by adding a prefix such that two lines with -;; the same text can be distinguished. In order to avoid matching the line -;; number, such that the user can search for numbers with `consult-line', we -;; encode the line number as characters outside the Unicode range. By doing -;; that, no accidental matching can occur. -(defun consult--tofu-encode (n) - "Return tofu-encoded number N as a string. -Large numbers are encoded as multiple tofu characters." - (let (str tofu) - (while (progn - (setq tofu (char-to-string - (+ consult--tofu-char (% n consult--tofu-range))) - str (if str (concat tofu str) tofu)) - (and (>= n consult--tofu-range) - (setq n (/ n consult--tofu-range))))) - (add-text-properties 0 (length str) '(invisible t consult-strip t) str) - str)) - -;;;; Regexp utilities - -(defun consult--find-highlights (str start &rest ignored-faces) - "Find highlighted regions in STR from position START. -Highlighted regions have a non-nil face property. -IGNORED-FACES are ignored when searching for matches." - (let (highlights - (end (length str)) - (beg start)) - (while (< beg end) - (let ((next (next-single-property-change beg 'face str end)) - (val (get-text-property beg 'face str))) - (when (and val - (not (memq val ignored-faces)) - (not (and (consp val) - (seq-some (lambda (x) (memq x ignored-faces)) val)))) - (push (cons (- beg start) (- next start)) highlights)) - (setq beg next))) - (nreverse highlights))) - -(defun consult--point-placement (str start &rest ignored-faces) - "Compute point placement from STR with START offset. -IGNORED-FACES are ignored when searching for matches. -Return cons of point position and a list of match begin/end pairs." - (let* ((matches (apply #'consult--find-highlights str start ignored-faces)) - (pos (pcase-exhaustive consult-point-placement - ('match-beginning (or (caar matches) 0)) - ('match-end (or (cdar (last matches)) 0)) - ('line-beginning 0)))) - (dolist (match matches) - (cl-decf (car match) pos) - (cl-decf (cdr match) pos)) - (cons pos matches))) - -(defun consult--highlight-regexps (regexps ignore-case str) - "Highlight REGEXPS in STR. -If a regular expression contains capturing groups, only these are highlighted. -If no capturing groups are used highlight the whole match. Case is ignored -if IGNORE-CASE is non-nil." - (dolist (re regexps) - (let ((i 0)) - (while (and (let ((case-fold-search ignore-case)) - (string-match re str i)) - ;; Ensure that regexp search made progress (edge case for .*) - (> (match-end 0) i)) - ;; Unfortunately there is no way to avoid the allocation of the match - ;; data, since the number of capturing groups is unknown. - (let ((m (match-data))) - (setq i (cadr m) m (or (cddr m) m)) - (while m - (when (car m) - (add-face-text-property (car m) (cadr m) - 'consult-highlight-match nil str)) - (setq m (cddr m))))))) - str) - -(defconst consult--convert-regexp-table - (append - ;; For simplicity, treat word beginning/end as word boundaries, - ;; since PCRE does not make this distinction. Usually the - ;; context determines if \b is the beginning or the end. - '(("\\<" . "\\b") ("\\>" . "\\b") - ("\\_<" . "\\b") ("\\_>" . "\\b")) - ;; Treat \` and \' as beginning and end of line. This is more - ;; widely supported and makes sense for line-based commands. - '(("\\`" . "^") ("\\'" . "$")) - ;; Historical: Unescaped *, +, ? are supported at the beginning - (mapcan (lambda (x) - (mapcar (lambda (y) - (cons (concat x y) - (concat (string-remove-prefix "\\" x) "\\" y))) - '("*" "+" "?"))) - '("" "\\(" "\\(?:" "\\|" "^")) - ;; Different escaping - (mapcan (lambda (x) `(,x (,(cdr x) . ,(car x)))) - '(("\\|" . "|") - ("\\(" . "(") ("\\)" . ")") - ("\\{" . "{") ("\\}" . "}")))) - "Regexp conversion table.") - -(defun consult--convert-regexp (regexp type) - "Convert Emacs REGEXP to regexp syntax TYPE." - (if (memq type '(emacs basic)) - regexp - ;; Support for Emacs regular expressions is fairly complete for basic - ;; usage. There are a few unsupported Emacs regexp features: - ;; - \= point matching - ;; - Syntax classes \sx \Sx - ;; - Character classes \cx \Cx - ;; - Explicitly numbered groups (?3:group) - (replace-regexp-in-string - (rx (or "\\\\" "\\^" ;; Pass through - (seq (or "\\(?:" "\\|") (any "*+?")) ;; Historical: \|+ or \(?:* etc - (seq "\\(" (any "*+")) ;; Historical: \(* or \(+ - (seq (or bos "^") (any "*+?")) ;; Historical: + or * at the beginning - (seq (opt "\\") (any "(){|}")) ;; Escape parens/braces/pipe - (seq "\\" (any "'<>`")) ;; Special escapes - (seq "\\_" (any "<>")))) ;; Beginning or end of symbol - (lambda (x) (or (cdr (assoc x consult--convert-regexp-table)) x)) - regexp 'fixedcase 'literal))) - -(defun consult--default-regexp-compiler (input type ignore-case) - "Compile the INPUT string to a list of regular expressions. -The function should return a pair, the list of regular expressions and a -highlight function. The highlight function should take a single -argument, the string to highlight given the INPUT. TYPE is the desired -type of regular expression, which can be `basic', `extended', `emacs' or -`pcre'. If IGNORE-CASE is non-nil return a highlight function which -matches case insensitively." - (setq input (consult--split-escaped input)) - (cons (mapcar (lambda (x) (consult--convert-regexp x type)) input) - (when-let (regexps (seq-filter #'consult--valid-regexp-p input)) - (apply-partially #'consult--highlight-regexps regexps ignore-case)))) - -(defun consult--split-escaped (str) - "Split STR at spaces, which can be escaped with backslash." - (mapcar - (lambda (x) (string-replace "\0" " " x)) - (split-string (replace-regexp-in-string - "\\\\\\\\\\|\\\\ " - (lambda (x) (if (equal x "\\ ") "\0" x)) - str 'fixedcase 'literal) - " +" t))) - -(defun consult--join-regexps (regexps type) - "Join REGEXPS of TYPE." - ;; Add look-ahead wrapper only if there is more than one regular expression - (cond - ((and (eq type 'pcre) (cdr regexps)) - (concat "^" (mapconcat (lambda (x) (format "(?=.*%s)" x)) - regexps ""))) - ((eq type 'basic) - (string-join regexps ".*")) - (t - (when (length> regexps 3) - (message "Too many regexps, %S ignored. Use post-filtering!" - (string-join (seq-drop regexps 3) " ")) - (setq regexps (seq-take regexps 3))) - (consult--join-regexps-permutations regexps (and (eq type 'emacs) "\\"))))) - -(defun consult--join-regexps-permutations (regexps esc) - "Join all permutations of REGEXPS. -ESC is the escaping string for choice and groups." - (pcase regexps - ('nil "") - (`(,r) r) - (_ (mapconcat - (lambda (r) - (concat esc "(" r esc ").*" esc "(" - (consult--join-regexps-permutations (remove r regexps) esc) - esc ")")) - regexps (concat esc "|"))))) - -(defun consult--valid-regexp-p (re) - "Return t if regexp RE is valid." - (condition-case nil - (progn (string-match-p re "") t) - (invalid-regexp nil))) - -(defun consult--regexp-filter (regexps) - "Create filter regexp from REGEXPS." - (if (stringp regexps) - regexps - (mapconcat (lambda (x) (concat "\\(?:" x "\\)")) regexps "\\|"))) - -;;;; Lookup functions - -(defun consult--lookup-member (selected candidates &rest _) - "Lookup SELECTED in CANDIDATES list, return original element." - (car (member selected candidates))) - -(defun consult--lookup-cons (selected candidates &rest _) - "Lookup SELECTED in CANDIDATES alist, return cons." - (assoc selected candidates)) - -(defun consult--lookup-cdr (selected candidates &rest _) - "Lookup SELECTED in CANDIDATES alist, return `cdr' of element." - (cdr (assoc selected candidates))) - -(defun consult--lookup-location (selected candidates &rest _) - "Lookup SELECTED in CANDIDATES list of `consult-location' category. -Return the location marker." - (when-let (found (member selected candidates)) - (setq found (car (consult--get-location (car found)))) - ;; Check that marker is alive - (and (or (not (markerp found)) (marker-buffer found)) found))) - -(defun consult--lookup-prop (prop selected candidates &rest _) - "Lookup SELECTED in CANDIDATES list and return PROP value." - (when-let (found (member selected candidates)) - (get-text-property 0 prop (car found)))) - -(defun consult--lookup-candidate (selected candidates &rest _) - "Lookup SELECTED in CANDIDATES list and return property `consult--candidate'." - (consult--lookup-prop 'consult--candidate selected candidates)) - -;;;; Preview support - -(defun consult--preview-allowed-p (fun) - "Return non-nil if FUN is an allowed preview mode hook." - (or (memq fun consult-preview-allowed-hooks) - (when-let (((symbolp fun)) - (name (symbol-name fun)) - ;; Global modes in Emacs 29 are activated via a - ;; `find-file-hook' ending with `-check-buffers'. This has been - ;; changed in Emacs 30. Now a `change-major-mode-hook' is used - ;; instead with the suffix `-check-buffers'. - (suffix (static-if (>= emacs-major-version 30) - "-enable-in-buffer" - "-check-buffers")) - ((string-suffix-p suffix name))) - (memq (intern (string-remove-suffix suffix name)) - consult-preview-allowed-hooks)))) - -(defun consult--filter-find-file-hook (orig &rest hooks) - "Filter `find-file-hook' by `consult-preview-allowed-hooks'. -This function is an advice for `run-hooks'. -ORIG is the original function, HOOKS the arguments." - (if (memq 'find-file-hook hooks) - (cl-letf* (((default-value 'find-file-hook) - (seq-filter #'consult--preview-allowed-p - (default-value 'find-file-hook))) - (find-file-hook (default-value 'find-file-hook))) - (apply orig hooks)) - (apply orig hooks))) - -(defun consult--find-file-temporarily-1 (name) - "Open file NAME, helper function for `consult--find-file-temporarily'." - (when-let (((not (seq-find (lambda (x) (string-match-p x name)) - consult-preview-excluded-files))) - ;; file-attributes may throw permission denied error - (attrs (ignore-errors (file-attributes name))) - (size (file-attribute-size attrs))) - (let* ((partial (>= size consult-preview-partial-size)) - (buffer (if partial - (generate-new-buffer (format "consult-partial-preview-%s" name)) - (find-file-noselect name 'nowarn))) - (success nil)) - (unwind-protect - (with-current-buffer buffer - (if (not partial) - (when (or (eq major-mode 'hexl-mode) - (and (eq major-mode 'fundamental-mode) - (save-excursion (search-forward "\0" nil 'noerror)))) - (error "No preview of binary file `%s'" - (file-name-nondirectory name))) - (with-silent-modifications - (setq buffer-read-only t) - (insert-file-contents name nil 0 consult-preview-partial-chunk) - (goto-char (point-max)) - (insert "\nFile truncated. End of partial preview.\n") - (goto-char (point-min))) - (when (save-excursion (search-forward "\0" nil 'noerror)) - (error "No partial preview of binary file `%s'" - (file-name-nondirectory name))) - ;; Auto detect major mode and hope for the best, given that the - ;; file is only previewed partially. If an error is thrown the - ;; buffer will be killed and preview is aborted. - (set-auto-mode) - (font-lock-mode 1)) - (when (bound-and-true-p so-long-detected-p) - (error "No preview of file `%s' with long lines" - (file-name-nondirectory name))) - ;; Run delayed hooks listed in `consult-preview-allowed-hooks'. - (dolist (hook (reverse (cons 'after-change-major-mode-hook delayed-mode-hooks))) - (run-hook-wrapped hook (lambda (fun) - (when (consult--preview-allowed-p fun) - (funcall fun)) - nil))) - (setq success (current-buffer))) - (unless success - (kill-buffer buffer)))))) - -(defun consult--find-file-temporarily (name) - "Open file NAME temporarily for preview." - (let ((vars (delq nil - (mapcar - (pcase-lambda (`(,k . ,v)) - (if (boundp k) - (list k v (default-value k) (symbol-value k)) - (message "consult-preview-variables: The variable `%s' is not bound" k) - nil)) - consult-preview-variables)))) - (condition-case err - (unwind-protect - (progn - (advice-add #'run-hooks :around #'consult--filter-find-file-hook) - (pcase-dolist (`(,k ,v . ,_) vars) - (set-default k v) - (set k v)) - (consult--find-file-temporarily-1 name)) - (advice-remove #'run-hooks #'consult--filter-find-file-hook) - (pcase-dolist (`(,k ,_ ,d ,v) vars) - (set-default k d) - (set k v))) - (error - (message "%s" (error-message-string err)) - nil)))) - -(defun consult--temporary-files () - "Return a function to open files temporarily for preview." - (let ((dir default-directory) - (hook (make-symbol "consult--temporary-files-upgrade-hook")) - (orig-buffers (buffer-list)) - temporary-buffers) - (fset hook - (lambda (_) - ;; Fully initialize previewed files and keep them alive. - (unless (consult--completion-window-p) - (let (live-files) - (pcase-dolist (`(,file . ,buf) temporary-buffers) - (when-let (wins (and (buffer-live-p buf) - (get-buffer-window-list buf))) - (push (cons file (mapcar - (lambda (win) - (cons win (window-state-get win t))) - wins)) - live-files))) - (pcase-dolist (`(,_ . ,buf) temporary-buffers) - (kill-buffer buf)) - (setq temporary-buffers nil) - (pcase-dolist (`(,file . ,wins) live-files) - (when-let (buf (consult--file-action file)) - (push buf orig-buffers) - (pcase-dolist (`(,win . ,state) wins) - (setf (car (alist-get 'buffer state)) buf) - (window-state-put state win)))))))) - (lambda (&optional name) - (if name - (let ((default-directory dir)) - (setq name (abbreviate-file-name (expand-file-name name))) - (or - ;; Find existing fully initialized buffer (non-previewed). We have - ;; to check for fully initialized buffer before accessing the - ;; previewed buffers, since `embark-act' can open a buffer which is - ;; currently previewed, such that we end up with two buffers for - ;; the same file - one previewed and only partially initialized and - ;; one fully initialized. In this case we prefer the fully - ;; initialized buffer. For directories `get-file-buffer' returns nil, - ;; therefore we have to special case Dired. - (if (and (fboundp 'dired-find-buffer-nocreate) (file-directory-p name)) - (dired-find-buffer-nocreate name) - (get-file-buffer name)) - ;; Find existing previewed buffer. Previewed buffers are not fully - ;; initialized (hooks are delayed) in order to ensure fast preview. - (cdr (assoc name temporary-buffers)) - ;; Finally, if no existing buffer has been found, open the file for - ;; preview. - (when-let (buf (consult--find-file-temporarily name)) - ;; Only add new buffer if not already in the list - (unless (or (rassq buf temporary-buffers) (memq buf orig-buffers)) - (add-hook 'window-selection-change-functions hook) - (push (cons name buf) temporary-buffers) - ;; Disassociate buffer from file by setting `buffer-file-name' - ;; and `dired-directory' to nil and rename the buffer. This - ;; lets us open an already previewed buffer with the Embark - ;; default action C-. RET. - (with-current-buffer buf - (rename-buffer - (format " Preview:%s" - (file-name-nondirectory (directory-file-name name))) - 'unique)) - ;; The buffer disassociation is delayed to avoid breaking modes - ;; like `pdf-view-mode' or `doc-view-mode' which rely on - ;; `buffer-file-name'. Executing (set-visited-file-name nil) - ;; early also prevents the major mode initialization. - (let ((hook (make-symbol "consult--temporary-files-disassociate-hook"))) - (fset hook (lambda () - (when (buffer-live-p buf) - (with-current-buffer buf - (remove-hook 'pre-command-hook hook) - (setq-local buffer-read-only t - dired-directory nil - buffer-file-name nil))))) - (add-hook 'pre-command-hook hook)) - ;; Only keep a few buffers alive - (while (length> temporary-buffers consult-preview-max-count) - (kill-buffer (cdar (last temporary-buffers))) - (setq temporary-buffers (nbutlast temporary-buffers)))) - buf))) - (remove-hook 'window-selection-change-functions hook) - (pcase-dolist (`(,_ . ,buf) temporary-buffers) - (kill-buffer buf)) - (setq temporary-buffers nil))))) - -(defun consult--invisible-open-permanently () - "Open overlays which hide the current line. -See `isearch-open-necessary-overlays' and `isearch-open-overlay-temporary'." - (if (and (derived-mode-p 'org-mode) (fboundp 'org-fold-show-set-visibility)) - ;; New Org 9.6 fold-core API - (let ((inhibit-redisplay t)) ;; HACK: Prevent flicker due to premature redisplay - (org-fold-show-set-visibility 'canonical)) - (dolist (ov (overlays-in (pos-bol) (pos-eol))) - (when-let (fun (overlay-get ov 'isearch-open-invisible)) - (when (invisible-p (overlay-get ov 'invisible)) - (funcall fun ov)))))) - -(defun consult--invisible-open-temporarily () - "Temporarily open overlays which hide the current line. -See `isearch-open-necessary-overlays' and `isearch-open-overlay-temporary'." - (if (and (derived-mode-p 'org-mode) - (fboundp 'org-fold-show-set-visibility) - (fboundp 'org-fold-core-get-regions) - (fboundp 'org-fold-core-region)) - ;; New Org 9.6 fold-core API - ;; TODO The provided Org API `org-fold-show-set-visibility' cannot be used - ;; efficiently. We obtain all regions in the whole buffer in order to - ;; restore them. A better show API would return all the applied - ;; modifications such that we can restore the ones which got modified. - (progn - (unless consult--org-fold-regions - (setq consult--org-fold-regions - (delq nil (org-fold-core-get-regions - :with-markers t :from (point-min) :to (point-max)))) - (when consult--org-fold-regions - (let ((hook (make-symbol "consult--invisible-open-temporarily-cleanup-hook")) - (buffer (current-buffer)) - (depth (recursion-depth))) - (fset hook - (lambda () - (when (= (recursion-depth) depth) - (remove-hook 'minibuffer-exit-hook hook) - (run-at-time - 0 nil - (lambda () - (when (buffer-live-p buffer) - (with-current-buffer buffer - (pcase-dolist (`(,beg ,end ,_) consult--org-fold-regions) - (when (markerp beg) (set-marker beg nil)) - (when (markerp end) (set-marker end nil))) - (kill-local-variable 'consult--org-fold-regions)))))))) - (add-hook 'minibuffer-exit-hook hook)))) - (let ((inhibit-redisplay t)) ;; HACK: Prevent flicker due to premature redisplay - (org-fold-show-set-visibility 'canonical)) - (list (lambda () - (pcase-dolist (`(,beg ,end ,spec) consult--org-fold-regions) - (org-fold-core-region beg end t spec))))) - (let (restore) - (dolist (ov (overlays-in (pos-bol) (pos-eol))) - (let ((inv (overlay-get ov 'invisible))) - (when (and (invisible-p inv) (overlay-get ov 'isearch-open-invisible)) - (push (if-let (fun (overlay-get ov 'isearch-open-invisible-temporary)) - (progn - (funcall fun ov nil) - (lambda () (funcall fun ov t))) - (overlay-put ov 'invisible nil) - (lambda () (overlay-put ov 'invisible inv))) - restore)))) - restore))) - -(defun consult--jump-ensure-buffer (pos) - "Ensure that buffer of marker POS is displayed, return t if successful." - (or (not (markerp pos)) - ;; Switch to buffer if it is not visible - (when-let ((buf (marker-buffer pos))) - (or (and (eq (current-buffer) buf) (eq (window-buffer) buf)) - (consult--buffer-action buf 'norecord) - t)))) - -(defun consult--jump (pos) - "Jump to POS. -First push current position to mark ring, then move to new -position and run `consult-after-jump-hook'." - (when pos - ;; Extract marker from list with with overlay positions, see `consult--line-match' - (when (consp pos) (setq pos (car pos))) - ;; When the marker is in the same buffer, record previous location - ;; such that the user can jump back quickly. - (when (or (not (markerp pos)) (eq (current-buffer) (marker-buffer pos))) - ;; push-mark mutates markers in the mark-ring and the mark-marker. - ;; Therefore we transform the marker to a number to be safe. - ;; We all love side effects! - (setq pos (+ pos 0)) - (push-mark (point) t)) - (when (consult--jump-ensure-buffer pos) - (unless (= (goto-char pos) (point)) ;; Widen if jump failed - (widen) - (goto-char pos)) - (consult--invisible-open-permanently) - (run-hooks 'consult-after-jump-hook))) - nil) - -(defun consult--jump-preview () - "The preview function used if selecting from a list of candidate positions. -The function can be used as the `:state' argument of `consult--read'." - (let (restore) - (lambda (action cand) - (when (eq action 'preview) - (mapc #'funcall restore) - (setq restore nil) - ;; TODO Better buffer preview support - ;; 1. Use consult--buffer-preview instead of consult--jump-ensure-buffer - ;; 2. Remove function consult--jump-ensure-buffer - ;; 3. Remove consult-buffer-other-* from consult-customize-alist - (when-let ((pos (or (car-safe cand) cand)) ;; Candidate can be previewed - ((consult--jump-ensure-buffer pos))) - (let ((saved-min (point-min-marker)) - (saved-max (point-max-marker)) - (saved-pos (point-marker))) - (set-marker-insertion-type saved-max t) ;; Grow when text is inserted - (push (lambda () - (when-let ((buf (marker-buffer saved-pos))) - (with-current-buffer buf - (narrow-to-region saved-min saved-max) - (goto-char saved-pos) - (set-marker saved-pos nil) - (set-marker saved-min nil) - (set-marker saved-max nil)))) - restore)) - (unless (= (goto-char pos) (point)) ;; Widen if jump failed - (widen) - (goto-char pos)) - (setq restore (nconc (consult--invisible-open-temporarily) restore)) - ;; Ensure that cursor is properly previewed (gh:minad/consult#764) - (unless (eq cursor-in-non-selected-windows 'box) - (let ((orig cursor-in-non-selected-windows) - (buf (current-buffer))) - (push - (if (local-variable-p 'cursor-in-non-selected-windows) - (lambda () - (when (buffer-live-p buf) - (with-current-buffer buf - (setq-local cursor-in-non-selected-windows orig)))) - (lambda () - (when (buffer-live-p buf) - (with-current-buffer buf - (kill-local-variable 'cursor-in-non-selected-windows))))) - restore) - (setq-local cursor-in-non-selected-windows 'box))) - ;; Match previews - (let ((overlays - (list (save-excursion - (let ((vbeg (progn (beginning-of-visual-line) (point))) - (vend (progn (end-of-visual-line) (point))) - (end (pos-eol))) - (consult--make-overlay vbeg (if (= vend end) (1+ end) vend) - 'face 'consult-preview-line - 'window (selected-window) - 'priority 1)))))) - (dolist (match (cdr-safe cand)) - (push (consult--make-overlay (+ (point) (car match)) - (+ (point) (cdr match)) - 'face 'consult-preview-match - 'window (selected-window) - 'priority 2) - overlays)) - (push (lambda () (mapc #'delete-overlay overlays)) restore)) - (run-hooks 'consult-after-jump-hook)))))) - -(defun consult--jump-state () - "The state function used if selecting from a list of candidate positions." - (consult--state-with-return (consult--jump-preview) #'consult--jump)) - -(defun consult--get-location (cand) - "Return location from CAND." - (let ((loc (get-text-property 0 'consult-location cand))) - (when (consp (car loc)) - ;; Transform cheap marker to real marker - (setcar loc (set-marker (make-marker) (cdar loc) (caar loc)))) - loc)) - -(defun consult--location-state (candidates) - "Location state function. -The cheap location markers from CANDIDATES are upgraded on window -selection change to full Emacs markers." - (let ((jump (consult--jump-state)) - (hook (make-symbol "consult--location-upgrade-hook"))) - (fset hook - (lambda (_) - (unless (consult--completion-window-p) - (remove-hook 'window-selection-change-functions hook) - (mapc #'consult--get-location - (if (functionp candidates) (funcall candidates) candidates))))) - (lambda (action cand) - (pcase action - ('setup (add-hook 'window-selection-change-functions hook)) - ('exit (remove-hook 'window-selection-change-functions hook))) - (funcall jump action cand)))) - -(defun consult--state-with-return (state return) - "Compose STATE function with RETURN function." - (lambda (action cand) - (funcall state action cand) - (when (and cand (eq action 'return)) - (funcall return cand)))) - -(defmacro consult--define-state (type) - "Define state function for TYPE." - `(defun ,(intern (format "consult--%s-state" type)) () - ,(format "State function for %ss with preview. -The result can be passed as :state argument to `consult--read'." type) - (consult--state-with-return (,(intern (format "consult--%s-preview" type))) - #',(intern (format "consult--%s-action" type))))) - -(defun consult--preview-key-normalize (preview-key) - "Normalize PREVIEW-KEY, return alist of keys and debounce times." - (let ((keys) - (debounce 0)) - (setq preview-key (ensure-list preview-key)) - (while preview-key - (if (eq (car preview-key) :debounce) - (setq debounce (cadr preview-key) - preview-key (cddr preview-key)) - (let ((key (car preview-key))) - (unless (eq key 'any) - (setq key (consult--key-parse key))) - (push (cons key debounce) keys)) - (pop preview-key))) - keys)) - -(defun consult--preview-key-debounce (preview-key cand) - "Return debounce value of PREVIEW-KEY given the current candidate CAND." - (when (and (consp preview-key) (memq :keys preview-key)) - (setq preview-key (funcall (plist-get preview-key :predicate) cand))) - (let ((map (make-sparse-keymap)) - (keys (this-single-command-keys)) - any) - (pcase-dolist (`(,k . ,d) (consult--preview-key-normalize preview-key)) - (if (eq k 'any) - (setq any d) - (define-key map k `(lambda () ,d)))) - (setq keys (lookup-key map keys)) - (if (functionp keys) (funcall keys) any))) - -(defun consult--preview-append-local-pch (fun) - "Append FUN to local `post-command-hook' list." - ;; Symbol indirection because of bug#46407. - (let ((hook (make-symbol "consult--preview-post-command-hook"))) - (fset hook fun) - ;; TODO Emacs 28 has a bug, where the hook--depth-alist is not cleaned up properly - ;; Do not use the broken add-hook here. - ;;(add-hook 'post-command-hook hook 'append 'local) - (setq-local post-command-hook - (append - (remove t post-command-hook) - (list hook) - (and (memq t post-command-hook) '(t)))))) - -(defun consult--with-preview-1 (preview-key state transform candidate save-input fun) - "Add preview support for FUN. -See `consult--with-preview' for the arguments -PREVIEW-KEY, STATE, TRANSFORM, CANDIDATE and SAVE-INPUT." - (let ((mb-input "") mb-narrow selected timer previewed) - (minibuffer-with-setup-hook - (if (and state preview-key) - (lambda () - (let ((hook (make-symbol "consult--preview-minibuffer-exit-hook")) - (depth (recursion-depth))) - (fset hook - (lambda () - (when (= (recursion-depth) depth) - (remove-hook 'minibuffer-exit-hook hook) - (when timer - (cancel-timer timer) - (setq timer nil)) - (with-selected-window (consult--original-window) - ;; STEP 3: Reset preview - (when previewed - (funcall state 'preview nil)) - ;; STEP 4: Notify the preview function of the minibuffer exit - (funcall state 'exit nil))))) - (add-hook 'minibuffer-exit-hook hook)) - ;; STEP 1: Setup the preview function - (with-selected-window (consult--original-window) - (funcall state 'setup nil)) - (setq consult--preview-function - (lambda () - (when-let ((cand (funcall candidate))) - ;; Drop properties to prevent bugs regarding candidate - ;; lookup, which must handle candidates without - ;; properties. Otherwise the arguments passed to the - ;; lookup function are confusing, since during preview - ;; the candidate has properties but for the final lookup - ;; after completion it does not. - (setq cand (substring-no-properties cand)) - (with-selected-window (active-minibuffer-window) - (let ((input (minibuffer-contents-no-properties)) - (narrow consult--narrow) - (win (consult--original-window))) - (with-selected-window win - (when-let ((transformed (funcall transform narrow input cand)) - (debounce (consult--preview-key-debounce preview-key transformed))) - (when timer - (cancel-timer timer) - (setq timer nil)) - ;; The transformed candidate may have text - ;; properties, which change the preview display. - ;; This matters for example for `consult-grep', - ;; where the current candidate and input may - ;; stay equal, but the highlighting of the - ;; candidate changes while the candidates list - ;; is lagging a bit behind and updates - ;; asynchronously. - ;; - ;; In older Consult versions we instead compared - ;; the input without properties, since I worried - ;; that comparing the transformed candidates - ;; could be potentially expensive. However - ;; comparing the transformed candidates is more - ;; correct. The transformed candidate is the - ;; thing which is actually previewed. - (unless (equal-including-properties previewed transformed) - (if (> debounce 0) - (setq timer - (run-at-time - debounce nil - (lambda () - ;; Preview only when a completion - ;; window is selected and when - ;; the preview window is alive. - (when (and (consult--completion-window-p) - (window-live-p win)) - (with-selected-window win - ;; STEP 2: Preview candidate - (funcall state 'preview (setq previewed transformed))))))) - ;; STEP 2: Preview candidate - (funcall state 'preview (setq previewed transformed))))))))))) - (consult--preview-append-local-pch - (lambda () - (setq mb-input (minibuffer-contents-no-properties) - mb-narrow consult--narrow) - (funcall consult--preview-function)))) - (lambda () - (consult--preview-append-local-pch - (lambda () - (setq mb-input (minibuffer-contents-no-properties) - mb-narrow consult--narrow))))) - (unwind-protect - (setq selected (when-let (result (funcall fun)) - (when-let ((save-input) - (list (symbol-value save-input)) - ((equal (car list) result))) - (set save-input (cdr list))) - (funcall transform mb-narrow mb-input result))) - (when save-input - (add-to-history save-input mb-input)) - (when state - ;; STEP 5: The preview function should perform its final action - (funcall state 'return selected)))))) - -(defmacro consult--with-preview (preview-key state transform candidate save-input &rest body) - "Add preview support to BODY. - -STATE is the state function. -TRANSFORM is the transformation function. -CANDIDATE is the function returning the current candidate. -PREVIEW-KEY are the keys which triggers the preview. -SAVE-INPUT can be a history variable symbol to save the input. - -The state function takes two arguments, an action argument and the -selected candidate. The candidate argument can be nil if no candidate is -selected or if the selection was aborted. The function is called in -sequence with the following arguments: - - 1. \\='setup nil After entering the mb (minibuffer-setup-hook). -⎧ 2. \\='preview CAND/nil Preview candidate CAND or reset if CAND is nil. -⎪ \\='preview CAND/nil -⎪ \\='preview CAND/nil -⎪ ... -⎩ 3. \\='preview nil Reset preview. - 4. \\='exit nil Before exiting the mb (minibuffer-exit-hook). - 5. \\='return CAND/nil After leaving the mb, CAND has been selected. - -The state function is always executed with the original window selected, -see `consult--original-window'. The state function is called once in -the beginning of the minibuffer setup with the `setup' argument. This is -useful in order to perform certain setup operations which require that -the minibuffer is initialized. During completion candidates are -previewed. Then the function is called with the `preview' argument and a -candidate CAND or nil if no candidate is selected. Furthermore if nil is -passed for CAND, then the preview must be undone and the original state -must be restored. The call with the `exit' argument happens once at the -end of the completion process, just before exiting the minibuffer. The -minibuffer is still alive at that point. Both `setup' and `exit' are -only useful for setup and cleanup operations. They don't receive a -candidate as argument. After leaving the minibuffer, the selected -candidate or nil is passed to the state function with the action -argument `return'. At this point the state function can perform the -actual action on the candidate. The state function with the `return' -argument is the continuation of `consult--read'. Via `unwind-protect' it -is guaranteed, that if the `setup' action of a state function is -invoked, the state function will also be called with `exit' and -`return'." - (declare (indent 5)) - `(consult--with-preview-1 ,preview-key ,state ,transform ,candidate ,save-input (lambda () ,@body))) - -;;;; Narrowing and grouping - -(defun consult--prefix-group (cand transform) - "Return title for CAND or TRANSFORM the candidate. -The candidate must have a `consult--prefix-group' property." - (if transform - (substring cand (1+ (length (get-text-property 0 'consult--prefix-group cand)))) - (get-text-property 0 'consult--prefix-group cand))) - -(defun consult--type-group (types) - "Return group function for TYPES." - (lambda (cand transform) - (if transform cand - (alist-get (get-text-property 0 'consult--type cand) types)))) - -(defun consult--type-narrow (types) - "Return narrowing configuration from TYPES." - (list :predicate - (lambda (cand) (eq (get-text-property 0 'consult--type cand) consult--narrow)) - :keys types)) - -(defun consult--widen-key () - "Return widening key, if `consult-widen-key' is not set. -The default is twice the `consult-narrow-key'." - (cond - (consult-widen-key - (consult--key-parse consult-widen-key)) - (consult-narrow-key - (let ((key (consult--key-parse consult-narrow-key))) - (vconcat key key))))) - -(defun consult-narrow (key) - "Narrow current completion with KEY. - -This command is used internally by the narrowing system of `consult--read'." - (declare (completion ignore)) - (interactive - (list (unless (equal (this-single-command-keys) (consult--widen-key)) - last-command-event))) - (consult--require-minibuffer) - (setq consult--narrow key) - (when consult--narrow-predicate - (setq minibuffer-completion-predicate (and consult--narrow consult--narrow-predicate))) - (when consult--narrow-overlay - (delete-overlay consult--narrow-overlay)) - (when consult--narrow - (setq consult--narrow-overlay - (consult--make-overlay - (1- (minibuffer-prompt-end)) (minibuffer-prompt-end) - 'before-string - (propertize (format " [%s]" (alist-get consult--narrow - consult--narrow-keys)) - 'face 'consult-narrow-indicator)))) - (run-hooks 'consult--completion-refresh-hook)) - -(defconst consult--narrow-delete - `(menu-item - "" nil :filter - ,(lambda (&optional _) - (when (equal (minibuffer-contents-no-properties) "") - (lambda () - (interactive) - (consult-narrow nil)))))) - -(defconst consult--narrow-space - `(menu-item - "" nil :filter - ,(lambda (&optional _) - (let ((str (minibuffer-contents-no-properties))) - (when-let (pair (or (and (length= str 1) - (assoc (aref str 0) consult--narrow-keys)) - (and (equal str "") - (assoc ?\s consult--narrow-keys)))) - (lambda () - (interactive) - (delete-minibuffer-contents) - (consult-narrow (car pair)))))))) - -(defun consult-narrow-help () - "Print narrowing help as a `minibuffer-message'. - -This command can be bound to a key in `consult-narrow-map', -to make it available for commands with narrowing." - (declare (completion ignore)) - (interactive) - (consult--require-minibuffer) - (let ((minibuffer-message-timeout 1000000)) - (minibuffer-message - (mapconcat (lambda (x) - (concat - (propertize (key-description (list (car x))) 'face 'consult-key) - " " - (propertize (cdr x) 'face 'consult-help))) - consult--narrow-keys - " ")))) - -(defun consult--narrow-setup (settings map) - "Setup narrowing with SETTINGS and keymap MAP." - (if (memq :keys settings) - (setq consult--narrow-predicate (plist-get settings :predicate) - consult--narrow-keys (plist-get settings :keys)) - (setq consult--narrow-predicate nil - consult--narrow-keys settings)) - (when-let ((key consult-narrow-key)) - (setq key (consult--key-parse key)) - (dolist (pair consult--narrow-keys) - (define-key map (vconcat key (vector (car pair))) - (cons (cdr pair) #'consult-narrow)))) - (when-let ((widen (consult--widen-key))) - (define-key map widen (cons "All" #'consult-narrow))) - (when-let ((init (and (memq :keys settings) (plist-get settings :initial)))) - (consult-narrow init))) - -;;;; Splitting completion style - -(defun consult--split-perl (str &optional _plist) - "Split input STR in async input and filtering part. - -The function returns a list with three elements: The async -string, the start position of the completion filter string and a -force flag. If the first character is a punctuation character it -determines the separator. Examples: \"/async/filter\", -\"#async#filter\"." - (if (string-match-p "^[[:punct:]]" str) - (save-match-data - (let ((q (regexp-quote (substring str 0 1)))) - (string-match (concat "^" q "\\([^" q "]*\\)\\(" q "\\)?") str) - `(,(match-string 1 str) - ,(match-end 0) - ;; Force update it two punctuation characters are entered. - ,(match-end 2) - ;; List of highlights - (0 . ,(match-beginning 1)) - ,@(and (match-end 2) `((,(match-beginning 2) . ,(match-end 2))))))) - `(,str ,(length str)))) - -(defun consult--split-nil (str &optional _plist) - "Treat the complete input STR as async input." - `(,str ,(length str))) - -(defun consult--split-separator (str plist) - "Split input STR in async input and filtering part at first separator. -PLIST is the splitter configuration, including the separator." - (let ((sep (regexp-quote (char-to-string (plist-get plist :separator))))) - (save-match-data - (if (string-match (format "^\\([^%s]+\\)\\(%s\\)?" sep sep) str) - `(,(match-string 1 str) - ,(match-end 0) - ;; Force update it space is entered. - ,(match-end 2) - ;; List of highlights - ,@(and (match-end 2) `((,(match-beginning 2) . ,(match-end 2))))) - `(,str ,(length str)))))) - -(defun consult--split-setup (split) - "Setup splitting completion style with splitter function SPLIT." - (let* ((styles completion-styles) - (catdef completion-category-defaults) - (catovr completion-category-overrides) - (try (lambda (str table pred point) - (let ((completion-styles styles) - (completion-category-defaults catdef) - (completion-category-overrides catovr) - (pos (cadr (funcall split str)))) - (pcase (completion-try-completion (substring str pos) table pred - (max 0 (- point pos))) - ('t t) - (`(,newstr . ,newpt) - (cons (concat (substring str 0 pos) newstr) - (+ pos newpt))))))) - (all (lambda (str table pred point) - (let ((completion-styles styles) - (completion-category-defaults catdef) - (completion-category-overrides catovr) - (pos (cadr (funcall split str)))) - (completion-all-completions (substring str pos) table pred - (max 0 (- point pos))))))) - (setq-local completion-styles-alist (cons `(consult--split ,try ,all "") - completion-styles-alist) - completion-styles '(consult--split) - completion-category-defaults nil - completion-category-overrides nil))) - -;;;; Asynchronous filtering functions - -(defun consult--async-p (fun) - "Return t if FUN is an asynchronous completion function." - (and (functionp fun) - (condition-case nil - (progn (funcall fun "" nil 'metadata) nil) - (wrong-number-of-arguments t)))) - -(defmacro consult--with-async (bind &rest body) - "Setup asynchronous completion in BODY. - -BIND is the asynchronous function binding." - (declare (indent 1)) - (let ((async (car bind))) - `(let ((,async ,@(cdr bind)) - (new-chunk (max read-process-output-max consult--process-chunk)) - orig-chunk) - (minibuffer-with-setup-hook - ;; Append such that we overwrite the completion style setting of - ;; `fido-mode'. See `consult--async-split' and - ;; `consult--split-setup'. - (:append - (lambda () - (when (consult--async-p ,async) - (setq orig-chunk read-process-output-max - read-process-output-max new-chunk) - (funcall ,async 'setup) - (let* ((mb (current-buffer)) - (fun (lambda () - (when-let (win (active-minibuffer-window)) - (when (eq (window-buffer win) mb) - (with-current-buffer mb - (let ((inhibit-modification-hooks t)) - ;; Push input string to request refresh. - (funcall ,async (minibuffer-contents-no-properties)))))))) - ;; We use a symbol in order to avoid adding lambdas to - ;; the hook variable. Symbol indirection because of - ;; bug#46407. - (hook (make-symbol "consult--async-after-change-hook"))) - ;; Delay modification hook to ensure that minibuffer is still - ;; alive after the change, such that we don't restart a new - ;; asynchronous search right before exiting the minibuffer. - (fset hook (lambda (&rest _) (run-at-time 0 nil fun))) - (add-hook 'after-change-functions hook nil 'local) - (funcall hook))))) - (let ((,async (if (consult--async-p ,async) ,async (lambda (_) ,async)))) - (unwind-protect - ,(macroexp-progn body) - (funcall ,async 'destroy) - (when (and orig-chunk (eq read-process-output-max new-chunk)) - (setq read-process-output-max orig-chunk)))))))) - -(defun consult--async-sink () - "Create ASYNC sink function. - -An async function must accept a single action argument. For the -\\='setup action it is guaranteed that the call originates from -the minibuffer. For the other actions no assumption about the -context can be made. - -\\='setup Setup the internal closure state. Return nil. -\\='destroy Destroy the internal closure state. Return nil. -\\='flush Flush the list of candidates. Return nil. -\\='refresh Request UI refresh. Return nil. -nil Return the list of candidates. -list Append the list to the already existing candidates list and return it. -string Update with the current user input string. Return nil." - (let (candidates last buffer) - (lambda (action) - (pcase-exhaustive action - ('setup - (setq buffer (current-buffer)) - nil) - ((or (pred stringp) 'destroy) nil) - ('flush (setq candidates nil last nil)) - ('refresh - ;; Refresh the UI when the current minibuffer window belongs - ;; to the current asynchronous completion session. - (when-let (win (active-minibuffer-window)) - (when (eq (window-buffer win) buffer) - (with-selected-window win - (run-hooks 'consult--completion-refresh-hook) - ;; Interaction between asynchronous completion functions and - ;; preview: We have to trigger preview immediately when - ;; candidates arrive (gh:minad/consult#436). - (when (and consult--preview-function candidates) - (funcall consult--preview-function))))) - nil) - ('nil candidates) - ((pred consp) - (setq last (last (if last (setcdr last action) (setq candidates action)))) - candidates))))) - -(defun consult--async-split-style () - "Return the async splitting style function and initial string." - (or (alist-get consult-async-split-style consult-async-split-styles-alist) - (user-error "Splitting style `%s' not found" consult-async-split-style))) - -(defun consult--async-split-initial (initial) - "Return initial string for async command. -INITIAL is the additional initial string." - (concat (plist-get (consult--async-split-style) :initial) initial)) - -(defun consult--async-split-thingatpt (thing) - "Return THING at point with async initial prefix." - (when-let (str (thing-at-point thing)) - (consult--async-split-initial str))) - -(defun consult--async-split (async &optional split) - "Create async function, which splits the input string. -ASYNC is the async sink. -SPLIT is the splitting function." - (unless split - (let* ((style (consult--async-split-style)) - (fn (plist-get style :function))) - (setq split (lambda (str) (funcall fn str style))))) - (lambda (action) - (pcase action - ('setup - (consult--split-setup split) - (funcall async 'setup)) - ((pred stringp) - (pcase-let* ((`(,async-str ,_ ,force . ,highlights) - (funcall split action)) - (async-len (length async-str)) - (input-len (length action)) - (end (minibuffer-prompt-end))) - ;; Highlight punctuation characters - (remove-list-of-text-properties end (+ end input-len) '(face)) - (dolist (hl highlights) - (put-text-property (+ end (car hl)) (+ end (cdr hl)) - 'face 'consult-async-split)) - (funcall async - ;; Pass through if the input is long enough! - (if (or force (>= async-len consult-async-min-input)) - async-str - ;; Pretend that there is no input - "")))) - (_ (funcall async action))))) - -(defun consult--async-indicator (async) - "Create async function with a state indicator overlay. -ASYNC is the async sink." - (let (ov) - (lambda (action &optional state) - (pcase action - ('indicator - (overlay-put ov 'display - (pcase-exhaustive state - ('running #("*" 0 1 (face consult-async-running))) - ('finished #(":" 0 1 (face consult-async-finished))) - ('killed #(";" 0 1 (face consult-async-failed))) - ('failed #("!" 0 1 (face consult-async-failed)))))) - ('setup - (setq ov (make-overlay (- (minibuffer-prompt-end) 2) - (- (minibuffer-prompt-end) 1))) - (funcall async 'setup)) - ('destroy - (delete-overlay ov) - (funcall async 'destroy)) - (_ (funcall async action)))))) - -(defun consult--async-log (formatted &rest args) - "Log FORMATTED ARGS to variable `consult--async-log'." - (with-current-buffer (get-buffer-create consult--async-log) - (goto-char (point-max)) - (insert (apply #'format formatted args)))) - -(defun consult--async-process (async builder &rest props) - "Create process source async function. - -ASYNC is the async function which receives the candidates. -BUILDER is the command line builder function. -PROPS are optional properties passed to `make-process'." - (setq async (consult--async-indicator async)) - (let (proc proc-buf last-args count) - (lambda (action) - (pcase action - ("" ;; If no input is provided kill current process - (when proc - (delete-process proc) - (kill-buffer proc-buf) - (setq proc nil proc-buf nil)) - (setq last-args nil)) - ((pred stringp) - (funcall async action) - (let* ((args (funcall builder action))) - (unless (stringp (car args)) - (setq args (car args))) - (unless (equal args last-args) - (setq last-args args) - (when proc - (delete-process proc) - (kill-buffer proc-buf) - (setq proc nil proc-buf nil)) - (when args - (let* ((flush t) - (rest "") - (proc-filter - (lambda (_ out) - (when flush - (setq flush nil) - (funcall async 'flush)) - (let ((lines (split-string out "[\r\n]+"))) - (if (not (cdr lines)) - (setq rest (concat rest (car lines))) - (setcar lines (concat rest (car lines))) - (let* ((len (length lines)) - (last (nthcdr (- len 2) lines))) - (setq rest (cadr last) - count (+ count len -1)) - (setcdr last nil) - (funcall async lines)))))) - (proc-sentinel - (lambda (_ event) - (when flush - (setq flush nil) - (funcall async 'flush)) - (funcall async 'indicator - (cond - ((string-prefix-p "killed" event) 'killed) - ((string-prefix-p "finished" event) 'finished) - (t 'failed))) - (when (and (string-prefix-p "finished" event) (not (equal rest ""))) - (cl-incf count) - (funcall async (list rest))) - (consult--async-log - "consult--async-process sentinel: event=%s lines=%d\n" - (string-trim event) count) - (when (> (buffer-size proc-buf) 0) - (with-current-buffer (get-buffer-create consult--async-log) - (goto-char (point-max)) - (insert ">>>>> stderr >>>>>\n") - (let ((beg (point))) - (insert-buffer-substring proc-buf) - (save-excursion - (goto-char beg) - (message #("%s" 0 2 (face error)) - (buffer-substring-no-properties (pos-bol) (pos-eol))))) - (insert "<<<<< stderr <<<<<\n"))))) - (process-adaptive-read-buffering nil)) - (funcall async 'indicator 'running) - (consult--async-log "consult--async-process started: args=%S default-directory=%S\n" - args default-directory) - (setq count 0 - proc-buf (generate-new-buffer " *consult-async-stderr*") - proc (apply #'make-process - `(,@props - :connection-type pipe - :name ,(car args) - ;;; XXX tramp bug, the stderr buffer must be empty - :stderr ,proc-buf - :noquery t - :command ,args - :filter ,proc-filter - :sentinel ,proc-sentinel))))))) - nil) - ('destroy - (when proc - (delete-process proc) - (kill-buffer proc-buf) - (setq proc nil proc-buf nil)) - (funcall async 'destroy)) - (_ (funcall async action)))))) - -(defun consult--async-highlight (async builder) - "Return a new ASYNC function with candidate highlighting. -BUILDER is the command line builder function." - (let (highlight) - (lambda (action) - (cond - ((stringp action) - (setq highlight (cdr (funcall builder action))) - (funcall async action)) - ((and (consp action) highlight) - (dolist (str action) - (funcall highlight str)) - (funcall async action)) - (t (funcall async action)))))) - -(defun consult--async-throttle (async &optional throttle debounce) - "Create async function from ASYNC which throttles input. - -The THROTTLE delay defaults to `consult-async-input-throttle'. -The DEBOUNCE delay defaults to `consult-async-input-debounce'." - (setq throttle (or throttle consult-async-input-throttle) - debounce (or debounce consult-async-input-debounce)) - (let* ((input "") (timer (timer-create)) (last 0)) - (lambda (action) - (pcase action - ((pred stringp) - (unless (equal action input) - (cancel-timer timer) - (funcall async "") ;; cancel running process - (setq input action) - (unless (equal action "") - (timer-set-function timer (lambda () - (setq last (float-time)) - (funcall async action))) - (timer-set-time - timer - (timer-relative-time - nil (max debounce (- (+ last throttle) (float-time))))) - (timer-activate timer))) - nil) - ('destroy - (cancel-timer timer) - (funcall async 'destroy)) - (_ (funcall async action)))))) - -(defun consult--async-refresh-immediate (async) - "Create async function from ASYNC, which refreshes the display. - -The refresh happens immediately when candidates are pushed." - (lambda (action) - (pcase action - ((or (pred consp) 'flush) - (prog1 (funcall async action) - (funcall async 'refresh))) - (_ (funcall async action))))) - -(defun consult--async-refresh-timer (async &optional delay) - "Create async function from ASYNC, which refreshes the display. - -The refresh happens after a DELAY, defaulting to `consult-async-refresh-delay'." - (let ((delay (or delay consult-async-refresh-delay)) - (timer (timer-create))) - (timer-set-function timer async '(refresh)) - (lambda (action) - (prog1 (funcall async action) - (pcase action - ((or (pred consp) 'flush) - (unless (memq timer timer-list) - (timer-set-time timer (timer-relative-time nil delay)) - (timer-activate timer))) - ('destroy - (cancel-timer timer))))))) - -(defmacro consult--async-command (builder &rest args) - "Asynchronous command pipeline. -ARGS is a list of `make-process' properties and transforms. -BUILDER is the command line builder function, which takes the -input string and must either return a list of command line -arguments or a pair of the command line argument list and a -highlighting function." - (declare (indent 1)) - `(thread-first - (consult--async-sink) - (consult--async-refresh-timer) - ,@(seq-take-while (lambda (x) (not (keywordp x))) args) - (consult--async-process - ,builder - ,@(seq-drop-while (lambda (x) (not (keywordp x))) args)) - (consult--async-throttle) - (consult--async-split))) - -(defmacro consult--async-transform (async &rest transform) - "Use FUN to TRANSFORM candidates of ASYNC." - (cl-with-gensyms (async-var action-var) - `(let ((,async-var ,async)) - (lambda (,action-var) - (funcall ,async-var (if (consp ,action-var) (,@transform ,action-var) ,action-var)))))) - -(defun consult--async-map (async fun) - "Map candidates of ASYNC by FUN." - (consult--async-transform async mapcar fun)) - -(defun consult--async-filter (async fun) - "Filter candidates of ASYNC by FUN." - (consult--async-transform async seq-filter fun)) - -;;;; Dynamic collections based - -(defun consult--dynamic-compute (async fun &optional debounce) - "Dynamic computation of candidates. -ASYNC is the sink. -FUN computes the candidates given the input. -DEBOUNCE is the time after which an interrupted computation -should be restarted." - (setq debounce (or debounce consult-async-input-debounce)) - (setq async (consult--async-indicator async)) - (let* ((request) (current) (timer) - (cancel (lambda () (when timer (cancel-timer timer) (setq timer nil)))) - (start (lambda (req) (setq request req) (funcall async 'refresh)))) - (lambda (action) - (pcase action - ((and 'nil (guard (not request))) - (funcall async nil)) - ('nil - (funcall cancel) - (let ((state 'killed)) - (unwind-protect - (progn - (funcall async 'indicator 'running) - (redisplay) - ;; Run computation - (let ((response (funcall fun request))) - ;; Flush and update candidate list - (funcall async 'flush) - (setq state 'finished current request) - (funcall async response))) - (funcall async 'indicator state) - ;; If the computation was killed, restart it after some time. - (when (eq state 'killed) - (setq timer (run-at-time debounce nil start request))) - (setq request nil)))) - ((pred stringp) - (funcall cancel) - (if (or (equal action "") (equal action current)) - (funcall async 'indicator 'finished) - (funcall start action))) - ('destroy - (funcall cancel) - (funcall async 'destroy)) - (_ (funcall async action)))))) - -(defun consult--dynamic-collection (fun) - "Dynamic collection with input splitting. -FUN computes the candidates given the input." - (thread-first - (consult--async-sink) - (consult--dynamic-compute fun) - (consult--async-throttle) - (consult--async-split))) - -;;;; Special keymaps - -(defvar-keymap consult-async-map - :doc "Keymap added for commands with asynchronous candidates." - ;; Overwriting some unusable defaults of default minibuffer completion. - "<remap> <minibuffer-complete-word>" #'self-insert-command - ;; Remap Emacs 29 history and default completion for now - ;; (gh:minad/consult#613). - "<remap> <minibuffer-complete-defaults>" #'ignore - "<remap> <minibuffer-complete-history>" #'consult-history) - -(defvar-keymap consult-narrow-map - :doc "Narrowing keymap which is added to the local minibuffer map. -Note that `consult-narrow-key' and `consult-widen-key' are bound dynamically." - "SPC" consult--narrow-space - "DEL" consult--narrow-delete) - -;;;; Internal API: consult--read - -(defun consult--annotate-align (cand ann) - "Align annotation ANN by computing the maximum CAND width." - (setq consult--annotate-align-width - (max consult--annotate-align-width - (* (ceiling (consult--display-width cand) - consult--annotate-align-step) - consult--annotate-align-step))) - (when ann - (concat - #(" " 0 1 (display (space :align-to (+ left consult--annotate-align-width)))) - ann))) - -(defun consult--add-history (async items) - "Add ITEMS to the minibuffer future history. -ASYNC must be non-nil for async completion functions." - (delete-dups - (append - ;; the defaults are at the beginning of the future history - (ensure-list minibuffer-default) - ;; then our custom items - (remove "" (remq nil (ensure-list items))) - ;; Add all the completions for non-async commands. For async commands this - ;; feature is not useful, since if one selects a completion candidate, the - ;; async search is restarted using that candidate string. This usually does - ;; not yield a desired result since the async input uses a special format, - ;; e.g., `#grep#filter'. - (unless async - (all-completions "" - minibuffer-completion-table - minibuffer-completion-predicate))))) - -(defun consult--setup-keymap (keymap async narrow preview-key) - "Setup minibuffer keymap. - -KEYMAP is a command-specific keymap. -ASYNC must be non-nil for async completion functions. -NARROW are the narrow settings. -PREVIEW-KEY are the preview keys." - (let ((old-map (current-local-map)) - (map (make-sparse-keymap))) - - ;; Add narrow keys - (when narrow - (consult--narrow-setup narrow map)) - - ;; Preview trigger keys - (when (and (consp preview-key) (memq :keys preview-key)) - (setq preview-key (plist-get preview-key :keys))) - (setq preview-key (mapcar #'car (consult--preview-key-normalize preview-key))) - (when preview-key - (dolist (key preview-key) - (unless (or (eq key 'any) (lookup-key old-map key)) - (define-key map key #'ignore)))) - - ;; Put the keymap together - (use-local-map - (make-composed-keymap - (delq nil (list keymap - (and async consult-async-map) - (and narrow consult-narrow-map) - map)) - old-map)))) - -(defun consult--tofu-hide-in-minibuffer (&rest _) - "Hide the tofus in the minibuffer." - (let* ((min (minibuffer-prompt-end)) - (max (point-max)) - (pos max)) - (while (and (> pos min) (consult--tofu-p (char-before pos))) - (cl-decf pos)) - (when (< pos max) - (add-text-properties pos max '(invisible t rear-nonsticky t cursor-intangible t))))) - -(defun consult--read-annotate (fun cand) - "Annotate CAND with annotation function FUN." - (pcase (funcall fun cand) - (`(,_ ,_ ,suffix) suffix) - (ann ann))) - -(defun consult--read-affixate (fun cands) - "Affixate CANDS with annotation function FUN." - (mapcar (lambda (cand) - (let ((ann (funcall fun cand))) - (if (consp ann) - ann - (setq ann (or ann "")) - (list cand "" - ;; The default completion UI adds the - ;; `completions-annotations' face if no other faces are - ;; present. - (if (text-property-not-all 0 (length ann) 'face nil ann) - ann - (propertize ann 'face 'completions-annotations)))))) - cands)) - -(cl-defun consult--read-1 (table &key - prompt predicate require-match history default - keymap category initial narrow add-history annotate - state preview-key sort lookup group inherit-input-method) - "See `consult--read' for the documentation of the arguments." - (minibuffer-with-setup-hook - (:append (lambda () - (add-hook 'after-change-functions #'consult--tofu-hide-in-minibuffer nil 'local) - (consult--setup-keymap keymap (consult--async-p table) narrow preview-key) - (setq-local minibuffer-default-add-function - (apply-partially #'consult--add-history (consult--async-p table) add-history)))) - (consult--with-async (async table) - (consult--with-preview - preview-key state - (lambda (narrow input cand) - (funcall lookup cand (funcall async nil) input narrow)) - (apply-partially #'run-hook-with-args-until-success - 'consult--completion-candidate-hook) - (pcase-exhaustive history - (`(:input ,var) var) - ((pred symbolp))) - ;; Do not unnecessarily let-bind the lambdas to avoid over-capturing in - ;; the interpreter. This will make closures and the lambda string - ;; representation larger, which makes debugging much worse. Fortunately - ;; the over-capturing problem does not affect the bytecode interpreter - ;; which does a proper scope analysis. - (let* ((metadata `(metadata - ,@(when category `((category . ,category))) - ,@(when group `((group-function . ,group))) - ,@(when annotate - `((affixation-function - . ,(apply-partially #'consult--read-affixate annotate)) - (annotation-function - . ,(apply-partially #'consult--read-annotate annotate)))) - ,@(unless sort '((cycle-sort-function . identity) - (display-sort-function . identity))))) - (consult--annotate-align-width 0) - (selected - (completing-read - prompt - (lambda (str pred action) - (let ((result (complete-with-action action (funcall async nil) str pred))) - (if (eq action 'metadata) - (if (and (eq (car result) 'metadata) (cdr result)) - ;; Merge metadata - `(metadata ,@(cdr metadata) ,@(cdr result)) - metadata) - result))) - predicate require-match initial - (if (symbolp history) history (cadr history)) - default - inherit-input-method))) - ;; Repair the null completion semantics. `completing-read' may return - ;; an empty string even if REQUIRE-MATCH is non-nil. One can always - ;; opt-in to null completion by passing the empty string for DEFAULT. - (when (and (eq require-match t) (not default) (equal selected "")) - (user-error "No selection")) - selected))))) - -(cl-defun consult--read (table &rest options &key - prompt predicate require-match history default - keymap category initial narrow add-history annotate - state preview-key sort lookup group inherit-input-method) - "Enhanced completing read function to select from TABLE. - -The function is a thin wrapper around `completing-read'. Keyword -arguments are used instead of positional arguments for code -clarity. On top of `completing-read' it additionally supports -computing the candidate list asynchronously, candidate preview -and narrowing. You should use `completing-read' instead of -`consult--read' if you don't use asynchronous candidate -computation or candidate preview. - -Keyword OPTIONS: - -PROMPT is the string which is shown as prompt in the minibuffer. -PREDICATE is a filter function called for each candidate, returns -nil or t. -REQUIRE-MATCH equals t means that an exact match is required. -HISTORY is the symbol of the history variable. -DEFAULT is the default selected value. -ADD-HISTORY is a list of items to add to the history. -CATEGORY is the completion category symbol. -SORT should be set to nil if the candidates are already sorted. -This will disable sorting in the completion UI. -LOOKUP is a lookup function passed the selected candidate string, -the list of candidates, the current input string and the current -narrowing value. -ANNOTATE is a function passed a candidate string. The function -should either return an annotation string or a list of three -strings (candidate prefix postfix). -INITIAL is the initial input string. -STATE is the state function, see `consult--with-preview'. -GROUP is a completion metadata `group-function' as documented in -the Elisp manual. -PREVIEW-KEY are the preview keys. Can be nil, `any', a single -key or a list of keys. -NARROW is an alist of narrowing prefix strings and description. -KEYMAP is a command-specific keymap. -INHERIT-INPUT-METHOD, if non-nil the minibuffer inherits the -input method." - ;; supported types - (cl-assert (or (functionp table) ;; dynamic table or asynchronous function - (obarrayp table) ;; obarray - (hash-table-p table) ;; hash table - (not table) ;; empty list - (stringp (car table)) ;; string list - (and (consp (car table)) (stringp (caar table))) ;; string alist - (and (consp (car table)) (symbolp (caar table))))) ;; symbol alist - (ignore prompt predicate require-match history default - keymap category initial narrow add-history annotate - state preview-key sort lookup group inherit-input-method) - (apply #'consult--read-1 table - (append - (consult--customize-get) - options - (list :prompt "Select: " - :preview-key consult-preview-key - :sort t - :lookup (lambda (selected &rest _) selected))))) - -;;;; Internal API: consult--prompt - -(cl-defun consult--prompt-1 (&key prompt history add-history initial default - keymap state preview-key transform inherit-input-method) - "See `consult--prompt' for documentation." - (minibuffer-with-setup-hook - (:append (lambda () - (consult--setup-keymap keymap nil nil preview-key) - (setq-local minibuffer-default-add-function - (apply-partially #'consult--add-history nil add-history)))) - (consult--with-preview - preview-key state - (lambda (_narrow inp _cand) (funcall transform inp)) - (lambda () "") - history - (read-from-minibuffer prompt initial nil nil history default inherit-input-method)))) - -(cl-defun consult--prompt (&rest options &key prompt history add-history initial default - keymap state preview-key transform inherit-input-method) - "Read from minibuffer. - -Keyword OPTIONS: - -PROMPT is the string to prompt with. -TRANSFORM is a function which is applied to the current input string. -HISTORY is the symbol of the history variable. -INITIAL is initial input. -DEFAULT is the default selected value. -ADD-HISTORY is a list of items to add to the history. -STATE is the state function, see `consult--with-preview'. -PREVIEW-KEY are the preview keys (nil, `any', a single key or a list of keys). -KEYMAP is a command-specific keymap." - (ignore prompt history add-history initial default - keymap state preview-key transform inherit-input-method) - (apply #'consult--prompt-1 - (append - (consult--customize-get) - options - (list :prompt "Input: " - :preview-key consult-preview-key - :transform #'identity)))) - -;;;; Internal API: consult--multi - -(defsubst consult--multi-source (sources cand) - "Lookup source for CAND in SOURCES list." - (aref sources (consult--tofu-get cand))) - -(defun consult--multi-predicate (sources cand) - "Predicate function called for each candidate CAND given SOURCES." - (let* ((src (consult--multi-source sources cand)) - (narrow (plist-get src :narrow)) - (type (or (car-safe narrow) narrow -1))) - (or (eq consult--narrow type) - (not (or consult--narrow (plist-get src :hidden)))))) - -(defun consult--multi-narrow (sources) - "Return narrow list from SOURCES." - (thread-last - sources - (mapcar (lambda (src) - (when-let (narrow (plist-get src :narrow)) - (if (consp narrow) - narrow - (when-let (name (plist-get src :name)) - (cons narrow name)))))) - (delq nil) - (delete-dups))) - -(defun consult--multi-annotate (sources cand) - "Annotate candidate CAND from multi SOURCES." - (consult--annotate-align - cand - (let ((src (consult--multi-source sources cand))) - (if-let ((fun (plist-get src :annotate))) - (funcall fun (cdr (get-text-property 0 'multi-category cand))) - (plist-get src :name))))) - -(defun consult--multi-group (sources cand transform) - "Return title of candidate CAND or TRANSFORM the candidate given SOURCES." - (if transform cand - (plist-get (consult--multi-source sources cand) :name))) - -(defun consult--multi-preview-key (sources) - "Return preview keys from SOURCES." - (list :predicate - (lambda (cand) - (if (plist-member (cdr cand) :preview-key) - (plist-get (cdr cand) :preview-key) - consult-preview-key)) - :keys - (delete-dups - (seq-filter (lambda (k) (or (eq k 'any) (stringp k))) - (seq-mapcat (lambda (src) - (ensure-list - (if (plist-member src :preview-key) - (plist-get src :preview-key) - consult-preview-key))) - sources))))) - -(defun consult--multi-lookup (sources selected candidates _input narrow &rest _) - "Lookup SELECTED in CANDIDATES given SOURCES, with potential NARROW." - (if (or (string-blank-p selected) - (not (consult--tofu-p (aref selected (1- (length selected)))))) - ;; Non-existing candidate without Tofu or default submitted (empty string) - (let* ((src (cond - (narrow (seq-find (lambda (src) - (let ((n (plist-get src :narrow))) - (eq (or (car-safe n) n -1) narrow))) - sources)) - ((seq-find (lambda (src) (plist-get src :default)) sources)) - ((seq-find (lambda (src) (not (plist-get src :hidden))) sources)) - ((aref sources 0)))) - (idx (seq-position sources src)) - (def (and (string-blank-p selected) ;; default candidate - (seq-find (lambda (cand) (eq idx (consult--tofu-get cand))) candidates)))) - (if def - (cons (cdr (get-text-property 0 'multi-category def)) src) - `(,selected :match nil ,@src))) - (if-let (found (member selected candidates)) - ;; Existing candidate submitted - (cons (cdr (get-text-property 0 'multi-category (car found))) - (consult--multi-source sources selected)) - ;; Non-existing Tofu'ed candidate submitted, e.g., via Embark - `(,(substring selected 0 -1) :match nil ,@(consult--multi-source sources selected))))) - -(defun consult--multi-candidates (sources) - "Return `consult--multi' candidates from SOURCES." - (let ((idx 0) candidates) - (seq-doseq (src sources) - (let* ((face (and (plist-member src :face) `(face ,(plist-get src :face)))) - (cat (plist-get src :category)) - (items (plist-get src :items)) - (items (if (functionp items) (funcall items) items))) - (dolist (item items) - (let* ((str (or (car-safe item) item)) - (cand (consult--tofu-append str idx))) - ;; Preserve existing `multi-category' datum of the candidate. - (if (and (eq str item) (get-text-property 0 'multi-category str)) - (when face (add-text-properties 0 (length str) face cand)) - ;; Attach `multi-category' datum and face. - (add-text-properties - 0 (length str) - `(multi-category (,cat . ,(or (cdr-safe item) item)) ,@face) cand)) - (push cand candidates)))) - (cl-incf idx)) - (nreverse candidates))) - -(defun consult--multi-enabled-sources (sources) - "Return vector of enabled SOURCES." - (vconcat - (seq-filter (lambda (src) - (if-let (pred (plist-get src :enabled)) - (funcall pred) - t)) - (mapcar (lambda (src) - (if (symbolp src) (symbol-value src) src)) - sources)))) - -(defun consult--multi-state (sources) - "State function given SOURCES." - (when-let (states (delq nil (mapcar (lambda (src) - (when-let (fun (plist-get src :state)) - (cons src (funcall fun)))) - sources))) - (let (last-fun) - (pcase-lambda (action `(,cand . ,src)) - (pcase action - ('setup - (pcase-dolist (`(,_ . ,fun) states) - (funcall fun 'setup nil))) - ('exit - (pcase-dolist (`(,_ . ,fun) states) - (funcall fun 'exit nil))) - ('preview - (let ((selected-fun (cdr (assq src states)))) - ;; If the candidate source changed during preview communicate to - ;; the last source, that none of its candidates is previewed anymore. - (when (and last-fun (not (eq last-fun selected-fun))) - (funcall last-fun 'preview nil)) - (setq last-fun selected-fun) - (when selected-fun - (funcall selected-fun 'preview cand)))) - ('return - (let ((selected-fun (cdr (assq src states)))) - ;; Finish all the sources, except the selected one. - (pcase-dolist (`(,_ . ,fun) states) - (unless (eq fun selected-fun) - (funcall fun 'return nil))) - ;; Finish the source with the selected candidate - (when selected-fun - (funcall selected-fun 'return cand))))))))) - -(defun consult--multi (sources &rest options) - "Select from candidates taken from a list of SOURCES. - -OPTIONS is the plist of options passed to `consult--read'. The following -options are supported: :require-match, :history, :keymap, :initial, -:add-history, :sort and :inherit-input-method. The other options of -`consult--read' are used by the implementation of `consult--multi' and -should not be overwritten, except in in special scenarios. - -The function returns the selected candidate in the form (cons candidate -source-plist). The plist has the key :match with a value nil if the -candidate does not exist, t if the candidate exists and `new' if the -candidate has been created. The sources of the source list can either be -symbols of source variables or source values. Source values must be -plists with fields from the following list. - -Required source fields: -* :category - Completion category symbol. -* :items - List of strings to select from or function returning - list of strings. Note that the strings can use text properties - to carry metadata, which is then available to the :annotate, - :action and :state functions. - -Optional source fields: -* :name - Name of the source as a string, used for narrowing, - group titles and annotations. -* :narrow - Narrowing character or (character . string) pair. -* :enabled - Function which must return t if the source is enabled. -* :hidden - When t candidates of this source are hidden by default. -* :face - Face used for highlighting the candidates. -* :annotate - Annotation function called for each candidate, returns string. -* :history - Name of history variable to add selected candidate. -* :default - Must be t if the first item of the source is the default value. -* :action - Function called with the selected candidate. -* :new - Function called with new candidate name, only if :require-match is nil. -* :state - State constructor for the source, must return the - state function. The state function is informed about state - changes of the UI and can be used to implement preview. -* Other custom source fields can be added depending on the use - case. Note that the source is returned by `consult--multi' - together with the selected candidate." - (let* ((sources (consult--multi-enabled-sources sources)) - (candidates (consult--with-increased-gc - (consult--multi-candidates sources))) - (selected - (apply #'consult--read - candidates - (append - options - (list - :category 'multi-category - :predicate (apply-partially #'consult--multi-predicate sources) - :annotate (apply-partially #'consult--multi-annotate sources) - :group (apply-partially #'consult--multi-group sources) - :lookup (apply-partially #'consult--multi-lookup sources) - :preview-key (consult--multi-preview-key sources) - :narrow (consult--multi-narrow sources) - :state (consult--multi-state sources)))))) - (when-let (history (plist-get (cdr selected) :history)) - (add-to-history history (car selected))) - (if (plist-member (cdr selected) :match) - (when-let (fun (plist-get (cdr selected) :new)) - (funcall fun (car selected)) - (plist-put (cdr selected) :match 'new)) - (when-let (fun (plist-get (cdr selected) :action)) - (funcall fun (car selected))) - (setq selected `(,(car selected) :match t ,@(cdr selected)))) - selected)) - -;;;; Customization macro - -(defun consult--customize-put (cmds prop form) - "Set property PROP to FORM of commands CMDS." - (dolist (cmd cmds) - (cond - ((and (boundp cmd) (consp (symbol-value cmd))) - (setf (plist-get (symbol-value cmd) prop) (eval form 'lexical))) - ((functionp cmd) - (setf (plist-get (alist-get cmd consult--customize-alist) prop) form)) - (t (user-error "%s is neither a Command command nor a source" cmd)))) - nil) - -(defmacro consult-customize (&rest args) - "Set properties of commands or sources. -ARGS is a list of commands or sources followed by the list of -keyword-value pairs. For `consult-customize' to succeed, the -customized sources and commands must exist. When a command is -invoked, the value of `this-command' is used to lookup the -corresponding customization options." - (let (setter) - (while args - (let ((cmds (seq-take-while (lambda (x) (not (keywordp x))) args))) - (setq args (seq-drop-while (lambda (x) (not (keywordp x))) args)) - (while (keywordp (car args)) - (push `(consult--customize-put ',cmds ,(car args) ',(cadr args)) setter) - (setq args (cddr args))))) - (macroexp-progn setter))) - -(defun consult--customize-get () - "Get configuration from `consult--customize-alist' for `this-command'." - (mapcar (lambda (x) (eval x 'lexical)) - (alist-get this-command consult--customize-alist))) - -;;;; Commands - -;;;;; Command: consult-completion-in-region - -(defun consult--insertion-preview (start end) - "State function for previewing a candidate in a specific region. -The candidates are previewed in the region from START to END. This function is -used as the `:state' argument for `consult--read' in the `consult-yank' family -of functions and in `consult-completion-in-region'." - (unless (or (minibufferp) - ;; Disable preview if anything odd is going on with the markers. - ;; Otherwise we get "Marker points into wrong buffer errors". See - ;; gh:minad/consult#375, where Org mode source blocks are - ;; completed in a different buffer than the original buffer. This - ;; completion is probably also problematic in my Corfu completion - ;; package. - (not (eq (window-buffer) (current-buffer))) - (and (markerp start) (not (eq (marker-buffer start) (current-buffer)))) - (and (markerp end) (not (eq (marker-buffer end) (current-buffer))))) - (let (ov) - (lambda (action cand) - (cond - ((and (not cand) ov) - (delete-overlay ov) - (setq ov nil)) - ((and (eq action 'preview) cand) - (unless ov - (setq ov (consult--make-overlay start end - 'invisible t - 'window (selected-window)))) - ;; Use `add-face-text-property' on a copy of "cand in order to merge face properties - (setq cand (copy-sequence cand)) - (add-face-text-property 0 (length cand) 'consult-preview-insertion t cand) - ;; Use the `before-string' property since the overlay might be empty. - (overlay-put ov 'before-string cand))))))) - -;;;###autoload -(defun consult-completion-in-region (start end collection &optional predicate) - "Use minibuffer completion as the UI for `completion-at-point'. - -The function is called with 4 arguments: START END COLLECTION -PREDICATE. The arguments and expected return value are as -specified for `completion-in-region'. Use this function as a -value for `completion-in-region-function'." - (barf-if-buffer-read-only) - (let* ((initial (buffer-substring-no-properties start end)) - (metadata (completion-metadata initial collection predicate)) - ;; TODO: `minibuffer-completing-file-name' is mostly deprecated, but - ;; still in use. Packages should instead use the completion metadata. - (minibuffer-completing-file-name - (eq 'file (completion-metadata-get metadata 'category))) - (threshold (completion--cycle-threshold metadata)) - (all (completion-all-completions initial collection predicate (length initial))) - ;; Wrap all annotation functions to ensure that they are executed - ;; in the original buffer. - (exit-fun (plist-get completion-extra-properties :exit-function)) - (ann-fun (plist-get completion-extra-properties :annotation-function)) - (aff-fun (plist-get completion-extra-properties :affixation-function)) - (docsig-fun (plist-get completion-extra-properties :company-docsig)) - (completion-extra-properties - `(,@(and ann-fun (list :annotation-function (consult--in-buffer ann-fun))) - ,@(and aff-fun (list :affixation-function (consult--in-buffer aff-fun))) - ;; Provide `:annotation-function' if `:company-docsig' is specified. - ,@(and docsig-fun (not ann-fun) (not aff-fun) - (list :annotation-function - (consult--in-buffer - (lambda (cand) - (concat (propertize " " 'display '(space :align-to center)) - (funcall docsig-fun cand))))))))) - ;; error if `threshold' is t or the improper list `all' is too short - (if (and threshold - (or (not (consp (ignore-errors (nthcdr threshold all)))) - (and completion-cycling completion-all-sorted-completions))) - (completion--in-region start end collection predicate) - (let* ((limit (car (completion-boundaries initial collection predicate ""))) - (this-command #'consult-completion-in-region) - (completion - (cond - ((atom all) nil) - ((and (consp all) (atom (cdr all))) - (concat (substring initial 0 limit) (car all))) - (t - (consult--local-let ((enable-recursive-minibuffers t)) - ;; Evaluate completion table in the original buffer. - ;; This is a reasonable thing to do and required by - ;; some completion tables in particular by lsp-mode. - ;; See gh:minad/vertico#61. - (consult--read (consult--completion-table-in-buffer collection) - :prompt "Completion: " - :state (consult--insertion-preview start end) - :predicate predicate - :initial initial)))))) - (if completion - (progn - ;; bug#55205: completion--replace removes properties! - (completion--replace start end (setq completion (concat completion))) - (when exit-fun - (funcall exit-fun completion - ;; If completion is finished and cannot be further - ;; completed, return `finished'. Otherwise return - ;; `exact'. - (if (eq (try-completion completion collection predicate) t) - 'finished 'exact))) - t) - (message "No completion") - nil))))) - -;;;;; Command: consult-outline - -(defun consult--outline-candidates () - "Return alist of outline headings and positions." - (consult--forbid-minibuffer) - (let* ((line (line-number-at-pos (point-min) consult-line-numbers-widen)) - (heading-regexp (concat "^\\(?:" - ;; default definition from outline.el - (or (bound-and-true-p outline-regexp) "[*\^L]+") - "\\)")) - (heading-alist (bound-and-true-p outline-heading-alist)) - (level-fun (or (bound-and-true-p outline-level) - (lambda () ;; as in the default from outline.el - (or (cdr (assoc (match-string 0) heading-alist)) - (- (match-end 0) (match-beginning 0)))))) - (buffer (current-buffer)) - candidates) - (save-excursion - (goto-char (point-min)) - (while (save-excursion - (if-let (fun (bound-and-true-p outline-search-function)) - (funcall fun) - (re-search-forward heading-regexp nil t))) - (cl-incf line (consult--count-lines (match-beginning 0))) - (push (consult--location-candidate - (consult--buffer-substring (pos-bol) (pos-eol) 'fontify) - (cons buffer (point)) (1- line) (1- line) - 'consult--outline-level (funcall level-fun)) - candidates) - (goto-char (1+ (pos-eol))))) - (unless candidates - (user-error "No headings")) - (nreverse candidates))) - -;;;###autoload -(defun consult-outline (&optional level) - "Jump to an outline heading, obtained by matching against `outline-regexp'. - -This command supports narrowing to a heading level and candidate -preview. The initial narrowing LEVEL can be given as prefix -argument. The symbol at point is added to the future history." - (interactive - (list (and current-prefix-arg (prefix-numeric-value current-prefix-arg)))) - (let* ((candidates (consult--slow-operation - "Collecting headings..." - (consult--outline-candidates))) - (min-level (- (cl-loop for cand in candidates minimize - (get-text-property 0 'consult--outline-level cand)) - ?1)) - (narrow-pred (lambda (cand) - (<= (get-text-property 0 'consult--outline-level cand) - (+ consult--narrow min-level)))) - (narrow-keys (mapcar (lambda (c) (cons c (format "Level %c" c))) - (number-sequence ?1 ?9))) - (narrow-init (and level (max ?1 (min ?9 (+ level ?0)))))) - (consult--read - candidates - :prompt "Go to heading: " - :annotate (consult--line-prefix) - :category 'consult-location - :sort nil - :require-match t - :lookup #'consult--line-match - :narrow `(:predicate ,narrow-pred :keys ,narrow-keys :initial ,narrow-init) - :history '(:input consult--line-history) - :add-history (thing-at-point 'symbol) - :state (consult--location-state candidates)))) - -;;;;; Command: consult-mark - -(defun consult--mark-candidates (markers) - "Return list of candidates strings for MARKERS." - (consult--forbid-minibuffer) - (let ((candidates) - (current-buf (current-buffer))) - (save-excursion - (dolist (marker markers) - (when-let ((pos (marker-position marker)) - (buf (marker-buffer marker))) - (when (and (eq buf current-buf) - (consult--in-range-p pos)) - (goto-char pos) - ;; `line-number-at-pos' is a very slow function, which should be - ;; replaced everywhere. However in this case the slow - ;; line-number-at-pos does not hurt much, since the mark ring is - ;; usually small since it is limited by `mark-ring-max'. - (push (consult--location-candidate - (consult--line-with-mark marker) marker - (line-number-at-pos pos consult-line-numbers-widen) - marker) - candidates))))) - (unless candidates - (user-error "No marks")) - (nreverse (delete-dups candidates)))) - -;;;###autoload -(defun consult-mark (&optional markers) - "Jump to a marker in MARKERS list (defaults to buffer-local `mark-ring'). - -The command supports preview of the currently selected marker position. -The symbol at point is added to the future history." - (interactive) - (consult--read - (consult--mark-candidates - (or markers (cons (mark-marker) mark-ring))) - :prompt "Go to mark: " - :annotate (consult--line-prefix) - :category 'consult-location - :sort nil - :require-match t - :lookup #'consult--lookup-location - :history '(:input consult--line-history) - :add-history (thing-at-point 'symbol) - :state (consult--jump-state))) - -;;;;; Command: consult-global-mark - -(defun consult--global-mark-candidates (markers) - "Return list of candidates strings for MARKERS." - (consult--forbid-minibuffer) - (let ((candidates)) - (save-excursion - (dolist (marker markers) - (when-let ((pos (marker-position marker)) - (buf (marker-buffer marker))) - (unless (minibufferp buf) - (with-current-buffer buf - (when (consult--in-range-p pos) - (goto-char pos) - ;; `line-number-at-pos' is slow, see comment in `consult--mark-candidates'. - (let* ((line (line-number-at-pos pos consult-line-numbers-widen)) - (prefix (consult--format-file-line-match (buffer-name buf) line "")) - (cand (concat prefix (consult--line-with-mark marker) (consult--tofu-encode marker)))) - (put-text-property 0 (length prefix) 'consult-strip t cand) - (put-text-property 0 (length cand) 'consult-location (cons marker line) cand) - (push cand candidates)))))))) - (unless candidates - (user-error "No global marks")) - (nreverse (delete-dups candidates)))) - -;;;###autoload -(defun consult-global-mark (&optional markers) - "Jump to a marker in MARKERS list (defaults to `global-mark-ring'). - -The command supports preview of the currently selected marker position. -The symbol at point is added to the future history." - (interactive) - (consult--read - (consult--global-mark-candidates - (or markers global-mark-ring)) - :prompt "Go to global mark: " - ;; Despite `consult-global-mark' formatting the candidates in grep-like - ;; style, we are not using the `consult-grep' category, since the candidates - ;; have location markers attached. - :category 'consult-location - :sort nil - :require-match t - :lookup #'consult--lookup-location - :history '(:input consult--line-history) - :add-history (thing-at-point 'symbol) - :state (consult--jump-state))) - -;;;;; Command: consult-line - -(defun consult--line-candidates (top curr-line) - "Return list of line candidates. -Start from top if TOP non-nil. -CURR-LINE is the current line number." - (consult--forbid-minibuffer) - (consult--fontify-all) - (let* ((buffer (current-buffer)) - (line (line-number-at-pos (point-min) consult-line-numbers-widen)) - default-cand candidates) - (consult--each-line beg end - (unless (looking-at-p "^\\s-*$") - (push (consult--location-candidate - (consult--buffer-substring beg end) - (cons buffer beg) line line) - candidates) - (when (and (not default-cand) (>= line curr-line)) - (setq default-cand candidates))) - (cl-incf line)) - (unless candidates - (user-error "No lines")) - (nreverse - (if (or top (not default-cand)) - candidates - (let ((before (cdr default-cand))) - (setcdr default-cand nil) - (nconc before candidates)))))) - -(defun consult--line-point-placement (selected candidates highlighted &rest ignored-faces) - "Find point position on matching line. -SELECTED is the currently selected candidate. -CANDIDATES is the list of candidates. -HIGHLIGHTED is the highlighted string to determine the match position. -IGNORED-FACES are ignored when determining the match position." - (when-let (pos (consult--lookup-location selected candidates)) - (if highlighted - (let* ((matches (apply #'consult--point-placement highlighted 0 ignored-faces)) - (dest (+ pos (car matches)))) - ;; Only create a new marker when jumping across buffers (for example - ;; `consult-line-multi'). Avoid creating unnecessary markers, when - ;; scrolling through candidates, since creating markers is not free. - (when (and (markerp pos) (not (eq (marker-buffer pos) (current-buffer)))) - (setq dest (move-marker (make-marker) dest (marker-buffer pos)))) - (cons dest (cdr matches))) - pos))) - -(defun consult--line-match (selected candidates input &rest _) - "Lookup position of match. -SELECTED is the currently selected candidate. -CANDIDATES is the list of candidates. -INPUT is the input string entered by the user." - (consult--line-point-placement selected candidates - (and (not (string-blank-p input)) - (car (consult--completion-filter - input - (list (substring-no-properties selected)) - 'consult-location 'highlight))) - 'completions-first-difference)) - -;;;###autoload -(defun consult-line (&optional initial start) - "Search for a matching line. - -Depending on the setting `consult-point-placement' the command -jumps to the beginning or the end of the first match on the line -or the line beginning. The default candidate is the non-empty -line next to point. This command obeys narrowing. Optional -INITIAL input can be provided. The search starting point is -changed if the START prefix argument is set. The symbol at point -and the last `isearch-string' is added to the future history." - (interactive (list nil (not (not current-prefix-arg)))) - (let* ((curr-line (line-number-at-pos (point) consult-line-numbers-widen)) - (top (not (eq start consult-line-start-from-top))) - (candidates (consult--slow-operation "Collecting lines..." - (consult--line-candidates top curr-line)))) - (consult--read - candidates - :prompt (if top "Go to line from top: " "Go to line: ") - :annotate (consult--line-prefix curr-line) - :category 'consult-location - :sort nil - :require-match t - ;; Always add last `isearch-string' to future history - :add-history (list (thing-at-point 'symbol) isearch-string) - :history '(:input consult--line-history) - :lookup #'consult--line-match - :default (car candidates) - ;; Add `isearch-string' as initial input if starting from Isearch - :initial (or initial - (and isearch-mode - (prog1 isearch-string (isearch-done)))) - :state (consult--location-state candidates)))) - -;;;;; Command: consult-line-multi - -(defun consult--line-multi-match (selected candidates &rest _) - "Lookup position of match. -SELECTED is the currently selected candidate. -CANDIDATES is the list of candidates." - (consult--line-point-placement selected candidates - (car (member selected candidates)))) - -(defun consult--line-multi-group (cand transform) - "Group function used by `consult-line-multi'. -If TRANSFORM non-nil, return transformed CAND, otherwise return title." - (if transform cand - (let* ((marker (car (get-text-property 0 'consult-location cand))) - (buf (if (consp marker) - (car marker) ;; Handle cheap marker - (marker-buffer marker)))) - (if buf (buffer-name buf) "Dead buffer")))) - -(defun consult--line-multi-candidates (buffers input) - "Collect matching candidates from multiple buffers. -INPUT is the user input which should be matched. -BUFFERS is the list of buffers." - (pcase-let ((`(,regexps . ,hl) - (funcall consult--regexp-compiler - input 'emacs completion-ignore-case)) - (candidates nil) - (cand-idx 0)) - (save-match-data - (dolist (buf buffers (nreverse candidates)) - (with-current-buffer buf - (save-excursion - (let ((line (line-number-at-pos (point-min) consult-line-numbers-widen))) - (goto-char (point-min)) - (while (and (not (eobp)) - (save-excursion (re-search-forward (car regexps) nil t))) - (cl-incf line (consult--count-lines (match-beginning 0))) - (let ((bol (pos-bol)) - (eol (pos-eol))) - (goto-char bol) - (when (and (not (looking-at-p "^\\s-*$")) - (seq-every-p (lambda (r) - (goto-char bol) - (re-search-forward r eol t)) - (cdr regexps))) - (push (consult--location-candidate - (funcall hl (buffer-substring-no-properties bol eol)) - (cons buf bol) (1- line) cand-idx) - candidates) - (cl-incf cand-idx)) - (goto-char (1+ eol))))))))))) - -;;;###autoload -(defun consult-line-multi (query &optional initial) - "Search for a matching line in multiple buffers. - -By default search across all project buffers. If the prefix -argument QUERY is non-nil, all buffers are searched. Optional -INITIAL input can be provided. The symbol at point and the last -`isearch-string' is added to the future history. In order to -search a subset of buffers, QUERY can be set to a plist according -to `consult--buffer-query'." - (interactive "P") - (unless (keywordp (car-safe query)) - (setq query (list :sort 'alpha-current :directory (and (not query) 'project)))) - (pcase-let* ((`(,prompt . ,buffers) (consult--buffer-query-prompt "Go to line" query)) - (collection (consult--dynamic-collection - (apply-partially #'consult--line-multi-candidates - buffers)))) - (consult--read - collection - :prompt prompt - :annotate (consult--line-prefix) - :category 'consult-location - :sort nil - :require-match t - ;; Always add last Isearch string to future history - :add-history (mapcar #'consult--async-split-initial - (delq nil (list (thing-at-point 'symbol) - isearch-string))) - :history '(:input consult--line-multi-history) - :lookup #'consult--line-multi-match - ;; Add `isearch-string' as initial input if starting from Isearch - :initial (consult--async-split-initial - (or initial - (and isearch-mode - (prog1 isearch-string (isearch-done))))) - :state (consult--location-state (lambda () (funcall collection nil))) - :group #'consult--line-multi-group))) - -;;;;; Command: consult-keep-lines - -(defun consult--keep-lines-state (filter) - "State function for `consult-keep-lines' with FILTER function." - (let ((font-lock-orig font-lock-mode) - (whitespace-orig (bound-and-true-p whitespace-mode)) - (hl-line-orig (bound-and-true-p hl-line-mode)) - (point-orig (point)) - lines content-orig replace last-input) - (if (use-region-p) - (save-restriction - ;; Use the same behavior as `keep-lines'. - (let ((rbeg (region-beginning)) - (rend (save-excursion - (goto-char (region-end)) - (unless (or (bolp) (eobp)) - (forward-line 0)) - (point)))) - (consult--fontify-region rbeg rend) - (narrow-to-region rbeg rend) - (consult--each-line beg end - (push (consult--buffer-substring beg end) lines)) - (setq content-orig (buffer-string) - replace (lambda (content &optional pos) - (delete-region rbeg rend) - (insert-before-markers content) - (goto-char (or pos rbeg)) - (setq rend (+ rbeg (length content))) - (add-face-text-property rbeg rend 'region t))))) - (consult--fontify-all) - (setq content-orig (buffer-string) - replace (lambda (content &optional pos) - (delete-region (point-min) (point-max)) - (insert content) - (goto-char (or pos (point-min))))) - (consult--each-line beg end - (push (consult--buffer-substring beg end) lines))) - (setq lines (nreverse lines)) - (lambda (action input) - ;; Restoring content and point position - (when (and (eq action 'return) last-input) - ;; No undo recording, modification hooks, buffer modified-status - (with-silent-modifications (funcall replace content-orig point-orig))) - ;; Committing or new input provided -> Update - (when (and input ;; Input has been provided - (or - ;; Committing, but not with empty input - (and (eq action 'return) (not (string-match-p "\\`!? ?\\'" input))) - ;; Input has changed - (not (equal input last-input)))) - (let ((filtered-content - (if (string-match-p "\\`!? ?\\'" input) - ;; Special case the empty input for performance. - ;; Otherwise it could happen that the minibuffer is empty, - ;; but the buffer has not been updated. - content-orig - (if (eq action 'return) - (apply #'concat (mapcan (lambda (x) (list x "\n")) - (funcall filter input lines))) - (while-no-input - ;; Heavy computation is interruptible if *not* committing! - ;; Allocate new string candidates since the matching function mutates! - (apply #'concat (mapcan (lambda (x) (list x "\n")) - (funcall filter input (mapcar #'copy-sequence lines))))))))) - (when (stringp filtered-content) - (when font-lock-mode (font-lock-mode -1)) - (when (bound-and-true-p whitespace-mode) (whitespace-mode -1)) - (when (bound-and-true-p hl-line-mode) (hl-line-mode -1)) - (if (eq action 'return) - (atomic-change-group - ;; Disable modification hooks for performance - (let ((inhibit-modification-hooks t)) - (funcall replace filtered-content))) - ;; No undo recording, modification hooks, buffer modified-status - (with-silent-modifications - (funcall replace filtered-content) - (setq last-input input)))))) - ;; Restore modes - (when (eq action 'return) - (when hl-line-orig (hl-line-mode 1)) - (when whitespace-orig (whitespace-mode 1)) - (when font-lock-orig (font-lock-mode 1)))))) - -;;;###autoload -(defun consult-keep-lines (filter &optional initial) - "Select a subset of the lines in the current buffer with live preview. - -The selected lines are kept and the other lines are deleted. When called -interactively, the lines selected are those that match the minibuffer input. In -order to match the inverse of the input, prefix the input with `! '. When -called from Elisp, the filtering is performed by a FILTER function. This -command obeys narrowing. - -FILTER is the filter function. -INITIAL is the initial input." - (interactive - (list (lambda (pattern cands) - ;; Use consult-location completion category when filtering lines - (consult--completion-filter-dispatch - pattern cands 'consult-location 'highlight)))) - (consult--forbid-minibuffer) - (let ((ro buffer-read-only)) - (unwind-protect - (minibuffer-with-setup-hook - (lambda () - (when ro - (minibuffer-message - (substitute-command-keys - " [Unlocked read-only buffer. \\[minibuffer-keyboard-quit] to quit.]")))) - (setq buffer-read-only nil) - (consult--with-increased-gc - (consult--prompt - :prompt "Keep lines: " - :initial initial - :history 'consult--line-history - :state (consult--keep-lines-state filter)))) - (setq buffer-read-only ro)))) - -;;;;; Command: consult-focus-lines - -(defun consult--focus-lines-state (filter) - "State function for `consult-focus-lines' with FILTER function." - (let (lines overlays last-input pt-orig pt-min pt-max) - (save-excursion - (save-restriction - (if (not (use-region-p)) - (consult--fontify-all) - (consult--fontify-region (region-beginning) (region-end)) - (narrow-to-region - (region-beginning) - ;; Behave the same as `keep-lines'. - ;; Move to the next line. - (save-excursion - (goto-char (region-end)) - (unless (or (bolp) (eobp)) - (forward-line 0)) - (point)))) - (setq pt-orig (point) pt-min (point-min) pt-max (point-max)) - (let ((i 0)) - (consult--each-line beg end - ;; Use "\n" for empty lines, since we need a non-empty string to - ;; attach the text property to. - (let ((line (if (eq beg end) (char-to-string ?\n) - (buffer-substring-no-properties beg end)))) - (put-text-property 0 1 'consult--focus-line (cons (cl-incf i) beg) line) - (push line lines))) - (setq lines (nreverse lines))))) - (lambda (action input) - ;; New input provided -> Update - (when (and input (not (equal input last-input))) - (let (new-overlays) - (pcase (while-no-input - (unless (string-match-p "\\`!? ?\\'" input) ;; Empty input. - (let* ((inhibit-quit (eq action 'return)) ;; Non interruptible, when quitting! - (not (string-prefix-p "! " input)) - (stripped (string-remove-prefix "! " input)) - (matches (funcall filter stripped lines)) - (old-ind 0) - (block-beg pt-min) - (block-end pt-min)) - (while old-ind - (let ((match (pop matches)) (ind nil) (beg pt-max) (end pt-max) prop) - (when match - (setq prop (get-text-property 0 'consult--focus-line match) - ind (car prop) - beg (cdr prop) - ;; Check for empty lines, see above. - end (+ 1 beg (if (equal match "\n") 0 (length match))))) - (unless (eq ind (1+ old-ind)) - (let ((a (if not block-beg block-end)) - (b (if not block-end beg))) - (when (/= a b) - (push (consult--make-overlay a b 'invisible t) new-overlays))) - (setq block-beg beg)) - (setq block-end end old-ind ind))))) - 'commit) - ('commit - (mapc #'delete-overlay overlays) - (setq last-input input overlays new-overlays)) - (_ (mapc #'delete-overlay new-overlays))))) - (when (eq action 'return) - (cond - ((not input) - (mapc #'delete-overlay overlays) - (goto-char pt-orig)) - ((equal input "") - (consult-focus-lines nil 'show) - (goto-char pt-orig)) - (t - ;; Successfully terminated -> Remember invisible overlays - (setq consult--focus-lines-overlays - (nconc consult--focus-lines-overlays overlays)) - ;; move point past invisible - (goto-char (if-let (ov (and (invisible-p pt-orig) - (seq-find (lambda (ov) (overlay-get ov 'invisible)) - (overlays-at pt-orig)))) - (overlay-end ov) - pt-orig)))))))) - -;;;###autoload -(defun consult-focus-lines (filter &optional show initial) - "Hide or show lines using overlays. - -The selected lines are shown and the other lines hidden. When called -interactively, the lines selected are those that match the minibuffer input. In -order to match the inverse of the input, prefix the input with `! '. With -optional prefix argument SHOW reveal the hidden lines. Alternatively the -command can be restarted to reveal the lines. When called from Elisp, the -filtering is performed by a FILTER function. This command obeys narrowing. - -FILTER is the filter function. -INITIAL is the initial input." - (interactive - (list (lambda (pattern cands) - ;; Use consult-location completion category when filtering lines - (consult--completion-filter-dispatch - pattern cands 'consult-location nil)) - current-prefix-arg)) - (if show - (progn - (mapc #'delete-overlay consult--focus-lines-overlays) - (setq consult--focus-lines-overlays nil) - (message "All lines revealed")) - (consult--forbid-minibuffer) - (consult--with-increased-gc - (consult--prompt - :prompt - (if consult--focus-lines-overlays - "Focus on lines (RET to reveal): " - "Focus on lines: ") - :initial initial - :history 'consult--line-history - :state (consult--focus-lines-state filter))))) - -;;;;; Command: consult-goto-line - -(defun consult--goto-line-position (str msg) - "Transform input STR to line number. -Print an error message with MSG function." - (save-match-data - (if (and str (string-match "\\`\\([[:digit:]]+\\):?\\([[:digit:]]*\\)\\'" str)) - (let ((line (string-to-number (match-string 1 str))) - (col (string-to-number (match-string 2 str)))) - (save-excursion - (save-restriction - (when consult-line-numbers-widen - (widen)) - (goto-char (point-min)) - (forward-line (1- line)) - (goto-char (min (+ (point) col) (pos-eol))) - (point)))) - (when (and str (not (equal str ""))) - (funcall msg "Please enter a number.")) - nil))) - -;;;###autoload -(defun consult-goto-line (&optional arg) - "Read line number and jump to the line with preview. - -Enter either a line number to jump to the first column of the -given line or line:column in order to jump to a specific column. -Jump directly if a line number is given as prefix ARG. The -command respects narrowing and the settings -`consult-goto-line-numbers' and `consult-line-numbers-widen'." - (interactive "P") - (if arg - (call-interactively #'goto-line) - (consult--forbid-minibuffer) - (consult--local-let ((display-line-numbers consult-goto-line-numbers) - (display-line-numbers-widen consult-line-numbers-widen)) - (while (if-let (pos (consult--goto-line-position - (consult--prompt - :prompt "Go to line: " - :history 'goto-line-history - :state - (let ((preview (consult--jump-preview))) - (lambda (action str) - (funcall preview action - (consult--goto-line-position str #'ignore))))) - #'minibuffer-message)) - (consult--jump pos) - t))))) - -;;;;; Command: consult-recent-file - -(defun consult--file-preview () - "Create preview function for files." - (let ((open (consult--temporary-files)) - (preview (consult--buffer-preview))) - (lambda (action cand) - (unless cand - (funcall open)) - (funcall preview action - (and cand - (eq action 'preview) - (funcall open cand)))))) - -(defun consult--file-action (file) - "Open FILE via `consult--buffer-action'." - ;; Try to preserve the buffer as is, if it has already been opened, for - ;; example in literal or raw mode. - (setq file (abbreviate-file-name (expand-file-name file))) - (consult--buffer-action (or (get-file-buffer file) (find-file-noselect file)))) - -(consult--define-state file) - -;;;###autoload -(defun consult-recent-file () - "Find recent file using `completing-read'." - (interactive) - (find-file - (consult--read - (or - (mapcar #'consult--fast-abbreviate-file-name (bound-and-true-p recentf-list)) - (user-error "No recent files, `recentf-mode' is %s" - (if recentf-mode "enabled" "disabled"))) - :prompt "Find recent file: " - :sort nil - :require-match t - :category 'file - :state (consult--file-preview) - :history 'file-name-history))) - -;;;;; Command: consult-mode-command - -(defun consult--mode-name (mode) - "Return name part of MODE." - (replace-regexp-in-string - "global-\\(.*\\)-mode" "\\1" - (replace-regexp-in-string - "\\(-global\\)?-mode\\'" "" - (if (eq mode 'c-mode) - "cc" - (symbol-name mode)) - 'fixedcase) - 'fixedcase)) - -(defun consult--mode-command-candidates (modes) - "Extract commands from MODES. - -The list of features is searched for files belonging to the modes. -From these files, the commands are extracted." - (let* ((case-fold-search) - (buffer (current-buffer)) - (command-filter (consult--regexp-filter (seq-filter #'stringp consult-mode-command-filter))) - (feature-filter (seq-filter #'symbolp consult-mode-command-filter)) - (minor-hash (consult--string-hash minor-mode-list)) - (minor-local-modes (seq-filter (lambda (m) - (and (gethash m minor-hash) - (local-variable-if-set-p m))) - modes)) - (minor-global-modes (seq-filter (lambda (m) - (and (gethash m minor-hash) - (not (local-variable-if-set-p m)))) - modes)) - (major-modes (seq-remove (lambda (m) - (gethash m minor-hash)) - modes)) - (major-paths-hash (consult--string-hash (mapcar #'symbol-file major-modes))) - (minor-local-paths-hash (consult--string-hash (mapcar #'symbol-file minor-local-modes))) - (minor-global-paths-hash (consult--string-hash (mapcar #'symbol-file minor-global-modes))) - (major-name-regexp (regexp-opt (mapcar #'consult--mode-name major-modes))) - (minor-local-name-regexp (regexp-opt (mapcar #'consult--mode-name minor-local-modes))) - (minor-global-name-regexp (regexp-opt (mapcar #'consult--mode-name minor-global-modes))) - (commands)) - (dolist (feature load-history commands) - (when-let (name (alist-get 'provide feature)) - (let* ((path (car feature)) - (file (file-name-nondirectory path)) - (key (cond - ((memq name feature-filter) nil) - ((or (gethash path major-paths-hash) - (string-match-p major-name-regexp file)) - ?m) - ((or (gethash path minor-local-paths-hash) - (string-match-p minor-local-name-regexp file)) - ?l) - ((or (gethash path minor-global-paths-hash) - (string-match-p minor-global-name-regexp file)) - ?g)))) - (when key - (dolist (cmd (cdr feature)) - (let ((sym (cdr-safe cmd))) - (when (and (consp cmd) - (eq (car cmd) 'defun) - (commandp sym) - (not (get sym 'byte-obsolete-info)) - (or (not read-extended-command-predicate) - (funcall read-extended-command-predicate sym buffer))) - (let ((name (symbol-name sym))) - (unless (string-match-p command-filter name) - (push (propertize name - 'consult--candidate sym - 'consult--type key) - commands)))))))))))) - -;;;###autoload -(defun consult-mode-command (&rest modes) - "Run a command from any of the given MODES. - -If no MODES are specified, use currently active major and minor modes." - (interactive) - (unless modes - (setq modes (cons major-mode - (seq-filter (lambda (m) - (and (boundp m) (symbol-value m))) - minor-mode-list)))) - (let ((narrow `((?m . ,(format "Major: %s" major-mode)) - (?l . "Local Minor") - (?g . "Global Minor")))) - (command-execute - (consult--read - (consult--mode-command-candidates modes) - :prompt "Mode command: " - :predicate - (lambda (cand) - (let ((key (get-text-property 0 'consult--type cand))) - (if consult--narrow - (= key consult--narrow) - (/= key ?g)))) - :lookup #'consult--lookup-candidate - :group (consult--type-group narrow) - :narrow narrow - :require-match t - :history 'extended-command-history - :category 'command)))) - -;;;;; Command: consult-yank - -(defun consult--read-from-kill-ring () - "Open kill ring menu and return selected string." - ;; `current-kill' updates `kill-ring' with interprogram paste, see - ;; gh:minad/consult#443. - (current-kill 0) - ;; Do not specify a :lookup function in order to preserve completion-styles - ;; highlighting of the current candidate. We have to perform a final lookup to - ;; obtain the original candidate which may be propertized with yank-specific - ;; properties, like 'yank-handler. - (consult--lookup-member - (consult--read - (consult--remove-dups - (or (if yank-from-kill-ring-rotate - (append kill-ring-yank-pointer - (butlast kill-ring (length kill-ring-yank-pointer))) - kill-ring) - (user-error "Kill ring is empty"))) - :prompt "Yank from kill-ring: " - :history t ;; disable history - :sort nil - :category 'kill-ring - :require-match t - :state - (consult--insertion-preview - (point) - ;; If previous command is yank, hide previously yanked string - (or (and (eq last-command 'yank) (mark t)) (point)))) - kill-ring)) - -;; Adapted from the Emacs `yank-from-kill-ring' function. -;;;###autoload -(defun consult-yank-from-kill-ring (string &optional arg) - "Select STRING from the kill ring and insert it. -With prefix ARG, put point at beginning, and mark at end, like `yank' does. - -This command behaves like `yank-from-kill-ring', which also offers a -`completing-read' interface to the `kill-ring'. Additionally the -Consult version supports preview of the selected string." - (interactive (list (consult--read-from-kill-ring) current-prefix-arg)) - (when string - (setq yank-window-start (window-start)) - (push-mark) - (insert-for-yank string) - (setq this-command 'yank) - (when yank-from-kill-ring-rotate - (if-let (pos (seq-position kill-ring string)) - (setq kill-ring-yank-pointer (nthcdr pos kill-ring)) - (kill-new string))) - (when (consp arg) - ;; Swap point and mark like in `yank'. - (goto-char (prog1 (mark t) - (set-marker (mark-marker) (point) (current-buffer))))))) - -(put 'consult-yank-replace 'delete-selection 'yank) -(put 'consult-yank-pop 'delete-selection 'yank) -(put 'consult-yank-from-kill-ring 'delete-selection 'yank) - -;;;###autoload -(defun consult-yank-pop (&optional arg) - "If there is a recent yank act like `yank-pop'. - -Otherwise select string from the kill ring and insert it. -See `yank-pop' for the meaning of ARG. - -This command behaves like `yank-pop', which also offers a -`completing-read' interface to the `kill-ring'. Additionally the -Consult version supports preview of the selected string." - (interactive "*p") - (if (eq last-command 'yank) - (yank-pop (or arg 1)) - (call-interactively #'consult-yank-from-kill-ring))) - -;; Adapted from the Emacs yank-pop function. -;;;###autoload -(defun consult-yank-replace (string) - "Select STRING from the kill ring. - -If there was no recent yank, insert the string. -Otherwise replace the just-yanked string with the selected string." - (interactive (list (consult--read-from-kill-ring))) - (when string - (if (not (eq last-command 'yank)) - (consult-yank-from-kill-ring string) - (let ((inhibit-read-only t) - (pt (point)) - (mk (mark t))) - (setq this-command 'yank) - (funcall (or yank-undo-function 'delete-region) (min pt mk) (max pt mk)) - (setq yank-undo-function nil) - (set-marker (mark-marker) pt (current-buffer)) - (insert-for-yank string) - (set-window-start (selected-window) yank-window-start t) - (if (< pt mk) - (goto-char (prog1 (mark t) - (set-marker (mark-marker) (point) (current-buffer))))))))) - -;;;;; Command: consult-bookmark - -(defun consult--bookmark-preview () - "Create preview function for bookmarks." - (let ((preview (consult--jump-preview)) - (open (consult--temporary-files))) - (lambda (action cand) - (unless cand - (funcall open)) - (funcall - preview action - ;; Only preview bookmarks with the default handler. - (when-let ((bm (and cand (eq action 'preview) (assoc cand bookmark-alist))) - (handler (or (bookmark-get-handler bm) #'bookmark-default-handler)) - ((eq handler #'bookmark-default-handler)) - (file (bookmark-get-filename bm)) - (pos (bookmark-get-position bm)) - (buf (funcall open file))) - (set-marker (make-marker) pos buf)))))) - -(defun consult--bookmark-action (bm) - "Open BM via `consult--buffer-action'." - (bookmark-jump bm consult--buffer-display)) - -(consult--define-state bookmark) - -(defun consult--bookmark-candidates () - "Return bookmark candidates." - (bookmark-maybe-load-default-file) - (let ((narrow (cl-loop for (y _ . xs) in consult-bookmark-narrow nconc - (cl-loop for x in xs collect (cons x y))))) - (cl-loop for bm in bookmark-alist collect - (propertize (car bm) - 'consult--type - (alist-get - (or (bookmark-get-handler bm) #'bookmark-default-handler) - narrow))))) - -;;;###autoload -(defun consult-bookmark (name) - "If bookmark NAME exists, open it, otherwise create a new bookmark with NAME. - -The command supports preview of file bookmarks and narrowing. See the -variable `consult-bookmark-narrow' for the narrowing configuration." - (interactive - (list - (let ((narrow (cl-loop for (x y . _) in consult-bookmark-narrow collect (cons x y)))) - (consult--read - (consult--bookmark-candidates) - :prompt "Bookmark: " - :state (consult--bookmark-preview) - :category 'bookmark - :history 'bookmark-history - ;; Add default names to future history. - ;; Ignore errors such that `consult-bookmark' can be used in - ;; buffers which are not backed by a file. - :add-history (ignore-errors (bookmark-prop-get (bookmark-make-record) 'defaults)) - :group (consult--type-group narrow) - :narrow (consult--type-narrow narrow))))) - (bookmark-maybe-load-default-file) - (if (assoc name bookmark-alist) - (bookmark-jump name) - (bookmark-set name))) - -;;;;; Command: consult-complex-command - -;;;###autoload -(defun consult-complex-command () - "Select and evaluate command from the command history. - -This command can act as a drop-in replacement for `repeat-complex-command'." - (interactive) - (let* ((history (or (delete-dups (mapcar #'prin1-to-string command-history)) - (user-error "There are no previous complex commands"))) - (cmd (read (consult--read - history - :prompt "Command: " - :default (car history) - :sort nil - :history t ;; disable history - :category 'expression)))) - ;; Taken from `repeat-complex-command' - (add-to-history 'command-history cmd) - (apply #'funcall-interactively - (car cmd) - (mapcar (lambda (e) (eval e t)) (cdr cmd))))) - -;;;;; Command: consult-history - -(declare-function ring-elements "ring") - -(defun consult--current-history () - "Return the history and index variable relevant to the current buffer. -If the minibuffer is active, the minibuffer history is returned, -otherwise the history corresponding to the mode. There is a -special case for `repeat-complex-command', for which the command -history is used." - (cond - ;; In the minibuffer we use the current minibuffer history, - ;; which can be configured by setting `minibuffer-history-variable'. - ((minibufferp) - (when (eq minibuffer-history-variable t) - (user-error "Minibuffer history is disabled for `%s'" this-command)) - (list (mapcar #'consult--tofu-hide - (if (eq minibuffer-history-variable 'command-history) - ;; If pressing "C-x M-:", i.e., `repeat-complex-command', - ;; we are instead querying the `command-history' and get a - ;; full s-expression. Alternatively you might want to use - ;; `consult-complex-command', which can also be bound to - ;; "C-x M-:"! - (mapcar #'prin1-to-string command-history) - (symbol-value minibuffer-history-variable))))) - ;; Otherwise we use a mode-specific history, see `consult-mode-histories'. - (t (let ((found (seq-find (lambda (h) - (and (derived-mode-p (car h)) - (boundp (if (consp (cdr h)) (cadr h) (cdr h))))) - consult-mode-histories))) - (unless found - (user-error "No history configured for `%s', see `consult-mode-histories'" - major-mode)) - (cons (symbol-value (cadr found)) (cddr found)))))) - -;;;###autoload -(defun consult-history (&optional history index bol) - "Insert string from HISTORY of current buffer. -In order to select from a specific HISTORY, pass the history -variable as argument. INDEX is the name of the index variable to -update, if any. BOL is the function which jumps to the beginning -of the prompt. See also `cape-history' from the Cape package." - (interactive) - (pcase-let* ((`(,history ,index ,bol) (if history - (list history index bol) - (consult--current-history))) - (history (if (ring-p history) (ring-elements history) history)) - (`(,beg . ,end) - (if (minibufferp) - (cons (minibuffer-prompt-end) (point-max)) - (if bol - (save-excursion - (funcall bol) - (cons (point) (pos-eol))) - (cons (point) (point))))) - (str (consult--local-let ((enable-recursive-minibuffers t)) - (consult--read - (or (consult--remove-dups history) - (user-error "History is empty")) - :prompt "History: " - :history t ;; disable history - :category ;; Report category depending on history variable - (and (minibufferp) - (pcase minibuffer-history-variable - ('extended-command-history 'command) - ('buffer-name-history 'buffer) - ('face-name-history 'face) - ('read-envvar-name-history 'environment-variable) - ('bookmark-history 'bookmark) - ('file-name-history 'file))) - :sort nil - :initial (buffer-substring-no-properties beg end) - :state (consult--insertion-preview beg end))))) - (delete-region beg end) - (when index - (set index (seq-position history str))) - (insert (substring-no-properties str)))) - -;;;;; Command: consult-isearch-history - -(defun consult-isearch-forward (&optional reverse) - "Continue Isearch forward optionally in REVERSE." - (declare (completion ignore)) - (interactive) - (consult--require-minibuffer) - (setq isearch-new-forward (not reverse) isearch-new-nonincremental nil) - (funcall (or (command-remapping #'exit-minibuffer) #'exit-minibuffer))) - -(defun consult-isearch-backward (&optional reverse) - "Continue Isearch backward optionally in REVERSE." - (declare (completion ignore)) - (interactive) - (consult-isearch-forward (not reverse))) - -(defvar-keymap consult-isearch-history-map - :doc "Additional keymap used by `consult-isearch-history'." - "<remap> <isearch-forward>" #'consult-isearch-forward - "<remap> <isearch-backward>" #'consult-isearch-backward) - -(defun consult--isearch-history-candidates () - "Return Isearch history candidates." - ;; Do not throw an error on empty history, in order to allow starting a - ;; search. We do not :require-match here. - (let ((history (if (eq t search-default-mode) - (append regexp-search-ring search-ring) - (append search-ring regexp-search-ring)))) - (delete-dups - (mapcar - (lambda (cand) - ;; The search type can be distinguished via text properties. - (let* ((props (plist-member (text-properties-at 0 cand) - 'isearch-regexp-function)) - (type (pcase (cadr props) - ((and 'nil (guard (not props))) ?r) - ('nil ?l) - ('word-search-regexp ?w) - ('isearch-symbol-regexp ?s) - ('char-fold-to-regexp ?c) - (_ ?u)))) - ;; Disambiguate history items. The same string could - ;; occur with different search types. - (consult--tofu-append cand type))) - history)))) - -(defconst consult--isearch-history-narrow - '((?c . "Char") - (?u . "Custom") - (?l . "Literal") - (?r . "Regexp") - (?s . "Symbol") - (?w . "Word"))) - -;;;###autoload -(defun consult-isearch-history () - "Read a search string with completion from the Isearch history. - -This replaces the current search string if Isearch is active, and -starts a new Isearch session otherwise." - (interactive) - (consult--forbid-minibuffer) - (let* ((isearch-message-function #'ignore) - (cursor-in-echo-area t) ;; Avoid cursor flickering - (candidates (consult--isearch-history-candidates))) - (unless isearch-mode (isearch-mode t)) - (with-isearch-suspended - (setq isearch-new-string - (consult--read - candidates - :prompt "I-search: " - :category 'consult-isearch-history - :history t ;; disable history - :sort nil - :initial isearch-string - :keymap consult-isearch-history-map - :annotate - (lambda (cand) - (consult--annotate-align - cand - (alist-get (consult--tofu-get cand) consult--isearch-history-narrow))) - :group - (lambda (cand transform) - (if transform - cand - (alist-get (consult--tofu-get cand) consult--isearch-history-narrow))) - :lookup - (lambda (selected candidates &rest _) - (if-let (found (member selected candidates)) - (substring (car found) 0 -1) - selected)) - :state - (lambda (action cand) - (when (and (eq action 'preview) cand) - (setq isearch-string cand) - (isearch-update-from-string-properties cand) - (isearch-update))) - :narrow - (list :predicate - (lambda (cand) (= (consult--tofu-get cand) consult--narrow)) - :keys consult--isearch-history-narrow)) - isearch-new-message - (mapconcat 'isearch-text-char-description isearch-new-string ""))) - ;; Setting `isearch-regexp' etc only works outside of `with-isearch-suspended'. - (unless (plist-member (text-properties-at 0 isearch-string) 'isearch-regexp-function) - (setq isearch-regexp t - isearch-regexp-function nil)))) - -;;;;; Command: consult-minor-mode-menu - -(defun consult--minor-mode-candidates () - "Return list of minor-mode candidate strings." - (mapcar - (pcase-lambda (`(,name . ,sym)) - (propertize - name - 'consult--candidate sym - 'consult--minor-mode-narrow - (logior - (ash (if (local-variable-if-set-p sym) ?l ?g) 8) - (if (and (boundp sym) (symbol-value sym)) ?i ?o)) - 'consult--minor-mode-group - (concat - (if (local-variable-if-set-p sym) "Local " "Global ") - (if (and (boundp sym) (symbol-value sym)) "On" "Off")))) - (nconc - ;; according to describe-minor-mode-completion-table-for-symbol - ;; the minor-mode-list contains *all* minor modes - (mapcar (lambda (sym) (cons (symbol-name sym) sym)) minor-mode-list) - ;; take the lighters from minor-mode-alist - (delq nil - (mapcar (pcase-lambda (`(,sym ,lighter)) - (when (and lighter (not (equal "" lighter))) - (let (message-log-max) - (setq lighter (string-trim (format-mode-line lighter))) - (unless (string-blank-p lighter) - (cons lighter sym))))) - minor-mode-alist))))) - -(defconst consult--minor-mode-menu-narrow - '((?l . "Local") - (?g . "Global") - (?i . "On") - (?o . "Off"))) - -;;;###autoload -(defun consult-minor-mode-menu () - "Enable or disable minor mode. - -This is an alternative to `minor-mode-menu-from-indicator'." - (interactive) - (call-interactively - (consult--read - (consult--minor-mode-candidates) - :prompt "Minor mode: " - :require-match t - :category 'minor-mode - :group - (lambda (cand transform) - (if transform cand (get-text-property 0 'consult--minor-mode-group cand))) - :narrow - (list :predicate - (lambda (cand) - (let ((narrow (get-text-property 0 'consult--minor-mode-narrow cand))) - (or (= (logand narrow 255) consult--narrow) - (= (ash narrow -8) consult--narrow)))) - :keys - consult--minor-mode-menu-narrow) - :lookup #'consult--lookup-candidate - :history 'consult--minor-mode-menu-history))) - -;;;;; Command: consult-theme - -;;;###autoload -(defun consult-theme (theme) - "Disable current themes and enable THEME from `consult-themes'. - -The command supports previewing the currently selected theme." - (interactive - (list - (let* ((regexp (consult--regexp-filter - (mapcar (lambda (x) (if (stringp x) x (format "\\`%s\\'" x))) - consult-themes))) - (avail-themes (seq-filter - (lambda (x) (string-match-p regexp (symbol-name x))) - (cons 'default (custom-available-themes)))) - (saved-theme (car custom-enabled-themes))) - (consult--read - (mapcar #'symbol-name avail-themes) - :prompt "Theme: " - :require-match t - :category 'theme - :history 'consult--theme-history - :lookup (lambda (selected &rest _) - (setq selected (and selected (intern-soft selected))) - (or (and selected (car (memq selected avail-themes))) - saved-theme)) - :state (lambda (action theme) - (pcase action - ('return (consult-theme (or theme saved-theme))) - ((and 'preview (guard theme)) (consult-theme theme)))) - :default (symbol-name (or saved-theme 'default)))))) - (when (eq theme 'default) (setq theme nil)) - (unless (eq theme (car custom-enabled-themes)) - (mapc #'disable-theme custom-enabled-themes) - (when theme - (if (custom-theme-p theme) - (enable-theme theme) - (load-theme theme :no-confirm))))) - -;;;;; Command: consult-buffer - -(defun consult--buffer-sort-alpha (buffers) - "Sort BUFFERS alphabetically, put starred buffers at the end." - (sort buffers - (lambda (x y) - (setq x (buffer-name x) y (buffer-name y)) - (let ((a (and (length> x 0) (eq (aref x 0) ?*))) - (b (and (length> y 0) (eq (aref y 0) ?*)))) - (if (eq a b) - (string< x y) - (not a)))))) - -(defun consult--buffer-sort-alpha-current (buffers) - "Sort BUFFERS alphabetically, put current at the beginning." - (let ((buffers (consult--buffer-sort-alpha buffers)) - (current (current-buffer))) - (if (memq current buffers) - (cons current (delq current buffers)) - buffers))) - -(defun consult--buffer-sort-visibility (buffers) - "Sort BUFFERS by visibility." - (let ((hidden) - (current (car (memq (current-buffer) buffers)))) - (consult--keep! buffers - (unless (eq it current) - (if (get-buffer-window it 'visible) - it - (push it hidden) - nil))) - (nconc (nreverse hidden) buffers (and current (list current))))) - -(defun consult--normalize-directory (dir) - "Normalize directory DIR. -DIR can be project, nil or a path." - (cond - ((eq dir 'project) (consult--project-root)) - (dir (expand-file-name dir)))) - -(defun consult--buffer-query-prompt (prompt query) - "Return a list of buffers and create an appropriate prompt string. -Return a pair of a prompt string and a list of buffers. PROMPT -is the prefix of the prompt string. QUERY specifies the buffers -to search and is passed to `consult--buffer-query'." - (let* ((dir (plist-get query :directory)) - (ndir (consult--normalize-directory dir)) - (buffers (apply #'consult--buffer-query :directory ndir query)) - (count (length buffers))) - (cons (format "%s (%d buffer%s%s): " prompt count - (if (= count 1) "" "s") - (cond - ((and ndir (eq dir 'project)) - (format ", Project %s" (consult--project-name ndir))) - (ndir (concat ", " (consult--left-truncate-file ndir))) - (t ""))) - buffers))) - -(cl-defun consult--buffer-query (&key sort directory mode as predicate (filter t) - include (exclude consult-buffer-filter) - (buffer-list t)) - "Query for a list of matching buffers. -The function supports filtering by various criteria which are -used throughout Consult. In particular it is the backbone of -most `consult-buffer-sources'. -DIRECTORY can either be the symbol project or a file name. -SORT can be visibility, alpha or nil. -FILTER can be either t, nil or invert. -EXCLUDE is a list of regexps. -INCLUDE is a list of regexps. -MODE can be a mode or a list of modes to restrict the returned buffers. -PREDICATE is a predicate function. -BUFFER-LIST is the unfiltered list of buffers. -AS is a conversion function." - (let ((root (consult--normalize-directory directory))) - (setq buffer-list (if (eq buffer-list t) (buffer-list) (copy-sequence buffer-list))) - (when sort - (setq buffer-list (funcall (intern (format "consult--buffer-sort-%s" sort)) buffer-list))) - (when (or filter mode as root) - (let ((exclude-re (consult--regexp-filter exclude)) - (include-re (consult--regexp-filter include)) - (case-fold-search)) - (consult--keep! buffer-list - (and - (or (not mode) - (let ((mm (buffer-local-value 'major-mode it))) - (if (consp mode) - (seq-some (lambda (m) (provided-mode-derived-p mm m)) mode) - (provided-mode-derived-p mm mode)))) - (pcase-exhaustive filter - ('nil t) - ((or 't 'invert) - (eq (eq filter t) - (and - (or (not exclude) - (not (string-match-p exclude-re (buffer-name it)))) - (or (not include) - (not (not (string-match-p include-re (buffer-name it))))))))) - (or (not root) - (when-let (dir (buffer-local-value 'default-directory it)) - (string-prefix-p root - (if (and (/= 0 (length dir)) (eq (aref dir 0) ?/)) - dir - (expand-file-name dir))))) - (or (not predicate) (funcall predicate it)) - (if as (funcall as it) it))))) - buffer-list)) - -(defun consult--buffer-file-hash () - "Return hash table of all buffer file names." - (consult--string-hash (consult--buffer-query :as #'buffer-file-name))) - -(defun consult--buffer-pair (buffer) - "Return a pair of name of BUFFER and BUFFER." - (cons (buffer-name buffer) buffer)) - -(defun consult--buffer-preview () - "Buffer preview function." - (let ((orig-buf (window-buffer (consult--original-window))) - (orig-prev (copy-sequence (window-prev-buffers))) - (orig-next (copy-sequence (window-next-buffers))) - other-win) - (lambda (action cand) - (pcase action - ('exit - (set-window-prev-buffers other-win orig-prev) - (set-window-next-buffers other-win orig-next)) - ('preview - (when (and (eq consult--buffer-display #'switch-to-buffer-other-window) - (not other-win)) - (switch-to-buffer-other-window orig-buf 'norecord) - (setq other-win (selected-window))) - (let ((win (or other-win (selected-window))) - (buf (or (and cand (get-buffer cand)) orig-buf))) - (when (and (window-live-p win) (buffer-live-p buf) - (not (buffer-match-p consult-preview-excluded-buffers buf))) - (with-selected-window win - (unless (or orig-prev orig-next) - (setq orig-prev (copy-sequence (window-prev-buffers)) - orig-next (copy-sequence (window-next-buffers)))) - (switch-to-buffer buf 'norecord))))))))) - -(defun consult--buffer-action (buffer &optional norecord) - "Switch to BUFFER via `consult--buffer-display' function. -If NORECORD is non-nil, do not record the buffer switch in the buffer list." - (funcall consult--buffer-display buffer norecord)) - -(consult--define-state buffer) - -(defvar consult--source-bookmark - `( :name "Bookmark" - :narrow ?m - :category bookmark - :face consult-bookmark - :history bookmark-history - :items ,#'bookmark-all-names - :state ,#'consult--bookmark-state) - "Bookmark candidate source for `consult-buffer'.") - -(defvar consult--source-project-buffer - `( :name "Project Buffer" - :narrow ?b - :category buffer - :face consult-buffer - :history buffer-name-history - :state ,#'consult--buffer-state - :enabled ,(lambda () consult-project-function) - :items - ,(lambda () - (when-let (root (consult--project-root)) - (consult--buffer-query :sort 'visibility - :directory root - :as #'consult--buffer-pair)))) - "Project buffer candidate source for `consult-buffer'.") - -(defvar consult--source-project-recent-file - `( :name "Project File" - :narrow ?f - :category file - :face consult-file - :history file-name-history - :state ,#'consult--file-state - :new - ,(lambda (file) - (consult--file-action - (expand-file-name file (consult--project-root)))) - :enabled - ,(lambda () - (and consult-project-function - recentf-mode)) - :items - ,(lambda () - (when-let (root (consult--project-root)) - (let ((len (length root)) - (ht (consult--buffer-file-hash)) - items) - (dolist (file (bound-and-true-p recentf-list) (nreverse items)) - ;; Emacs 29 abbreviates file paths by default, see - ;; `recentf-filename-handlers'. I recommend to set - ;; `recentf-filename-handlers' to nil to avoid any slow down. - (unless (eq (aref file 0) ?/) - (let (file-name-handler-alist) ;; No Tramp slowdown please. - (setq file (expand-file-name file)))) - (when (and (not (gethash file ht)) (string-prefix-p root file)) - (let ((part (substring file len))) - (when (equal part "") (setq part "./")) - (put-text-property 0 1 'multi-category `(file . ,file) part) - (push part items)))))))) - "Project file candidate source for `consult-buffer'.") - -(defvar consult--source-project-buffer-hidden - `(:hidden t :narrow (?p . "Project") ,@consult--source-project-buffer) - "Like `consult--source-project-buffer' but hidden by default.") - -(defvar consult--source-project-recent-file-hidden - `(:hidden t :narrow (?p . "Project") ,@consult--source-project-recent-file) - "Like `consult--source-project-recent-file' but hidden by default.") - -(defvar consult--source-hidden-buffer - `( :name "Hidden Buffer" - :narrow ?\s - :hidden t - :category buffer - :face consult-buffer - :history buffer-name-history - :action ,#'consult--buffer-action - :items - ,(lambda () (consult--buffer-query :sort 'visibility - :filter 'invert - :as #'consult--buffer-pair))) - "Hidden buffer candidate source for `consult-buffer'.") - -(defvar consult--source-modified-buffer - `( :name "Modified Buffer" - :narrow ?* - :hidden t - :category buffer - :face consult-buffer - :history buffer-name-history - :state ,#'consult--buffer-state - :items - ,(lambda () (consult--buffer-query :sort 'visibility - :as #'consult--buffer-pair - :predicate - (lambda (buf) - (and (buffer-modified-p buf) - (buffer-file-name buf)))))) - "Modified buffer candidate source for `consult-buffer'.") - -(defvar consult--source-buffer - `( :name "Buffer" - :narrow ?b - :category buffer - :face consult-buffer - :history buffer-name-history - :state ,#'consult--buffer-state - :default t - :items - ,(lambda () (consult--buffer-query :sort 'visibility - :as #'consult--buffer-pair))) - "Buffer candidate source for `consult-buffer'.") - -(defun consult--file-register-p (reg) - "Return non-nil if REG is a file register." - (memq (car-safe (cdr reg)) '(file-query file))) - -(autoload 'consult-register--candidates "consult-register") -(defvar consult--source-file-register - `( :name "File Register" - :narrow (?r . "Register") - :category file - :state ,#'consult--file-state - :enabled ,(lambda () (seq-some #'consult--file-register-p register-alist)) - :items ,(lambda () (consult-register--candidates #'consult--file-register-p))) - "File register source.") - -(defvar consult--source-recent-file - `( :name "File" - :narrow ?f - :category file - :face consult-file - :history file-name-history - :state ,#'consult--file-state - :new ,#'consult--file-action - :enabled ,(lambda () recentf-mode) - :items - ,(lambda () - (let ((ht (consult--buffer-file-hash)) - items) - (dolist (file (bound-and-true-p recentf-list) (nreverse items)) - ;; Emacs 29 abbreviates file paths by default, see - ;; `recentf-filename-handlers'. I recommend to set - ;; `recentf-filename-handlers' to nil to avoid any slow down. - (unless (eq (aref file 0) ?/) - (let (file-name-handler-alist) ;; No Tramp slowdown please. - (setq file (expand-file-name file)))) - (unless (gethash file ht) - (push (consult--fast-abbreviate-file-name file) items)))))) - "Recent file candidate source for `consult-buffer'.") - -;;;###autoload -(defun consult-buffer (&optional sources) - "Enhanced `switch-to-buffer' command with support for virtual buffers. - -The command supports recent files, bookmarks, views and project files as -virtual buffers. Buffers are previewed. Narrowing to buffers (b), files (f), -bookmarks (m) and project files (p) is supported via the corresponding -keys. In order to determine the project-specific files and buffers, the -`consult-project-function' is used. The virtual buffer SOURCES -default to `consult-buffer-sources'. See `consult--multi' for the -configuration of the virtual buffer sources." - (interactive) - (let ((selected (consult--multi (or sources consult-buffer-sources) - :require-match - (confirm-nonexistent-file-or-buffer) - :prompt "Switch to: " - :history 'consult--buffer-history - :sort nil))) - ;; For non-matching candidates, fall back to buffer creation. - (unless (plist-get (cdr selected) :match) - (consult--buffer-action (car selected))))) - -(defmacro consult--with-project (&rest body) - "Ensure that BODY is executed with a project root." - ;; We have to work quite hard here to ensure that the project root is - ;; only overridden at the current recursion level. When entering a - ;; recursive minibuffer session, we should be able to still switch the - ;; project. But who does that? Working on the first level on project A - ;; and on the second level on project B and on the third level on project C? - ;; You mustn't be afraid to dream a little bigger, darling. - `(let ((consult-project-function - (let ((root (or (consult--project-root t) (user-error "No project found"))) - (depth (recursion-depth)) - (orig consult-project-function)) - (lambda (may-prompt) - (if (= depth (recursion-depth)) - root - (funcall orig may-prompt)))))) - ,@body)) - -;;;###autoload -(defun consult-project-buffer () - "Enhanced `project-switch-to-buffer' command with support for virtual buffers. -The command may prompt you for a project directory if it is invoked from -outside a project. See `consult-buffer' for more details." - (interactive) - (consult--with-project - (consult-buffer consult-project-buffer-sources))) - -;;;###autoload -(defun consult-buffer-other-window () - "Variant of `consult-buffer', switching to a buffer in another window." - (interactive) - (let ((consult--buffer-display #'switch-to-buffer-other-window)) - (consult-buffer))) - -;;;###autoload -(defun consult-buffer-other-frame () - "Variant of `consult-buffer', switching to a buffer in another frame." - (interactive) - (let ((consult--buffer-display #'switch-to-buffer-other-frame)) - (consult-buffer))) - -;;;###autoload -(defun consult-buffer-other-tab () - "Variant of `consult-buffer', switching to a buffer in another tab." - (interactive) - (let ((consult--buffer-display #'switch-to-buffer-other-tab)) - (consult-buffer))) - -;;;;; Command: consult-grep - -(defun consult--grep-format (async builder) - "Return ASYNC function highlighting grep match results. -BUILDER is the command line builder function." - (let (highlight) - (lambda (action) - (cond - ((stringp action) - (setq highlight (cdr (funcall builder action))) - (funcall async action)) - ((consp action) - (let ((file "") (file-len 0) result) - (save-match-data - (dolist (str action) - (when (and (string-match consult--grep-match-regexp str) - ;; Filter out empty context lines - (or (/= (aref str (match-beginning 3)) ?-) - (/= (match-end 0) (length str)))) - ;; We share the file name across candidates to reduce - ;; the amount of allocated memory. - (unless (and (= file-len (- (match-end 1) (match-beginning 1))) - (eq t (compare-strings - file 0 file-len - str (match-beginning 1) (match-end 1) nil))) - (setq file (match-string 1 str) - file-len (length file))) - (let* ((line (match-string 2 str)) - (ctx (= (aref str (match-beginning 3)) ?-)) - (sep (if ctx "-" ":")) - (content (substring str (match-end 0))) - (line-len (length line))) - (when (and consult-grep-max-columns - (length> content consult-grep-max-columns)) - (setq content (substring content 0 consult-grep-max-columns))) - (when highlight - (funcall highlight content)) - (setq str (concat file sep line sep content)) - ;; Store file name in order to avoid allocations in `consult--prefix-group' - (add-text-properties 0 file-len `(face consult-file consult--prefix-group ,file) str) - (put-text-property (1+ file-len) (+ 1 file-len line-len) 'face 'consult-line-number str) - (when ctx - (add-face-text-property (+ 2 file-len line-len) (length str) 'consult-grep-context 'append str)) - (push str result))))) - (funcall async (nreverse result)))) - (t (funcall async action)))))) - -(defun consult--grep-position (cand &optional find-file) - "Return the grep position marker for CAND. -FIND-FILE is the file open function, defaulting to `find-file-noselect'." - (when cand - (let* ((file-end (next-single-property-change 0 'face cand)) - (line-end (next-single-property-change (1+ file-end) 'face cand)) - (matches (consult--point-placement cand (1+ line-end) 'consult-grep-context)) - (file (substring-no-properties cand 0 file-end)) - (line (string-to-number (substring-no-properties cand (+ 1 file-end) line-end)))) - (when-let (pos (consult--marker-from-line-column - (funcall (or find-file #'consult--file-action) file) - line (or (car matches) 0))) - (cons pos (cdr matches)))))) - -(defun consult--grep-state () - "Grep state function." - (let ((open (consult--temporary-files)) - (jump (consult--jump-state))) - (lambda (action cand) - (unless cand - (funcall open)) - (funcall jump action (consult--grep-position - cand - (and (not (eq action 'return)) open)))))) - -(defun consult--grep-exclude-args () - "Produce grep exclude arguments. -Take the variables `grep-find-ignored-directories' and -`grep-find-ignored-files' into account." - (unless (boundp 'grep-find-ignored-files) (require 'grep)) - (nconc (mapcar (lambda (s) (concat "--exclude=" s)) - (bound-and-true-p grep-find-ignored-files)) - (mapcar (lambda (s) (concat "--exclude-dir=" s)) - (bound-and-true-p grep-find-ignored-directories)))) - -(defun consult--grep (prompt make-builder dir initial) - "Run asynchronous grep. - -MAKE-BUILDER is the function that returns the command line -builder function. DIR is a directory or a list of file or -directories. PROMPT is the prompt string. INITIAL is initial -input." - (pcase-let* ((`(,prompt ,paths ,dir) (consult--directory-prompt prompt dir)) - (default-directory dir) - (builder (funcall make-builder paths))) - (consult--read - (consult--async-command builder - (consult--grep-format builder) - :file-handler t) ;; allow tramp - :prompt prompt - :lookup #'consult--lookup-member - :state (consult--grep-state) - :initial (consult--async-split-initial initial) - :add-history (consult--async-split-thingatpt 'symbol) - :require-match t - :category 'consult-grep - :group #'consult--prefix-group - :history '(:input consult--grep-history) - :sort nil))) - -(defun consult--grep-lookahead-p (&rest cmd) - "Return t if grep CMD supports look-ahead." - (eq 0 (process-file-shell-command - (concat "echo xaxbx | " - (mapconcat #'shell-quote-argument `(,@cmd "^(?=.*b)(?=.*a)") " "))))) - -(defun consult--grep-make-builder (paths) - "Build grep command line and grep across PATHS." - (let* ((cmd (consult--build-args consult-grep-args)) - (type (if (consult--grep-lookahead-p (car cmd) "-P") 'pcre 'extended))) - (lambda (input) - (pcase-let* ((`(,arg . ,opts) (consult--command-split input)) - (flags (append cmd opts)) - (ignore-case (or (member "-i" flags) (member "--ignore-case" flags)))) - (if (or (member "-F" flags) (member "--fixed-strings" flags)) - (cons (append cmd (list "-e" arg) opts paths) - (apply-partially #'consult--highlight-regexps - (list (regexp-quote arg)) ignore-case)) - (pcase-let ((`(,re . ,hl) (funcall consult--regexp-compiler arg type ignore-case))) - (when re - (cons (append cmd - (list (if (eq type 'pcre) "-P" "-E") ;; perl or extended - "-e" (consult--join-regexps re type)) - opts paths) - hl)))))))) - -;;;###autoload -(defun consult-grep (&optional dir initial) - "Search with `grep' for files in DIR where the content matches a regexp. - -The initial input is given by the INITIAL argument. DIR can be nil, a -directory string or a list of file/directory paths. If `consult-grep' -is called interactively with a prefix argument, the user can specify the -directories or files to search in. Multiple directories or files must -be separated by comma in the minibuffer, since they are read via -`completing-read-multiple'. By default the project directory is used if -`consult-project-function' is defined and returns non-nil. Otherwise -the `default-directory' is searched. If the command is invoked with a -double prefix argument (twice `C-u') the user is asked for a project, if -not yet inside a project, or the current project is searched. - -The input string is split, the first part of the string (grep input) is -passed to the asynchronous grep process and the second part of the -string is passed to the completion-style filtering. - -The input string is split at a punctuation character, which is given as -the first character of the input string. The format is similar to -Perl-style regular expressions, e.g., /regexp/. Furthermore command -line options can be passed to grep, specified behind --. The overall -prompt input has the form `#async-input -- grep-opts#filter-string'. - -Note that the grep input string is transformed from Emacs regular -expressions to Posix regular expressions. Always enter Emacs regular -expressions at the prompt. `consult-grep' behaves like builtin Emacs -search commands, e.g., Isearch, which take Emacs regular expressions. -Furthermore the asynchronous input split into words, each word must -match separately and in any order. See `consult--regexp-compiler' for -the inner workings. In order to disable transformations of the grep -input, adjust `consult--regexp-compiler' accordingly. - -Here we give a few example inputs: - -#alpha beta : Search for alpha and beta in any order. -#alpha.*beta : Search for alpha before beta. -#\\(alpha\\|beta\\) : Search for alpha or beta (Note Emacs syntax!) -#word -- -C3 : Search for word, include 3 lines as context -#first#second : Search for first, quick filter for second. - -The symbol at point is added to the future history." - (interactive "P") - (consult--grep "Grep" #'consult--grep-make-builder dir initial)) - -;;;;; Command: consult-git-grep - -(defun consult--git-grep-make-builder (paths) - "Create grep command line builder given PATHS." - (let ((cmd (consult--build-args consult-git-grep-args))) - (lambda (input) - (pcase-let* ((`(,arg . ,opts) (consult--command-split input)) - (flags (append cmd opts)) - (ignore-case (or (member "-i" flags) (member "--ignore-case" flags)))) - (if (or (member "-F" flags) (member "--fixed-strings" flags)) - (cons (append cmd (list "-e" arg) opts paths) - (apply-partially #'consult--highlight-regexps - (list (regexp-quote arg)) ignore-case)) - (pcase-let ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'extended ignore-case))) - (when re - (cons (append cmd - (cdr (mapcan (lambda (x) (list "--and" "-e" x)) re)) - opts paths) - hl)))))))) - -;;;###autoload -(defun consult-git-grep (&optional dir initial) - "Search with `git grep' for files in DIR with INITIAL input. -See `consult-grep' for details." - (interactive "P") - (consult--grep "Git-grep" #'consult--git-grep-make-builder dir initial)) - -;;;;; Command: consult-ripgrep - -(defun consult--ripgrep-make-builder (paths) - "Create ripgrep command line builder given PATHS." - (let* ((cmd (consult--build-args consult-ripgrep-args)) - (type (if (consult--grep-lookahead-p (car cmd) "-P") 'pcre 'extended))) - (lambda (input) - (pcase-let* ((`(,arg . ,opts) (consult--command-split input)) - (flags (append cmd opts)) - (ignore-case - (and (not (or (member "-s" flags) (member "--case-sensitive" flags))) - (or (member "-i" flags) (member "--ignore-case" flags) - (and (or (member "-S" flags) (member "--smart-case" flags)) - (let (case-fold-search) - ;; Case insensitive if there are no uppercase letters - (not (string-match-p "[[:upper:]]" arg)))))))) - (if (or (member "-F" flags) (member "--fixed-strings" flags)) - (cons (append cmd (list "-e" arg) opts paths) - (apply-partially #'consult--highlight-regexps - (list (regexp-quote arg)) ignore-case)) - (pcase-let ((`(,re . ,hl) (funcall consult--regexp-compiler arg type ignore-case))) - (when re - (cons (append cmd (and (eq type 'pcre) '("-P")) - (list "-e" (consult--join-regexps re type)) - opts paths) - hl)))))))) - -;;;###autoload -(defun consult-ripgrep (&optional dir initial) - "Search with `rg' for files in DIR with INITIAL input. -See `consult-grep' for details." - (interactive "P") - (consult--grep "Ripgrep" #'consult--ripgrep-make-builder dir initial)) - -;;;;; Command: consult-find - -(defun consult--find (prompt builder initial) - "Run find command in current directory. - -The function returns the selected file. -The filename at point is added to the future history. - -BUILDER is the command line builder function. -PROMPT is the prompt. -INITIAL is initial input." - (consult--read - (consult--async-command builder - (consult--async-map (lambda (x) (string-remove-prefix "./" x))) - (consult--async-highlight builder) - :file-handler t) ;; allow tramp - :prompt prompt - :sort nil - :require-match t - :initial (consult--async-split-initial initial) - :add-history (consult--async-split-thingatpt 'filename) - :category 'file - :history '(:input consult--find-history))) - -(defun consult--find-make-builder (paths) - "Build find command line, finding across PATHS." - (let* ((cmd (seq-mapcat (lambda (x) - (if (equal x ".") paths (list x))) - (consult--build-args consult-find-args))) - (type (if (eq 0 (process-file-shell-command - (concat (car cmd) " -regextype emacs -version"))) - 'emacs 'basic))) - (lambda (input) - (pcase-let* ((`(,arg . ,opts) (consult--command-split input)) - ;; ignore-case=t since -iregex is used below - (`(,re . ,hl) (funcall consult--regexp-compiler arg type t))) - (when re - (cons (append cmd - (cdr (mapcan - (lambda (x) - `("-and" "-iregex" - ,(format ".*%s.*" - ;; Replace non-capturing groups with capturing groups. - ;; GNU find does not support non-capturing groups. - (replace-regexp-in-string - "\\\\(\\?:" "\\(" x 'fixedcase 'literal)))) - re)) - opts) - hl)))))) - -;;;###autoload -(defun consult-find (&optional dir initial) - "Search for files with `find' in DIR. -The file names must match the input regexp. INITIAL is the -initial minibuffer input. See `consult-grep' for details -regarding the asynchronous search and the arguments." - (interactive "P") - (pcase-let* ((`(,prompt ,paths ,dir) (consult--directory-prompt "Find" dir)) - (default-directory dir) - (builder (consult--find-make-builder paths))) - (find-file (consult--find prompt builder initial)))) - -;;;;; Command: consult-fd - -(defun consult--fd-make-builder (paths) - "Build find command line, finding across PATHS." - (let ((cmd (consult--build-args consult-fd-args))) - (lambda (input) - (pcase-let* ((`(,arg . ,opts) (consult--command-split input)) - (flags (append cmd opts)) - (ignore-case - (and (not (or (member "-s" flags) (member "--case-sensitive" flags))) - (or (member "-i" flags) (member "--ignore-case" flags) - (let (case-fold-search) - ;; Case insensitive if there are no uppercase letters - (not (string-match-p "[[:upper:]]" arg))))))) - (if (or (member "-F" flags) (member "--fixed-strings" flags)) - (cons (append cmd (list arg) opts paths) - (apply-partially #'consult--highlight-regexps - (list (regexp-quote arg)) ignore-case)) - (pcase-let ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'pcre ignore-case))) - (when re - (cons (append cmd - (mapcan (lambda (x) `("--and" ,x)) re) - opts - (mapcan (lambda (x) `("--search-path" ,x)) paths)) - hl)))))))) - -;;;###autoload -(defun consult-fd (&optional dir initial) - "Search for files with `fd' in DIR. -The file names must match the input regexp. INITIAL is the -initial minibuffer input. See `consult-grep' for details -regarding the asynchronous search and the arguments." - (interactive "P") - (pcase-let* ((`(,prompt ,paths ,dir) (consult--directory-prompt "Fd" dir)) - (default-directory dir) - (builder (consult--fd-make-builder paths))) - (find-file (consult--find prompt builder initial)))) - -;;;;; Command: consult-locate - -(defun consult--locate-builder (input) - "Build command line from INPUT." - (pcase-let ((`(,arg . ,opts) (consult--command-split input))) - (unless (string-blank-p arg) - (cons (append (consult--build-args consult-locate-args) - (consult--split-escaped arg) opts) - (cdr (consult--default-regexp-compiler input 'basic t)))))) - -;;;###autoload -(defun consult-locate (&optional initial) - "Search with `locate' for files which match input given INITIAL input. - -The input is treated literally such that locate can take advantage of -the locate database index. Regular expressions would often force a slow -linear search through the entire database. The locate process is started -asynchronously, similar to `consult-grep'. See `consult-grep' for more -details regarding the asynchronous search." - (interactive) - (find-file (consult--find "Locate: " #'consult--locate-builder initial))) - -;;;;; Command: consult-man - -(defun consult--man-builder (input) - "Build command line from INPUT." - (pcase-let* ((`(,arg . ,opts) (consult--command-split input)) - (`(,re . ,hl) (funcall consult--regexp-compiler arg 'extended t))) - (when re - (cons (append (consult--build-args consult-man-args) - (list (consult--join-regexps re 'extended)) - opts) - hl)))) - -(defun consult--man-format (lines) - "Format man candidates from LINES." - (let ((candidates)) - (save-match-data - (dolist (str lines) - (when (string-match "\\`\\(.*?\\([^ ]+\\) *(\\([^,)]+\\)[^)]*).*?\\) +- +\\(.*\\)\\'" str) - (let* ((names (match-string 1 str)) - (name (match-string 2 str)) - (section (match-string 3 str)) - (desc (match-string 4 str)) - (cand (format "%s - %s" names desc))) - (add-text-properties 0 (length names) - (list 'face 'consult-file - 'consult-man (concat section " " name)) - cand) - (push cand candidates))))) - (nreverse candidates))) - -;;;###autoload -(defun consult-man (&optional initial) - "Search for man page given INITIAL input. - -The input string is not preprocessed and passed literally to the -underlying man commands. The man process is started asynchronously, -similar to `consult-grep'. See `consult-grep' for more details regarding -the asynchronous search." - (interactive) - (man (consult--read - (consult--async-command #'consult--man-builder - (consult--async-transform consult--man-format) - (consult--async-highlight #'consult--man-builder)) - :prompt "Manual entry: " - :require-match t - :category 'consult-man - :lookup (apply-partially #'consult--lookup-prop 'consult-man) - :initial (consult--async-split-initial initial) - :add-history (consult--async-split-thingatpt 'symbol) - :history '(:input consult--man-history)))) - -;;;; Preview at point in completions buffers - -(define-minor-mode consult-preview-at-point-mode - "Preview minor mode for *Completions* buffers. -When moving around in the *Completions* buffer, the candidate at point is -automatically previewed." - :group 'consult - (if consult-preview-at-point-mode - (add-hook 'post-command-hook #'consult-preview-at-point nil 'local) - (remove-hook 'post-command-hook #'consult-preview-at-point 'local))) - -(defun consult-preview-at-point () - "Preview candidate at point in *Completions* buffer." - (interactive) - (when-let ((win (active-minibuffer-window)) - (buf (window-buffer win)) - (fun (buffer-local-value 'consult--preview-function buf))) - (funcall fun))) - -;;;; Integration with completion systems - -;;;;; Integration: Default *Completions* - -(defun consult--default-completion-minibuffer-candidate () - "Return current minibuffer candidate from default completion system or Icomplete." - (when (and (minibufferp) - (eq completing-read-function #'completing-read-default)) - (let ((content (minibuffer-contents-no-properties))) - ;; When the current minibuffer content matches a candidate, return it! - (if (test-completion content - minibuffer-completion-table - minibuffer-completion-predicate) - content - ;; Return the full first candidate of the sorted completion list. - (when-let ((completions (completion-all-sorted-completions))) - (concat - (substring content 0 (or (cdr (last completions)) 0)) - (car completions))))))) - -(defun consult--default-completion-list-candidate () - "Return current candidate at point from completions buffer." - (let (beg) - (when (and - (derived-mode-p 'completion-list-mode) - ;; Logic taken from `choose-completion'. - ;; TODO Upstream a `completion-list-get-candidate' function. - (cond - ((and (not (eobp)) (get-text-property (point) 'completion--string)) - (setq beg (1+ (point)))) - ((and (not (bobp)) (get-text-property (1- (point)) 'completion--string)) - (setq beg (point))))) - (get-text-property (previous-single-property-change beg 'completion--string) - 'completion--string)))) - -;;;;; Integration: Vertico - -(defvar vertico--input) -(declare-function vertico--exhibit "ext:vertico") -(declare-function vertico--candidate "ext:vertico") -(declare-function vertico--filter-completions "ext:vertico") - -(defun consult--vertico-candidate () - "Return current candidate for Consult preview." - (and vertico--input (vertico--candidate 'highlight))) - -(defun consult--vertico-refresh () - "Refresh completion UI." - (when vertico--input - (setq vertico--input t) - (vertico--exhibit))) - -(defun consult--vertico-filter-adv (orig pattern cands category highlight) - "Advice for ORIG `consult--completion-filter' function. -See `consult--completion-filter' for arguments PATTERN, CANDS, CATEGORY -and HIGHLIGHT." - (if (and (not highlight) (bound-and-true-p vertico-mode)) - ;; Optimize `consult--completion-filter' using the deferred highlighting - ;; from Vertico. The advice is not necessary - it is a pure optimization. - (nconc (car (vertico--filter-completions pattern cands nil (length pattern) - `(metadata (category . ,category)))) - nil) - (funcall orig pattern cands category highlight))) - -(with-eval-after-load 'vertico - (advice-add #'consult--completion-filter :around #'consult--vertico-filter-adv) - (add-hook 'consult--completion-candidate-hook #'consult--vertico-candidate) - (add-hook 'consult--completion-refresh-hook #'consult--vertico-refresh) - (define-key consult-async-map [remap vertico-insert] 'vertico-next-group)) - -;;;;; Integration: Mct - -(with-eval-after-load 'mct (add-hook 'consult--completion-refresh-hook - 'mct--live-completions-refresh)) - -;;;;; Integration: Icomplete - -(defvar icomplete-mode) -(declare-function icomplete-exhibit "icomplete") - -(defun consult--icomplete-refresh () - "Refresh icomplete view." - (when icomplete-mode - (let ((top (car completion-all-sorted-completions))) - (completion--flush-all-sorted-completions) - ;; force flushing, otherwise narrowing is broken! - (setq completion-all-sorted-completions nil) - (when top - (let* ((completions (completion-all-sorted-completions)) - (last (last completions)) - (before)) ;; completions before top - ;; warning: completions is an improper list - (while (consp completions) - (if (equal (car completions) top) - (progn - (setcdr last (append (nreverse before) (cdr last))) - (setq completion-all-sorted-completions completions - completions nil)) - (push (car completions) before) - (setq completions (cdr completions))))))) - (icomplete-exhibit))) - -(with-eval-after-load 'icomplete - (add-hook 'consult--completion-refresh-hook #'consult--icomplete-refresh)) - -(provide 'consult) -;;; consult.el ends here diff --git a/emacs/elpa/consult-20241115.517/consult.elc b/emacs/elpa/consult-20241115.517/consult.elc Binary files differ. diff --git a/emacs/elpa/consult-20241115.517/consult-autoloads.el b/emacs/elpa/consult-20241117.2113/consult-autoloads.el diff --git a/emacs/elpa/consult-20241115.517/consult-compile.el b/emacs/elpa/consult-20241117.2113/consult-compile.el diff --git a/emacs/elpa/consult-20241115.517/consult-compile.elc b/emacs/elpa/consult-20241117.2113/consult-compile.elc Binary files differ. diff --git a/emacs/elpa/consult-20241115.517/consult-flymake.el b/emacs/elpa/consult-20241117.2113/consult-flymake.el diff --git a/emacs/elpa/consult-20241115.517/consult-flymake.elc b/emacs/elpa/consult-20241117.2113/consult-flymake.elc Binary files differ. diff --git a/emacs/elpa/consult-20241115.517/consult-imenu.el b/emacs/elpa/consult-20241117.2113/consult-imenu.el diff --git a/emacs/elpa/consult-20241115.517/consult-imenu.elc b/emacs/elpa/consult-20241117.2113/consult-imenu.elc Binary files differ. diff --git a/emacs/elpa/consult-20241115.517/consult-info.el b/emacs/elpa/consult-20241117.2113/consult-info.el diff --git a/emacs/elpa/consult-20241115.517/consult-info.elc b/emacs/elpa/consult-20241117.2113/consult-info.elc Binary files differ. diff --git a/emacs/elpa/consult-20241115.517/consult-kmacro.el b/emacs/elpa/consult-20241117.2113/consult-kmacro.el diff --git a/emacs/elpa/consult-20241115.517/consult-kmacro.elc b/emacs/elpa/consult-20241117.2113/consult-kmacro.elc Binary files differ. diff --git a/emacs/elpa/consult-20241115.517/consult-org.el b/emacs/elpa/consult-20241117.2113/consult-org.el diff --git a/emacs/elpa/consult-20241115.517/consult-org.elc b/emacs/elpa/consult-20241117.2113/consult-org.elc Binary files differ. diff --git a/emacs/elpa/consult-20241117.2113/consult-pkg.el b/emacs/elpa/consult-20241117.2113/consult-pkg.el @@ -0,0 +1,10 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "consult" "20241117.2113" + "Consulting completing-read." + '((emacs "28.1") + (compat "30")) + :url "https://github.com/minad/consult" + :commit "917cdd86cce06d74235ba0084422341b860e1569" + :revdesc "917cdd86cce0" + :keywords '("matching" "files" "completion") + :maintainers '(("Daniel Mendler" . "mail@daniel-mendler.de"))) diff --git a/emacs/elpa/consult-20241115.517/consult-register.el b/emacs/elpa/consult-20241117.2113/consult-register.el diff --git a/emacs/elpa/consult-20241115.517/consult-register.elc b/emacs/elpa/consult-20241117.2113/consult-register.elc Binary files differ. diff --git a/emacs/elpa/consult-20241115.517/consult-xref.el b/emacs/elpa/consult-20241117.2113/consult-xref.el diff --git a/emacs/elpa/consult-20241115.517/consult-xref.elc b/emacs/elpa/consult-20241117.2113/consult-xref.elc Binary files differ. diff --git a/emacs/elpa/consult-20241117.2113/consult.el b/emacs/elpa/consult-20241117.2113/consult.el @@ -0,0 +1,5253 @@ +;;; consult.el --- Consulting completing-read -*- lexical-binding: t -*- + +;; Copyright (C) 2021-2024 Free Software Foundation, Inc. + +;; Author: Daniel Mendler and Consult contributors +;; Maintainer: Daniel Mendler <mail@daniel-mendler.de> +;; Created: 2020 +;; Package-Version: 20241117.2113 +;; Package-Revision: 917cdd86cce0 +;; Package-Requires: ((emacs "28.1") (compat "30")) +;; URL: https://github.com/minad/consult +;; Keywords: matching, files, completion + +;; This file is 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 this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Consult implements a set of `consult-<thing>' commands, which aim to +;; improve the way you use Emacs. The commands are founded on +;; `completing-read', which selects from a list of candidate strings. +;; Consult provides an enhanced buffer switcher `consult-buffer' and +;; search and navigation commands like `consult-imenu' and +;; `consult-line'. Searching through multiple files is supported by the +;; asynchronous `consult-grep' command. Many Consult commands support +;; previewing candidates. If a candidate is selected in the completion +;; view, the buffer shows the candidate immediately. + +;; The Consult commands are compatible with multiple completion systems +;; based on the Emacs `completing-read' API, including the default +;; completion system, Vertico, Mct and Icomplete. + +;; See the README for an overview of the available Consult commands and +;; the documentation of the configuration and installation of the +;; package. + +;; The full list of contributors can be found in the acknowledgments +;; section of the README. + +;;; Code: + +(eval-when-compile + (require 'cl-lib) + (require 'subr-x)) +(require 'compat) +(require 'bookmark) + +(defgroup consult nil + "Consulting `completing-read'." + :link '(info-link :tag "Info Manual" "(consult)") + :link '(url-link :tag "Website" "https://github.com/minad/consult") + :link '(url-link :tag "Wiki" "https://github.com/minad/consult/wiki") + :link '(emacs-library-link :tag "Library Source" "consult.el") + :group 'files + :group 'outlines + :group 'minibuffer + :prefix "consult-") + +;;;; Customization + +(defcustom consult-narrow-key nil + "Prefix key for narrowing during completion. + +Good choices for this key are \"<\" and \"C-+\" for example. The +key must be a string accepted by `key-valid-p'." + :type '(choice key (const :tag "None" nil))) + +(defcustom consult-widen-key nil + "Key used for widening during completion. + +If this key is unset, defaults to twice the `consult-narrow-key'. +The key must be a string accepted by `key-valid-p'." + :type '(choice key (const :tag "None" nil))) + +(defcustom consult-project-function + #'consult--default-project-function + "Function which returns project root directory. +The function takes one boolean argument MAY-PROMPT. If +MAY-PROMPT is non-nil, the function may ask the prompt the user +for a project directory. The root directory is used by +`consult-buffer' and `consult-grep'." + :type `(choice + (const :tag "Default project function" ,#'consult--default-project-function) + (function :tag "Custom function") + (const :tag "No project integration" nil))) + +(defcustom consult-async-refresh-delay 0.2 + "Refreshing delay of the completion UI for asynchronous commands. + +The completion UI is only updated every +`consult-async-refresh-delay' seconds. This applies to +asynchronous commands like for example `consult-grep'." + :type '(float :tag "Delay in seconds")) + +(defcustom consult-async-input-throttle 0.5 + "Input throttle for asynchronous commands. + +The asynchronous process is started only every +`consult-async-input-throttle' seconds. This applies to asynchronous +commands, e.g., `consult-grep'." + :type '(float :tag "Delay in seconds")) + +(defcustom consult-async-input-debounce 0.2 + "Input debounce for asynchronous commands. + +The asynchronous process is started only when there has not been new +input for `consult-async-input-debounce' seconds. This applies to +asynchronous commands, e.g., `consult-grep'." + :type '(float :tag "Delay in seconds")) + +(defcustom consult-async-min-input 3 + "Minimum number of characters needed, before asynchronous process is called. + +This applies to asynchronous commands, e.g., `consult-grep'." + :type '(natnum :tag "Number of characters")) + +(defcustom consult-async-split-style 'perl + "Async splitting style, see `consult-async-split-styles-alist'." + :type '(choice (const :tag "No splitting" nil) + (const :tag "Comma" comma) + (const :tag "Semicolon" semicolon) + (const :tag "Perl" perl))) + +(defcustom consult-async-split-styles-alist + `((nil :function ,#'consult--split-nil) + (comma :separator ?, :function ,#'consult--split-separator) + (semicolon :separator ?\; :function ,#'consult--split-separator) + (perl :initial "#" :function ,#'consult--split-perl)) + "Async splitting styles." + :type '(alist :key-type symbol :value-type plist)) + +(defcustom consult-mode-histories + '((eshell-mode eshell-history-ring eshell-history-index eshell-bol) + (comint-mode comint-input-ring comint-input-ring-index comint-bol) + (term-mode term-input-ring term-input-ring-index term-bol)) + "Alist of mode histories (mode history index bol). +The histories can be rings or lists. Index, if provided, is a +variable to set to the index of the selection within the ring or +list. Bol, if provided is a function which jumps to the beginning +of the line after the prompt." + :type '(alist :key-type symbol + :value-type (group :tag "Include Index" + (symbol :tag "List/Ring") + (symbol :tag "Index Variable") + (symbol :tag "Bol Function")))) + +(defcustom consult-themes nil + "List of themes (symbols or regexps) to be presented for selection. +nil shows all `custom-available-themes'." + :type '(repeat (choice symbol regexp))) + +(defcustom consult-after-jump-hook (list #'recenter) + "Function called after jumping to a location. + +Commonly used functions for this hook are `recenter' and +`reposition-window'. You may want to add a function which pulses the +current line, e.g., `pulse-momentary-highlight-one-line'. The hook +called during preview and for the jump after selection." + :type 'hook) + +(defcustom consult-line-start-from-top nil + "Start search from the top if non-nil. +Otherwise start the search at the current line and wrap around." + :type 'boolean) + +(defcustom consult-point-placement 'match-beginning + "Where to leave point when jumping to a match. +This setting affects the command `consult-line' and the `consult-grep' variants." + :type '(choice (const :tag "Beginning of the line" line-beginning) + (const :tag "Beginning of the match" match-beginning) + (const :tag "End of the match" match-end))) + +(defcustom consult-line-numbers-widen t + "Show absolute line numbers when narrowing is active. + +See also `display-line-numbers-widen'." + :type 'boolean) + +(defcustom consult-goto-line-numbers t + "Show line numbers for `consult-goto-line'." + :type 'boolean) + +(defcustom consult-fontify-preserve t + "Preserve fontification for line-based commands." + :type 'boolean) + +(defcustom consult-fontify-max-size 1048576 + "Buffers larger than this byte limit are not fontified. + +This is necessary in order to prevent a large startup time +for navigation commands like `consult-line'." + :type '(natnum :tag "Buffer size in bytes")) + +(defcustom consult-buffer-filter + '("\\` " + "\\`\\*Completions\\*\\'" + "\\`\\*Flymake log\\*\\'" + "\\`\\*Semantic SymRef\\*\\'" + "\\`\\*vc\\*\\'" + "\\`newsrc-dribble\\'" ;; Gnus + "\\`\\*tramp/.*\\*\\'") + "Filter regexps for `consult-buffer'. + +The default setting is to filter ephemeral buffer names beginning +with a space character, the *Completions* buffer and a few log +buffers. The regular expressions are matched case sensitively." + :type '(repeat regexp)) + +(defcustom consult-buffer-sources + '(consult--source-hidden-buffer + consult--source-modified-buffer + consult--source-buffer + consult--source-recent-file + consult--source-file-register + consult--source-bookmark + consult--source-project-buffer-hidden + consult--source-project-recent-file-hidden) + "Sources used by `consult-buffer'. +See also `consult-project-buffer-sources'. +See `consult--multi' for a description of the source data structure." + :type '(repeat symbol)) + +(defcustom consult-project-buffer-sources + '(consult--source-project-buffer + consult--source-project-recent-file) + "Sources used by `consult-project-buffer'. +See also `consult-buffer-sources'. +See `consult--multi' for a description of the source data structure." + :type '(repeat symbol)) + +(defcustom consult-mode-command-filter + '(;; Filter commands + "-mode\\'" "--" + ;; Filter whole features + simple mwheel time so-long recentf tab-bar tab-line) + "Filter commands for `consult-mode-command'." + :type '(repeat (choice symbol regexp))) + +(defcustom consult-grep-max-columns 300 + "Maximal number of columns of grep output. +If set to nil, do not truncate candidates. This can have negative +performance implications but helps if you want to export long lines via +`embark-export'." + :type '(choice natnum (const nil))) + +(defconst consult--grep-match-regexp + "\\`\\(?:\\./\\)?\\([^\n\0]+\\)\0\\([0-9]+\\)\\([-:\0]\\)" + "Regexp used to match file and line of grep output.") + +(defcustom consult-grep-args + '("grep" (consult--grep-exclude-args) + "--null --line-buffered --color=never --ignore-case\ + --with-filename --line-number -I -r") + "Command line arguments for grep, see `consult-grep'. +The dynamically computed arguments are appended. +Can be either a string, or a list of strings or expressions." + :type '(choice string (repeat (choice string sexp)))) + +(defcustom consult-git-grep-args + "git --no-pager grep --null --color=never --ignore-case\ + --extended-regexp --line-number -I" + "Command line arguments for git-grep, see `consult-git-grep'. +The dynamically computed arguments are appended. +Can be either a string, or a list of strings or expressions." + :type '(choice string (repeat (choice string sexp)))) + +(defcustom consult-ripgrep-args + "rg --null --line-buffered --color=never --max-columns=1000 --path-separator /\ + --smart-case --no-heading --with-filename --line-number --search-zip" + "Command line arguments for ripgrep, see `consult-ripgrep'. +The dynamically computed arguments are appended. +Can be either a string, or a list of strings or expressions." + :type '(choice string (repeat (choice string sexp)))) + +(defcustom consult-find-args + "find . -not ( -path */.[A-Za-z]* -prune )" + "Command line arguments for find, see `consult-find'. +The dynamically computed arguments are appended. +Can be either a string, or a list of strings or expressions." + :type '(choice string (repeat (choice string sexp)))) + +(defcustom consult-fd-args + '((if (executable-find "fdfind" 'remote) "fdfind" "fd") + "--full-path --color=never") + "Command line arguments for fd, see `consult-fd'. +The dynamically computed arguments are appended. +Can be either a string, or a list of strings or expressions." + :type '(choice string (repeat (choice string sexp)))) + +(defcustom consult-locate-args + "locate --ignore-case" ;; --existing not supported by Debian plocate + "Command line arguments for locate, see `consult-locate'. +The dynamically computed arguments are appended. +Can be either a string, or a list of strings or expressions." + :type '(choice string (repeat (choice string sexp)))) + +(defcustom consult-man-args + "man -k" + "Command line arguments for man, see `consult-man'. +The dynamically computed arguments are appended. +Can be either a string, or a list of strings or expressions." + :type '(choice string (repeat (choice string sexp)))) + +(defcustom consult-preview-key 'any + "Preview trigger keys, can be nil, `any', a single key or a list of keys. +Debouncing can be specified via the `:debounce' attribute. The +individual keys must be strings accepted by `key-valid-p'." + :type '(choice (const :tag "Any key" any) + (list :tag "Debounced" + (const :debounce) + (float :tag "Seconds" 0.1) + (const any)) + (const :tag "No preview" nil) + (key :tag "Key") + (repeat :tag "List of keys" key))) + +(defcustom consult-preview-partial-size 1048576 + "Files larger than this byte limit are previewed partially." + :type '(natnum :tag "File size in bytes")) + +(defcustom consult-preview-partial-chunk 102400 + "Partial preview chunk size in bytes. +If a file is larger than `consult-preview-partial-size' only the +chunk from the beginning of the file is previewed." + :type '(natnum :tag "Chunk size in bytes")) + +(defcustom consult-preview-max-count 10 + "Number of file buffers to keep open temporarily during preview." + :type '(natnum :tag "Number of buffers")) + +(defcustom consult-preview-excluded-buffers nil + "Buffers excluded from preview. +The value should conform to the predicate format demanded by the +function `buffer-match-p'." + :type 'sexp) + +(defcustom consult-preview-excluded-files + '("\\`/[^/|:]+:") ;; Do not preview remote files + "List of regexps matched against names of files, which are not previewed." + :type '(repeat regexp)) + +(defcustom consult-preview-allowed-hooks + '(global-font-lock-mode + save-place-find-file-hook) + "List of hooks, which should be executed during file preview. +This variable applies to `find-file-hook', `change-major-mode-hook' and +mode hooks, e.g., `prog-mode-hook'." + :type '(repeat symbol)) + +(defcustom consult-preview-variables + '((inhibit-message . t) + (enable-dir-local-variables . nil) + (enable-local-variables . :safe) + (non-essential . t) + (delay-mode-hooks . t)) + "Variables which are bound for file preview." + :type '(alist :key-type symbol)) + +(defcustom consult-bookmark-narrow + `((?f "File" bookmark-default-handler) + (?h "Help" help-bookmark-jump Info-bookmark-jump + Man-bookmark-jump woman-bookmark-jump) + (?p "Picture" image-bookmark-jump) + (?d "Docview" doc-view-bookmark-jump) + (?m "Mail" gnus-summary-bookmark-jump) + (?s "Eshell" eshell-bookmark-jump) + (?w "Web" eww-bookmark-jump xwidget-webkit-bookmark-jump-handler) + (?v "VC Directory" vc-dir-bookmark-jump) + (nil "Other")) + "Bookmark narrowing configuration. + +Each element of the list must have the form (char name handlers...)." + :type '(alist :key-type character :value-type (cons string (repeat function)))) + +(define-obsolete-variable-alias + 'consult-yank-rotate 'yank-from-kill-ring-rotate "1.8") + +;;;; Faces + +(defgroup consult-faces nil + "Faces used by Consult." + :group 'consult + :group 'faces) + +(defface consult-preview-line + '((t :inherit consult-preview-insertion :extend t)) + "Face used for line previews.") + +(defface consult-highlight-match + '((t :inherit match)) + "Face used to highlight matches in the completion candidates. +Used for example by `consult-grep'.") + +(defface consult-highlight-mark + '((t :inherit consult-highlight-match)) + "Face used for mark positions in completion candidates. +Used for example by `consult-mark'. The face should be different +than the `cursor' face to avoid confusion.") + +(defface consult-preview-match + '((t :inherit isearch)) + "Face used for match previews, e.g., in `consult-line'.") + +(defface consult-preview-insertion + '((t :inherit region)) + "Face used for previews of text to be inserted. +Used by `consult-completion-in-region', `consult-yank' and `consult-history'.") + +(defface consult-narrow-indicator + '((t :inherit warning)) + "Face used for the narrowing indicator.") + +(defface consult-async-running + '((t :inherit consult-narrow-indicator)) + "Face used if asynchronous process is running.") + +(defface consult-async-finished + '((t :inherit success)) + "Face used if asynchronous process has finished.") + +(defface consult-async-failed + '((t :inherit error)) + "Face used if asynchronous process has failed.") + +(defface consult-async-split + '((t :inherit font-lock-negation-char-face)) + "Face used to highlight punctuation character.") + +(defface consult-help + '((t :inherit shadow)) + "Face used to highlight help, e.g., in `consult-register-store'.") + +(defface consult-key + '((t :inherit font-lock-keyword-face)) + "Face used to highlight keys, e.g., in `consult-register'.") + +(defface consult-line-number + '((t :inherit consult-key)) + "Face used to highlight location line in `consult-global-mark'.") + +(defface consult-file + '((t :inherit font-lock-function-name-face)) + "Face used to highlight files in `consult-buffer'.") + +(defface consult-grep-context + '((t :inherit shadow)) + "Face used to highlight grep context in `consult-grep'.") + +(defface consult-bookmark + '((t :inherit font-lock-constant-face)) + "Face used to highlight bookmarks in `consult-buffer'.") + +(defface consult-buffer + '((t)) + "Face used to highlight buffers in `consult-buffer'.") + +(defface consult-line-number-prefix + '((t :inherit line-number)) + "Face used to highlight line number prefixes.") + +(defface consult-line-number-wrapped + '((t :inherit consult-line-number-prefix :inherit font-lock-warning-face)) + "Face used to highlight line number prefixes after wrap around.") + +(defface consult-separator + '((((class color) (min-colors 88) (background light)) + :foreground "#ccc") + (((class color) (min-colors 88) (background dark)) + :foreground "#333")) + "Face used for thin line separators in `consult-register-window'.") + +;;;; Input history variables + +(defvar consult--path-history nil) +(defvar consult--grep-history nil) +(defvar consult--find-history nil) +(defvar consult--man-history nil) +(defvar consult--line-history nil) +(defvar consult--line-multi-history nil) +(defvar consult--theme-history nil) +(defvar consult--minor-mode-menu-history nil) +(defvar consult--buffer-history nil) + +;;;; Internal variables + +(defvar consult--regexp-compiler + #'consult--default-regexp-compiler + "Regular expression compiler used by `consult-grep' and other commands. +The function must return a list of regular expressions and a highlighter +function.") + +(defvar consult--customize-alist + ;; Disable preview in frames, since `consult--jump-preview' does not properly + ;; clean up. See gh:minad/consult#593. This issue should better be fixed in + ;; `consult--jump-preview'. + `((,#'consult-buffer-other-frame :preview-key nil) + (,#'consult-buffer-other-tab :preview-key nil)) + "Command configuration alist for fine-grained configuration. + +Each element of the list must have the form (command-name plist...). The +options set here will be evaluated and passed to `consult--read', when +called from the corresponding command. Note that the options depend on +the private `consult--read' API and should not be considered as stable +as the public API.") + +(defvar consult--buffer-display #'switch-to-buffer + "Buffer display function.") + +(defvar consult--completion-candidate-hook + (list #'consult--default-completion-minibuffer-candidate + #'consult--default-completion-list-candidate) + "Get candidate from completion system.") + +(defvar consult--completion-refresh-hook nil + "Refresh completion system.") + +(defvar-local consult--preview-function nil + "Minibuffer-local variable which exposes the current preview function. +This function can be called by custom completion systems from +outside the minibuffer.") + +(defvar consult--annotate-align-step 10 + "Round candidate width.") + +(defvar consult--annotate-align-width 0 + "Maximum candidate width used for annotation alignment.") + +(defconst consult--tofu-char #x200000 + "Special character used to encode line prefixes for disambiguation. +We use invalid characters outside the Unicode range.") + +(defconst consult--tofu-range #x100000 + "Special character range.") + +(defvar-local consult--narrow nil + "Current narrowing key.") + +(defvar-local consult--narrow-keys nil + "Narrowing prefixes of the current completion.") + +(defvar-local consult--narrow-predicate nil + "Narrowing predicate of the current completion.") + +(defvar-local consult--narrow-overlay nil + "Narrowing indicator overlay.") + +(defvar consult--gc-threshold (* 64 1024 1024) + "Large GC threshold for temporary increase.") + +(defvar consult--gc-percentage 0.5 + "Large GC percentage for temporary increase.") + +(defvar consult--process-chunk (* 1024 1024) + "Increase process output chunk size.") + +(defvar consult--async-log + " *consult-async*" + "Buffer for async logging output used by `consult--async-process'.") + +(defvar-local consult--focus-lines-overlays nil + "Overlays used by `consult-focus-lines'.") + +(defvar-local consult--org-fold-regions nil + "Stored regions for the org-fold API.") + +;;;; Miscellaneous helper functions + +(defun consult--key-parse (key) + "Parse KEY or signal error if invalid." + (unless (key-valid-p key) + (error "%S is not a valid key definition; see `key-valid-p'" key)) + (key-parse key)) + +(defun consult--in-buffer (fun &optional buffer) + "Ensure that FUN is executed inside BUFFER." + (unless buffer (setq buffer (current-buffer))) + (lambda (&rest args) + (with-current-buffer buffer + (apply fun args)))) + +(defun consult--completion-table-in-buffer (table &optional buffer) + "Ensure that completion TABLE is executed inside BUFFER." + (if (functionp table) + (consult--in-buffer + (lambda (str pred action) + (let ((result (funcall table str pred action))) + (pcase action + ('metadata + (setq result + (mapcar + (lambda (x) + (if (and (string-suffix-p "-function" (symbol-name (car-safe x))) (cdr x)) + (cons (car x) (consult--in-buffer (cdr x))) + x)) + result))) + ((and 'completion--unquote (guard (functionp (cadr result)))) + (cl-callf consult--in-buffer (cadr result) buffer) + (cl-callf consult--in-buffer (cadddr result) buffer))) + result)) + buffer) + table)) + +(defun consult--build-args (arg) + "Return ARG as a flat list of split strings. + +Turn ARG into a list, and for each element either: +- split it if it a string. +- eval it if it is an expression." + (seq-mapcat (lambda (x) + (if (stringp x) + (split-string-and-unquote x) + (ensure-list (eval x 'lexical)))) + (ensure-list arg))) + +(defun consult--command-split (str) + "Return command argument and options list given input STR." + (save-match-data + (let ((opts (when (string-match " +--\\( +\\|\\'\\)" str) + (prog1 (substring str (match-end 0)) + (setq str (substring str 0 (match-beginning 0))))))) + ;; split-string-and-unquote fails if the quotes are invalid. Ignore it. + (cons str (and opts (ignore-errors (split-string-and-unquote opts))))))) + +(defmacro consult--keep! (list form) + "Evaluate FORM for every element of LIST and keep the non-nil results." + (declare (indent 1)) + (cl-with-gensyms (head prev result) + `(let* ((,head (cons nil ,list)) + (,prev ,head)) + (while (cdr ,prev) + (if-let (,result (let ((it (cadr ,prev))) ,form)) + (progn + (pop ,prev) + (setcar ,prev ,result)) + (setcdr ,prev (cddr ,prev)))) + (setq ,list (cdr ,head)) + nil))) + +(defun consult--completion-filter (pattern cands category _highlight) + "Filter CANDS with PATTERN. + +CATEGORY is the completion category, used to find the completion style via +`completion-category-defaults' and `completion-category-overrides'. +HIGHLIGHT must be non-nil if the resulting strings should be highlighted." + ;; Ensure that the global completion style settings are used for + ;; `consult-line', `consult-focus-lines' and `consult-keep-lines' filtering. + ;; This override is necessary since users may want to override the settings + ;; buffer-locally for in-buffer completion via Corfu. + (let ((completion-styles (default-value 'completion-styles)) + (completion-category-defaults (default-value 'completion-category-defaults)) + (completion-category-overrides (default-value 'completion-category-overrides))) + ;; `completion-all-completions' returns an improper list where the last link + ;; is not necessarily nil. + (nconc (completion-all-completions pattern cands nil (length pattern) + `(metadata (category . ,category))) + nil))) + +(defun consult--completion-filter-complement (pattern cands category _highlight) + "Filter CANDS with complement of PATTERN. +See `consult--completion-filter' for the arguments CATEGORY and HIGHLIGHT." + (let ((ht (consult--string-hash (consult--completion-filter pattern cands category nil)))) + (seq-remove (lambda (x) (gethash x ht)) cands))) + +(defun consult--completion-filter-dispatch (pattern cands category highlight) + "Filter CANDS with PATTERN with optional complement. +Either using `consult--completion-filter' or +`consult--completion-filter-complement', depending on if the pattern starts +with a bang. See `consult--completion-filter' for the arguments CATEGORY and +HIGHLIGHT." + (cond + ((string-match-p "\\`!? ?\\'" pattern) cands) ;; empty pattern + ((string-prefix-p "! " pattern) (consult--completion-filter-complement + (substring pattern 2) cands category nil)) + (t (consult--completion-filter pattern cands category highlight)))) + +(defmacro consult--each-line (beg end &rest body) + "Iterate over each line. + +The line beginning/ending BEG/END is bound in BODY." + (declare (indent 2)) + (cl-with-gensyms (max) + `(save-excursion + (let ((,beg (point-min)) (,max (point-max)) ,end) + (while (< ,beg ,max) + (goto-char ,beg) + (setq ,end (pos-eol)) + ,@body + (setq ,beg (1+ ,end))))))) + +(defun consult--display-width (string) + "Compute width of STRING taking display and invisible properties into account." + (let ((pos 0) (width 0) (end (length string))) + (while (< pos end) + (let ((nextd (next-single-property-change pos 'display string end)) + (display (get-text-property pos 'display string))) + (if (stringp display) + (setq width (+ width (string-width display)) + pos nextd) + (while (< pos nextd) + (let ((nexti (next-single-property-change pos 'invisible string nextd))) + (unless (get-text-property pos 'invisible string) + (setq width (+ width (string-width string pos nexti)))) + (setq pos nexti)))))) + width)) + +(defun consult--string-hash (strings) + "Create hash table from STRINGS." + (let ((ht (make-hash-table :test #'equal :size (length strings)))) + (dolist (str strings) + (puthash str t ht)) + ht)) + +(defmacro consult--local-let (binds &rest body) + "Buffer local let BINDS of dynamic variables in BODY." + (declare (indent 1)) + (let ((buffer (gensym "buffer")) + (local (mapcar (lambda (x) (cons (gensym "local") (car x))) binds))) + `(let ((,buffer (current-buffer)) + ,@(mapcar (lambda (x) `(,(car x) (local-variable-p ',(cdr x)))) local)) + (unwind-protect + (progn + ,@(mapcar (lambda (x) `(make-local-variable ',(car x))) binds) + (let (,@binds) + ,@body)) + (when (buffer-live-p ,buffer) + (with-current-buffer ,buffer + ,@(mapcar (lambda (x) + `(unless ,(car x) + (kill-local-variable ',(cdr x)))) + local))))))) + +(defvar consult--fast-abbreviate-file-name nil) +(defun consult--fast-abbreviate-file-name (name) + "Return abbreviate file NAME. +This function is a pure variant of `abbreviate-file-name', which +does not access the file system. This is important if we require +that the operation is fast, even for remote paths or paths on +network file systems." + (save-match-data + (let (case-fold-search) ;; Assume that file system is case sensitive. + (setq name (directory-abbrev-apply name)) + (if (string-match (with-memoization consult--fast-abbreviate-file-name + (directory-abbrev-make-regexp (expand-file-name "~"))) + name) + (concat "~" (substring name (match-beginning 1))) + name)))) + +(defun consult--left-truncate-file (file) + "Return abbreviated file name of FILE for use in `completing-read' prompt." + (save-match-data + (let ((file (directory-file-name (abbreviate-file-name file))) + (prefix nil)) + (when (string-match "\\`/\\([^/|:]+:\\)" file) + (setq prefix (propertize (match-string 1 file) 'face 'error) + file (substring file (match-end 0)))) + (when (and (string-match "/\\([^/]+\\)/\\([^/]+\\)\\'" file) + (< (- (match-end 0) (match-beginning 0) -3) (length file))) + (setq file (format "…/%s/%s" (match-string 1 file) (match-string 2 file)))) + (concat prefix file)))) + +(defun consult--directory-prompt (prompt dir) + "Return prompt, paths and default directory. + +PROMPT is the prompt prefix. The directory is appended to the +prompt prefix. For projects only the project name is shown. The +`default-directory' is not shown. Other directories are +abbreviated and only the last two path components are shown. + +If DIR is a string, it is returned as default directory. If DIR +is a list of strings, the list is returned as search paths. If +DIR is nil the `consult-project-function' is tried to retrieve +the default directory. If no project is found the +`default-directory' is returned as is. Otherwise the user is +asked for the directories or files to search via +`completing-read-multiple'." + (let* ((paths nil) + (dir + (pcase dir + ((pred stringp) dir) + ((or 'nil '(16)) (or (consult--project-root dir) default-directory)) + (_ + (pcase (if (stringp (car-safe dir)) + dir + ;; Preserve this-command across `completing-read-multiple' call, + ;; such that `consult-customize' continues to work. + (let ((this-command this-command) + (def (abbreviate-file-name default-directory)) + ;; TODO: `minibuffer-completing-file-name' is + ;; mostly deprecated, but still in use. Packages + ;; should instead use the completion metadata. + (minibuffer-completing-file-name t) + (ignore-case read-file-name-completion-ignore-case)) + (minibuffer-with-setup-hook + (lambda () + (setq-local completion-ignore-case ignore-case) + (set-syntax-table minibuffer-local-filename-syntax)) + (completing-read-multiple "Directories or files: " + #'completion-file-name-table + nil t def 'consult--path-history def)))) + ((and `(,p) (guard (file-directory-p p))) p) + (ps (setq paths (mapcar (lambda (p) + (file-relative-name (expand-file-name p))) + ps)) + default-directory))))) + (edir (file-name-as-directory (expand-file-name dir))) + (pdir (let ((default-directory edir)) + ;; Bind default-directory in order to find the project + (consult--project-root)))) + (list + (format "%s (%s): " prompt + (pcase paths + ((guard (<= 1 (length paths) 2)) + (string-join (mapcar #'consult--left-truncate-file paths) ", ")) + (`(,p . ,_) + (format "%d paths, %s, …" (length paths) (consult--left-truncate-file p))) + ((guard (equal edir pdir)) (concat "Project " (consult--project-name pdir))) + (_ (consult--left-truncate-file edir)))) + (or paths '(".")) + edir))) + +(declare-function project-current "project") +(declare-function project-root "project") + +(defun consult--default-project-function (may-prompt) + "Return project root directory. +When no project is found and MAY-PROMPT is non-nil ask the user." + (when-let (proj (project-current may-prompt)) + (project-root proj))) + +(defun consult--project-root (&optional may-prompt) + "Return project root as absolute path. +When no project is found and MAY-PROMPT is non-nil ask the user." + ;; Preserve this-command across project selection, + ;; such that `consult-customize' continues to work. + (let ((this-command this-command)) + (when-let (root (and consult-project-function + (funcall consult-project-function may-prompt))) + (expand-file-name root)))) + +(defun consult--project-name (dir) + "Return the project name for DIR." + (if (string-match "/\\([^/]+\\)/\\'" dir) + (propertize (match-string 1 dir) 'help-echo (abbreviate-file-name dir)) + dir)) + +(defun consult--format-file-line-match (file line match) + "Format string FILE:LINE:MATCH with faces." + (setq line (number-to-string line) + match (concat file ":" line ":" match) + file (length file)) + (put-text-property 0 file 'face 'consult-file match) + (put-text-property (1+ file) (+ 1 file (length line)) 'face 'consult-line-number match) + match) + +(defun consult--make-overlay (beg end &rest props) + "Make consult overlay between BEG and END with PROPS." + (let ((ov (make-overlay beg end))) + (while props + (overlay-put ov (car props) (cadr props)) + (setq props (cddr props))) + ov)) + +(defun consult--remove-dups (list) + "Remove duplicate strings from LIST." + (delete-dups (copy-sequence list))) + +(defsubst consult--in-range-p (pos) + "Return t if position POS lies in range `point-min' to `point-max'." + (<= (point-min) pos (point-max))) + +(defun consult--completion-window-p () + "Return non-nil if the selected window belongs to the completion UI." + (or (eq (selected-window) (active-minibuffer-window)) + (eq #'completion-list-mode (buffer-local-value 'major-mode (window-buffer))))) + +(defun consult--original-window () + "Return window which was just selected just before the minibuffer was entered. +In contrast to `minibuffer-selected-window' never return nil and +always return an appropriate non-minibuffer window." + (or (minibuffer-selected-window) + (if (window-minibuffer-p (selected-window)) + (next-window) + (selected-window)))) + +(defun consult--forbid-minibuffer () + "Raise an error if executed from the minibuffer." + (when (minibufferp) + (user-error "`%s' called inside the minibuffer" this-command))) + +(defun consult--require-minibuffer () + "Raise an error if executed outside the minibuffer." + (unless (minibufferp) + (user-error "`%s' must be called inside the minibuffer" this-command))) + +(defun consult--fontify-all () + "Ensure that the whole buffer is fontified." + ;; Font-locking is lazy, i.e., if a line has not been looked at yet, the line + ;; is not font-locked. We would observe this if consulting an unfontified + ;; line. Therefore we have to enforce font-locking now, which is slow. In + ;; order to prevent is hang-up we check the buffer size against + ;; `consult-fontify-max-size'. + (when (and consult-fontify-preserve jit-lock-mode + (< (buffer-size) consult-fontify-max-size)) + (jit-lock-fontify-now))) + +(defun consult--fontify-region (start end) + "Ensure that region between START and END is fontified." + (when (and consult-fontify-preserve jit-lock-mode) + (jit-lock-fontify-now start end))) + +(defmacro consult--with-increased-gc (&rest body) + "Temporarily increase the GC limit in BODY to optimize for throughput." + (cl-with-gensyms (overwrite) + `(let* ((,overwrite (> consult--gc-threshold gc-cons-threshold)) + (gc-cons-threshold (if ,overwrite consult--gc-threshold gc-cons-threshold)) + (gc-cons-percentage (if ,overwrite consult--gc-percentage gc-cons-percentage))) + ,@body))) + +(defmacro consult--slow-operation (message &rest body) + "Show delayed MESSAGE if BODY takes too long. +Also temporarily increase the GC limit via `consult--with-increased-gc'." + (declare (indent 1)) + `(with-delayed-message (1 ,message) + (consult--with-increased-gc ,@body))) + +(defun consult--count-lines (pos) + "Move to position POS and return number of lines." + (let ((line 1)) + (while (< (point) pos) + (forward-line) + (when (<= (point) pos) + (cl-incf line))) + (goto-char pos) + line)) + +(defun consult--marker-from-line-column (buffer line column) + "Get marker in BUFFER from LINE and COLUMN." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (save-excursion + (without-restriction + (goto-char (point-min)) + ;; Location data might be invalid by now! + (ignore-errors + (forward-line (1- line)) + (goto-char (min (+ (point) column) (pos-eol)))) + (point-marker)))))) + +(defun consult--line-prefix (&optional curr-line) + "Annotate `consult-location' candidates with line numbers. +CURR-LINE is the current line number." + (setq curr-line (or curr-line -1)) + (let* ((width (length (number-to-string (line-number-at-pos + (point-max) + consult-line-numbers-widen)))) + (before (format #("%%%dd " 0 6 (face consult-line-number-wrapped)) width)) + (after (format #("%%%dd " 0 6 (face consult-line-number-prefix)) width))) + (lambda (cand) + (let ((line (cdr (get-text-property 0 'consult-location cand)))) + (list cand (format (if (< line curr-line) before after) line) ""))))) + +(defsubst consult--location-candidate (cand marker line tofu &rest props) + "Add MARKER and LINE as `consult-location' text property to CAND. +Furthermore add the additional text properties PROPS, and append +TOFU suffix for disambiguation." + (setq cand (concat cand (consult--tofu-encode tofu))) + (add-text-properties 0 1 `(consult-location (,marker . ,line) ,@props) cand) + cand) + +;; There is a similar variable `yank-excluded-properties'. Unfortunately +;; we cannot use it here since it excludes too much (e.g., invisible) +;; and at the same time not enough (e.g., cursor-sensor-functions). +(defconst consult--remove-text-properties + '( category cursor cursor-intangible cursor-sensor-functions field follow-link + fontified front-sticky help-echo insert-behind-hooks insert-in-front-hooks + intangible keymap local-map modification-hooks mouse-face pointer read-only + rear-nonsticky yank-handler) + "List of text properties to remove from buffer strings.") + +(defsubst consult--buffer-substring (beg end &optional fontify) + "Return buffer substring between BEG and END. +If FONTIFY and `consult-fontify-preserve' are non-nil, first ensure that the +region has been fontified." + (if consult-fontify-preserve + (let (str) + (when fontify (consult--fontify-region beg end)) + (setq str (buffer-substring beg end)) + ;; TODO Propose the upstream addition of a function + ;; `preserve-list-of-text-properties', which should be as efficient as + ;; `remove-list-of-text-properties'. + (remove-list-of-text-properties + 0 (- end beg) consult--remove-text-properties str) + str) + (buffer-substring-no-properties beg end))) + +(defun consult--line-with-mark (marker) + "Current line string where the MARKER position is highlighted." + (let* ((beg (pos-bol)) + (end (pos-eol)) + (str (consult--buffer-substring beg end 'fontify))) + (if (>= marker end) + (concat str #(" " 0 1 (face consult-highlight-mark))) + (put-text-property (- marker beg) (- (1+ marker) beg) + 'face 'consult-highlight-mark str) + str))) + +;;;; Tofu cooks + +(defsubst consult--tofu-p (char) + "Return non-nil if CHAR is a tofu." + (<= consult--tofu-char char (+ consult--tofu-char consult--tofu-range -1))) + +(defun consult--tofu-hide (str) + "Hide the tofus in STR." + (let* ((max (length str)) + (end max)) + (while (and (> end 0) (consult--tofu-p (aref str (1- end)))) + (cl-decf end)) + (when (< end max) + (setq str (copy-sequence str)) + (put-text-property end max 'invisible t str)) + str)) + +(defsubst consult--tofu-append (cand id) + "Append tofu-encoded ID to CAND. +The ID must fit within a single character. It must be smaller +than `consult--tofu-range'." + (setq id (char-to-string (+ consult--tofu-char id))) + (add-text-properties 0 1 '(invisible t consult-strip t) id) + (concat cand id)) + +(defsubst consult--tofu-get (cand) + "Extract tofu-encoded ID from CAND. +See `consult--tofu-append'." + (- (aref cand (1- (length cand))) consult--tofu-char)) + +;; We must disambiguate the lines by adding a prefix such that two lines with +;; the same text can be distinguished. In order to avoid matching the line +;; number, such that the user can search for numbers with `consult-line', we +;; encode the line number as characters outside the Unicode range. By doing +;; that, no accidental matching can occur. +(defun consult--tofu-encode (n) + "Return tofu-encoded number N as a string. +Large numbers are encoded as multiple tofu characters." + (let (str tofu) + (while (progn + (setq tofu (char-to-string + (+ consult--tofu-char (% n consult--tofu-range))) + str (if str (concat tofu str) tofu)) + (and (>= n consult--tofu-range) + (setq n (/ n consult--tofu-range))))) + (add-text-properties 0 (length str) '(invisible t consult-strip t) str) + str)) + +;;;; Regexp utilities + +(defun consult--find-highlights (str start &rest ignored-faces) + "Find highlighted regions in STR from position START. +Highlighted regions have a non-nil face property. +IGNORED-FACES are ignored when searching for matches." + (let (highlights + (end (length str)) + (beg start)) + (while (< beg end) + (let ((next (next-single-property-change beg 'face str end)) + (val (get-text-property beg 'face str))) + (when (and val + (not (memq val ignored-faces)) + (not (and (consp val) + (seq-some (lambda (x) (memq x ignored-faces)) val)))) + (push (cons (- beg start) (- next start)) highlights)) + (setq beg next))) + (nreverse highlights))) + +(defun consult--point-placement (str start &rest ignored-faces) + "Compute point placement from STR with START offset. +IGNORED-FACES are ignored when searching for matches. +Return cons of point position and a list of match begin/end pairs." + (let* ((matches (apply #'consult--find-highlights str start ignored-faces)) + (pos (pcase-exhaustive consult-point-placement + ('match-beginning (or (caar matches) 0)) + ('match-end (or (cdar (last matches)) 0)) + ('line-beginning 0)))) + (dolist (match matches) + (cl-decf (car match) pos) + (cl-decf (cdr match) pos)) + (cons pos matches))) + +(defun consult--highlight-regexps (regexps ignore-case str) + "Highlight REGEXPS in STR. +If a regular expression contains capturing groups, only these are highlighted. +If no capturing groups are used highlight the whole match. Case is ignored +if IGNORE-CASE is non-nil." + (dolist (re regexps) + (let ((i 0)) + (while (and (let ((case-fold-search ignore-case)) + (string-match re str i)) + ;; Ensure that regexp search made progress (edge case for .*) + (> (match-end 0) i)) + ;; Unfortunately there is no way to avoid the allocation of the match + ;; data, since the number of capturing groups is unknown. + (let ((m (match-data))) + (setq i (cadr m) m (or (cddr m) m)) + (while m + (when (car m) + (add-face-text-property (car m) (cadr m) + 'consult-highlight-match nil str)) + (setq m (cddr m))))))) + str) + +(defconst consult--convert-regexp-table + (append + ;; For simplicity, treat word beginning/end as word boundaries, + ;; since PCRE does not make this distinction. Usually the + ;; context determines if \b is the beginning or the end. + '(("\\<" . "\\b") ("\\>" . "\\b") + ("\\_<" . "\\b") ("\\_>" . "\\b")) + ;; Treat \` and \' as beginning and end of line. This is more + ;; widely supported and makes sense for line-based commands. + '(("\\`" . "^") ("\\'" . "$")) + ;; Historical: Unescaped *, +, ? are supported at the beginning + (mapcan (lambda (x) + (mapcar (lambda (y) + (cons (concat x y) + (concat (string-remove-prefix "\\" x) "\\" y))) + '("*" "+" "?"))) + '("" "\\(" "\\(?:" "\\|" "^")) + ;; Different escaping + (mapcan (lambda (x) `(,x (,(cdr x) . ,(car x)))) + '(("\\|" . "|") + ("\\(" . "(") ("\\)" . ")") + ("\\{" . "{") ("\\}" . "}")))) + "Regexp conversion table.") + +(defun consult--convert-regexp (regexp type) + "Convert Emacs REGEXP to regexp syntax TYPE." + (if (memq type '(emacs basic)) + regexp + ;; Support for Emacs regular expressions is fairly complete for basic + ;; usage. There are a few unsupported Emacs regexp features: + ;; - \= point matching + ;; - Syntax classes \sx \Sx + ;; - Character classes \cx \Cx + ;; - Explicitly numbered groups (?3:group) + (replace-regexp-in-string + (rx (or "\\\\" "\\^" ;; Pass through + (seq (or "\\(?:" "\\|") (any "*+?")) ;; Historical: \|+ or \(?:* etc + (seq "\\(" (any "*+")) ;; Historical: \(* or \(+ + (seq (or bos "^") (any "*+?")) ;; Historical: + or * at the beginning + (seq (opt "\\") (any "(){|}")) ;; Escape parens/braces/pipe + (seq "\\" (any "'<>`")) ;; Special escapes + (seq "\\_" (any "<>")))) ;; Beginning or end of symbol + (lambda (x) (or (cdr (assoc x consult--convert-regexp-table)) x)) + regexp 'fixedcase 'literal))) + +(defun consult--default-regexp-compiler (input type ignore-case) + "Compile the INPUT string to a list of regular expressions. +The function should return a pair, the list of regular expressions and a +highlight function. The highlight function should take a single +argument, the string to highlight given the INPUT. TYPE is the desired +type of regular expression, which can be `basic', `extended', `emacs' or +`pcre'. If IGNORE-CASE is non-nil return a highlight function which +matches case insensitively." + (setq input (consult--split-escaped input)) + (cons (mapcar (lambda (x) (consult--convert-regexp x type)) input) + (when-let (regexps (seq-filter #'consult--valid-regexp-p input)) + (apply-partially #'consult--highlight-regexps regexps ignore-case)))) + +(defun consult--split-escaped (str) + "Split STR at spaces, which can be escaped with backslash." + (mapcar + (lambda (x) (string-replace "\0" " " x)) + (split-string (replace-regexp-in-string + "\\\\\\\\\\|\\\\ " + (lambda (x) (if (equal x "\\ ") "\0" x)) + str 'fixedcase 'literal) + " +" t))) + +(defun consult--join-regexps (regexps type) + "Join REGEXPS of TYPE." + ;; Add look-ahead wrapper only if there is more than one regular expression + (cond + ((and (eq type 'pcre) (cdr regexps)) + (concat "^" (mapconcat (lambda (x) (format "(?=.*%s)" x)) + regexps ""))) + ((eq type 'basic) + (string-join regexps ".*")) + (t + (when (length> regexps 3) + (message "Too many regexps, %S ignored. Use post-filtering!" + (string-join (seq-drop regexps 3) " ")) + (setq regexps (seq-take regexps 3))) + (consult--join-regexps-permutations regexps (and (eq type 'emacs) "\\"))))) + +(defun consult--join-regexps-permutations (regexps esc) + "Join all permutations of REGEXPS. +ESC is the escaping string for choice and groups." + (pcase regexps + ('nil "") + (`(,r) r) + (_ (mapconcat + (lambda (r) + (concat esc "(" r esc ").*" esc "(" + (consult--join-regexps-permutations (remove r regexps) esc) + esc ")")) + regexps (concat esc "|"))))) + +(defun consult--valid-regexp-p (re) + "Return t if regexp RE is valid." + (condition-case nil + (progn (string-match-p re "") t) + (invalid-regexp nil))) + +(defun consult--regexp-filter (regexps) + "Create filter regexp from REGEXPS." + (if (stringp regexps) + regexps + (mapconcat (lambda (x) (concat "\\(?:" x "\\)")) regexps "\\|"))) + +;;;; Lookup functions + +(defun consult--lookup-member (selected candidates &rest _) + "Lookup SELECTED in CANDIDATES list, return original element." + (car (member selected candidates))) + +(defun consult--lookup-cons (selected candidates &rest _) + "Lookup SELECTED in CANDIDATES alist, return cons." + (assoc selected candidates)) + +(defun consult--lookup-cdr (selected candidates &rest _) + "Lookup SELECTED in CANDIDATES alist, return `cdr' of element." + (cdr (assoc selected candidates))) + +(defun consult--lookup-location (selected candidates &rest _) + "Lookup SELECTED in CANDIDATES list of `consult-location' category. +Return the location marker." + (when-let (found (member selected candidates)) + (setq found (car (consult--get-location (car found)))) + ;; Check that marker is alive + (and (or (not (markerp found)) (marker-buffer found)) found))) + +(defun consult--lookup-prop (prop selected candidates &rest _) + "Lookup SELECTED in CANDIDATES list and return PROP value." + (when-let (found (member selected candidates)) + (get-text-property 0 prop (car found)))) + +(defun consult--lookup-candidate (selected candidates &rest _) + "Lookup SELECTED in CANDIDATES list and return property `consult--candidate'." + (consult--lookup-prop 'consult--candidate selected candidates)) + +;;;; Preview support + +(defun consult--preview-allowed-p (fun) + "Return non-nil if FUN is an allowed preview mode hook." + (or (memq fun consult-preview-allowed-hooks) + (when-let (((symbolp fun)) + (name (symbol-name fun)) + ;; Global modes in Emacs 29 are activated via a + ;; `find-file-hook' ending with `-check-buffers'. This has been + ;; changed in Emacs 30. Now a `change-major-mode-hook' is used + ;; instead with the suffix `-check-buffers'. + (suffix (static-if (>= emacs-major-version 30) + "-enable-in-buffer" + "-check-buffers")) + ((string-suffix-p suffix name))) + (memq (intern (string-remove-suffix suffix name)) + consult-preview-allowed-hooks)))) + +(defun consult--filter-find-file-hook (orig &rest hooks) + "Filter `find-file-hook' by `consult-preview-allowed-hooks'. +This function is an advice for `run-hooks'. +ORIG is the original function, HOOKS the arguments." + (if (memq 'find-file-hook hooks) + (cl-letf* (((default-value 'find-file-hook) + (seq-filter #'consult--preview-allowed-p + (default-value 'find-file-hook))) + (find-file-hook (default-value 'find-file-hook))) + (apply orig hooks)) + (apply orig hooks))) + +(defun consult--find-file-temporarily-1 (name) + "Open file NAME, helper function for `consult--find-file-temporarily'." + (when-let (((not (seq-find (lambda (x) (string-match-p x name)) + consult-preview-excluded-files))) + ;; file-attributes may throw permission denied error + (attrs (ignore-errors (file-attributes name))) + (size (file-attribute-size attrs))) + (let* ((partial (>= size consult-preview-partial-size)) + (buffer (if partial + (generate-new-buffer (format "consult-partial-preview-%s" name)) + (find-file-noselect name 'nowarn))) + (success nil)) + (unwind-protect + (with-current-buffer buffer + (if (not partial) + (when (or (eq major-mode 'hexl-mode) + (and (eq major-mode 'fundamental-mode) + (save-excursion (search-forward "\0" nil 'noerror)))) + (error "No preview of binary file `%s'" + (file-name-nondirectory name))) + (with-silent-modifications + (setq buffer-read-only t) + (insert-file-contents name nil 0 consult-preview-partial-chunk) + (goto-char (point-max)) + (insert "\nFile truncated. End of partial preview.\n") + (goto-char (point-min))) + (when (save-excursion (search-forward "\0" nil 'noerror)) + (error "No partial preview of binary file `%s'" + (file-name-nondirectory name))) + ;; Auto detect major mode and hope for the best, given that the + ;; file is only previewed partially. If an error is thrown the + ;; buffer will be killed and preview is aborted. + (set-auto-mode) + (font-lock-mode 1)) + (when (bound-and-true-p so-long-detected-p) + (error "No preview of file `%s' with long lines" + (file-name-nondirectory name))) + ;; Run delayed hooks listed in `consult-preview-allowed-hooks'. + (dolist (hook (reverse (cons 'after-change-major-mode-hook delayed-mode-hooks))) + (run-hook-wrapped hook (lambda (fun) + (when (consult--preview-allowed-p fun) + (funcall fun)) + nil))) + (setq success (current-buffer))) + (unless success + (kill-buffer buffer)))))) + +(defun consult--find-file-temporarily (name) + "Open file NAME temporarily for preview." + (let ((vars (delq nil + (mapcar + (pcase-lambda (`(,k . ,v)) + (if (boundp k) + (list k v (default-value k) (symbol-value k)) + (message "consult-preview-variables: The variable `%s' is not bound" k) + nil)) + consult-preview-variables)))) + (condition-case err + (unwind-protect + (progn + (advice-add #'run-hooks :around #'consult--filter-find-file-hook) + (pcase-dolist (`(,k ,v . ,_) vars) + (set-default k v) + (set k v)) + (consult--find-file-temporarily-1 name)) + (advice-remove #'run-hooks #'consult--filter-find-file-hook) + (pcase-dolist (`(,k ,_ ,d ,v) vars) + (set-default k d) + (set k v))) + (error + (message "%s" (error-message-string err)) + nil)))) + +(defun consult--temporary-files () + "Return a function to open files temporarily for preview." + (let ((dir default-directory) + (hook (make-symbol "consult--temporary-files-upgrade-hook")) + (orig-buffers (buffer-list)) + temporary-buffers) + (fset hook + (lambda (_) + ;; Fully initialize previewed files and keep them alive. + (unless (consult--completion-window-p) + (let (live-files) + (pcase-dolist (`(,file . ,buf) temporary-buffers) + (when-let (wins (and (buffer-live-p buf) + (get-buffer-window-list buf))) + (push (cons file (mapcar + (lambda (win) + (cons win (window-state-get win t))) + wins)) + live-files))) + (pcase-dolist (`(,_ . ,buf) temporary-buffers) + (kill-buffer buf)) + (setq temporary-buffers nil) + (pcase-dolist (`(,file . ,wins) live-files) + (when-let (buf (consult--file-action file)) + (push buf orig-buffers) + (pcase-dolist (`(,win . ,state) wins) + (setf (car (alist-get 'buffer state)) buf) + (window-state-put state win)))))))) + (lambda (&optional name) + (if name + (let ((default-directory dir)) + (setq name (abbreviate-file-name (expand-file-name name))) + (or + ;; Find existing fully initialized buffer (non-previewed). We have + ;; to check for fully initialized buffer before accessing the + ;; previewed buffers, since `embark-act' can open a buffer which is + ;; currently previewed, such that we end up with two buffers for + ;; the same file - one previewed and only partially initialized and + ;; one fully initialized. In this case we prefer the fully + ;; initialized buffer. For directories `get-file-buffer' returns nil, + ;; therefore we have to special case Dired. + (if (and (fboundp 'dired-find-buffer-nocreate) (file-directory-p name)) + (dired-find-buffer-nocreate name) + (get-file-buffer name)) + ;; Find existing previewed buffer. Previewed buffers are not fully + ;; initialized (hooks are delayed) in order to ensure fast preview. + (cdr (assoc name temporary-buffers)) + ;; Finally, if no existing buffer has been found, open the file for + ;; preview. + (when-let (buf (consult--find-file-temporarily name)) + ;; Only add new buffer if not already in the list + (unless (or (rassq buf temporary-buffers) (memq buf orig-buffers)) + (add-hook 'window-selection-change-functions hook) + (push (cons name buf) temporary-buffers) + ;; Disassociate buffer from file by setting `buffer-file-name' + ;; and `dired-directory' to nil and rename the buffer. This + ;; lets us open an already previewed buffer with the Embark + ;; default action C-. RET. + (with-current-buffer buf + (rename-buffer + (format " Preview:%s" + (file-name-nondirectory (directory-file-name name))) + 'unique)) + ;; The buffer disassociation is delayed to avoid breaking modes + ;; like `pdf-view-mode' or `doc-view-mode' which rely on + ;; `buffer-file-name'. Executing (set-visited-file-name nil) + ;; early also prevents the major mode initialization. + (let ((hook (make-symbol "consult--temporary-files-disassociate-hook"))) + (fset hook (lambda () + (when (buffer-live-p buf) + (with-current-buffer buf + (remove-hook 'pre-command-hook hook) + (setq-local buffer-read-only t + dired-directory nil + buffer-file-name nil))))) + (add-hook 'pre-command-hook hook)) + ;; Only keep a few buffers alive + (while (length> temporary-buffers consult-preview-max-count) + (kill-buffer (cdar (last temporary-buffers))) + (setq temporary-buffers (nbutlast temporary-buffers)))) + buf))) + (remove-hook 'window-selection-change-functions hook) + (pcase-dolist (`(,_ . ,buf) temporary-buffers) + (kill-buffer buf)) + (setq temporary-buffers nil))))) + +(defun consult--invisible-open-permanently () + "Open overlays which hide the current line. +See `isearch-open-necessary-overlays' and `isearch-open-overlay-temporary'." + (if (and (derived-mode-p 'org-mode) (fboundp 'org-fold-show-set-visibility)) + ;; New Org 9.6 fold-core API + (let ((inhibit-redisplay t)) ;; HACK: Prevent flicker due to premature redisplay + (org-fold-show-set-visibility 'canonical)) + (dolist (ov (overlays-in (pos-bol) (pos-eol))) + (when-let (fun (overlay-get ov 'isearch-open-invisible)) + (when (invisible-p (overlay-get ov 'invisible)) + (funcall fun ov)))))) + +(defun consult--invisible-open-temporarily () + "Temporarily open overlays which hide the current line. +See `isearch-open-necessary-overlays' and `isearch-open-overlay-temporary'." + (if (and (derived-mode-p 'org-mode) + (fboundp 'org-fold-show-set-visibility) + (fboundp 'org-fold-core-get-regions) + (fboundp 'org-fold-core-region)) + ;; New Org 9.6 fold-core API + ;; TODO The provided Org API `org-fold-show-set-visibility' cannot be used + ;; efficiently. We obtain all regions in the whole buffer in order to + ;; restore them. A better show API would return all the applied + ;; modifications such that we can restore the ones which got modified. + (progn + (unless consult--org-fold-regions + (setq consult--org-fold-regions + (delq nil (org-fold-core-get-regions + :with-markers t :from (point-min) :to (point-max)))) + (when consult--org-fold-regions + (let ((hook (make-symbol "consult--invisible-open-temporarily-cleanup-hook")) + (buffer (current-buffer)) + (depth (recursion-depth))) + (fset hook + (lambda () + (when (= (recursion-depth) depth) + (remove-hook 'minibuffer-exit-hook hook) + (run-at-time + 0 nil + (lambda () + (when (buffer-live-p buffer) + (with-current-buffer buffer + (pcase-dolist (`(,beg ,end ,_) consult--org-fold-regions) + (when (markerp beg) (set-marker beg nil)) + (when (markerp end) (set-marker end nil))) + (kill-local-variable 'consult--org-fold-regions)))))))) + (add-hook 'minibuffer-exit-hook hook)))) + (let ((inhibit-redisplay t)) ;; HACK: Prevent flicker due to premature redisplay + (org-fold-show-set-visibility 'canonical)) + (list (lambda () + (pcase-dolist (`(,beg ,end ,spec) consult--org-fold-regions) + (org-fold-core-region beg end t spec))))) + (let (restore) + (dolist (ov (overlays-in (pos-bol) (pos-eol))) + (let ((inv (overlay-get ov 'invisible))) + (when (and (invisible-p inv) (overlay-get ov 'isearch-open-invisible)) + (push (if-let (fun (overlay-get ov 'isearch-open-invisible-temporary)) + (progn + (funcall fun ov nil) + (lambda () (funcall fun ov t))) + (overlay-put ov 'invisible nil) + (lambda () (overlay-put ov 'invisible inv))) + restore)))) + restore))) + +(defun consult--jump-ensure-buffer (pos) + "Ensure that buffer of marker POS is displayed, return t if successful." + (or (not (markerp pos)) + ;; Switch to buffer if it is not visible + (when-let ((buf (marker-buffer pos))) + (or (and (eq (current-buffer) buf) (eq (window-buffer) buf)) + (consult--buffer-action buf 'norecord) + t)))) + +(defun consult--jump (pos) + "Jump to POS. +First push current position to mark ring, then move to new +position and run `consult-after-jump-hook'." + (when pos + ;; Extract marker from list with with overlay positions, see `consult--line-match' + (when (consp pos) (setq pos (car pos))) + ;; When the marker is in the same buffer, record previous location + ;; such that the user can jump back quickly. + (when (or (not (markerp pos)) (eq (current-buffer) (marker-buffer pos))) + ;; push-mark mutates markers in the mark-ring and the mark-marker. + ;; Therefore we transform the marker to a number to be safe. + ;; We all love side effects! + (setq pos (+ pos 0)) + (push-mark (point) t)) + (when (consult--jump-ensure-buffer pos) + (unless (= (goto-char pos) (point)) ;; Widen if jump failed + (widen) + (goto-char pos)) + (consult--invisible-open-permanently) + (run-hooks 'consult-after-jump-hook))) + nil) + +(defun consult--jump-preview () + "The preview function used if selecting from a list of candidate positions. +The function can be used as the `:state' argument of `consult--read'." + (let (restore) + (lambda (action cand) + (when (eq action 'preview) + (mapc #'funcall restore) + (setq restore nil) + ;; TODO Better buffer preview support + ;; 1. Use consult--buffer-preview instead of consult--jump-ensure-buffer + ;; 2. Remove function consult--jump-ensure-buffer + ;; 3. Remove consult-buffer-other-* from consult-customize-alist + (when-let ((pos (or (car-safe cand) cand)) ;; Candidate can be previewed + ((consult--jump-ensure-buffer pos))) + (let ((saved-min (point-min-marker)) + (saved-max (point-max-marker)) + (saved-pos (point-marker))) + (set-marker-insertion-type saved-max t) ;; Grow when text is inserted + (push (lambda () + (when-let ((buf (marker-buffer saved-pos))) + (with-current-buffer buf + (narrow-to-region saved-min saved-max) + (goto-char saved-pos) + (set-marker saved-pos nil) + (set-marker saved-min nil) + (set-marker saved-max nil)))) + restore)) + (unless (= (goto-char pos) (point)) ;; Widen if jump failed + (widen) + (goto-char pos)) + (setq restore (nconc (consult--invisible-open-temporarily) restore)) + ;; Ensure that cursor is properly previewed (gh:minad/consult#764) + (unless (eq cursor-in-non-selected-windows 'box) + (let ((orig cursor-in-non-selected-windows) + (buf (current-buffer))) + (push + (if (local-variable-p 'cursor-in-non-selected-windows) + (lambda () + (when (buffer-live-p buf) + (with-current-buffer buf + (setq-local cursor-in-non-selected-windows orig)))) + (lambda () + (when (buffer-live-p buf) + (with-current-buffer buf + (kill-local-variable 'cursor-in-non-selected-windows))))) + restore) + (setq-local cursor-in-non-selected-windows 'box))) + ;; Match previews + (let ((overlays + (list (save-excursion + (let ((vbeg (progn (beginning-of-visual-line) (point))) + (vend (progn (end-of-visual-line) (point))) + (end (pos-eol))) + (consult--make-overlay vbeg (if (= vend end) (1+ end) vend) + 'face 'consult-preview-line + 'window (selected-window) + 'priority 1)))))) + (dolist (match (cdr-safe cand)) + (push (consult--make-overlay (+ (point) (car match)) + (+ (point) (cdr match)) + 'face 'consult-preview-match + 'window (selected-window) + 'priority 2) + overlays)) + (push (lambda () (mapc #'delete-overlay overlays)) restore)) + (run-hooks 'consult-after-jump-hook)))))) + +(defun consult--jump-state () + "The state function used if selecting from a list of candidate positions." + (consult--state-with-return (consult--jump-preview) #'consult--jump)) + +(defun consult--get-location (cand) + "Return location from CAND." + (let ((loc (get-text-property 0 'consult-location cand))) + (when (consp (car loc)) + ;; Transform cheap marker to real marker + (setcar loc (set-marker (make-marker) (cdar loc) (caar loc)))) + loc)) + +(defun consult--location-state (candidates) + "Location state function. +The cheap location markers from CANDIDATES are upgraded on window +selection change to full Emacs markers." + (let ((jump (consult--jump-state)) + (hook (make-symbol "consult--location-upgrade-hook"))) + (fset hook + (lambda (_) + (unless (consult--completion-window-p) + (remove-hook 'window-selection-change-functions hook) + (mapc #'consult--get-location + (if (functionp candidates) (funcall candidates) candidates))))) + (lambda (action cand) + (pcase action + ('setup (add-hook 'window-selection-change-functions hook)) + ('exit (remove-hook 'window-selection-change-functions hook))) + (funcall jump action cand)))) + +(defun consult--state-with-return (state return) + "Compose STATE function with RETURN function." + (lambda (action cand) + (funcall state action cand) + (when (and cand (eq action 'return)) + (funcall return cand)))) + +(defmacro consult--define-state (type) + "Define state function for TYPE." + `(defun ,(intern (format "consult--%s-state" type)) () + ,(format "State function for %ss with preview. +The result can be passed as :state argument to `consult--read'." type) + (consult--state-with-return (,(intern (format "consult--%s-preview" type))) + #',(intern (format "consult--%s-action" type))))) + +(defun consult--preview-key-normalize (preview-key) + "Normalize PREVIEW-KEY, return alist of keys and debounce times." + (let ((keys) + (debounce 0)) + (setq preview-key (ensure-list preview-key)) + (while preview-key + (if (eq (car preview-key) :debounce) + (setq debounce (cadr preview-key) + preview-key (cddr preview-key)) + (let ((key (car preview-key))) + (unless (eq key 'any) + (setq key (consult--key-parse key))) + (push (cons key debounce) keys)) + (pop preview-key))) + keys)) + +(defun consult--preview-key-debounce (preview-key cand) + "Return debounce value of PREVIEW-KEY given the current candidate CAND." + (when (and (consp preview-key) (memq :keys preview-key)) + (setq preview-key (funcall (plist-get preview-key :predicate) cand))) + (let ((map (make-sparse-keymap)) + (keys (this-single-command-keys)) + any) + (pcase-dolist (`(,k . ,d) (consult--preview-key-normalize preview-key)) + (if (eq k 'any) + (setq any d) + (define-key map k `(lambda () ,d)))) + (setq keys (lookup-key map keys)) + (if (functionp keys) (funcall keys) any))) + +(defun consult--preview-append-local-pch (fun) + "Append FUN to local `post-command-hook' list." + ;; Symbol indirection because of bug#46407. + (let ((hook (make-symbol "consult--preview-post-command-hook"))) + (fset hook fun) + ;; TODO Emacs 28 has a bug, where the hook--depth-alist is not cleaned up properly + ;; Do not use the broken add-hook here. + ;;(add-hook 'post-command-hook hook 'append 'local) + (setq-local post-command-hook + (append + (remove t post-command-hook) + (list hook) + (and (memq t post-command-hook) '(t)))))) + +(defun consult--with-preview-1 (preview-key state transform candidate save-input fun) + "Add preview support for FUN. +See `consult--with-preview' for the arguments +PREVIEW-KEY, STATE, TRANSFORM, CANDIDATE and SAVE-INPUT." + (let ((mb-input "") mb-narrow selected timer previewed) + (minibuffer-with-setup-hook + (if (and state preview-key) + (lambda () + (let ((hook (make-symbol "consult--preview-minibuffer-exit-hook")) + (depth (recursion-depth))) + (fset hook + (lambda () + (when (= (recursion-depth) depth) + (remove-hook 'minibuffer-exit-hook hook) + (when timer + (cancel-timer timer) + (setq timer nil)) + (with-selected-window (consult--original-window) + ;; STEP 3: Reset preview + (when previewed + (funcall state 'preview nil)) + ;; STEP 4: Notify the preview function of the minibuffer exit + (funcall state 'exit nil))))) + (add-hook 'minibuffer-exit-hook hook)) + ;; STEP 1: Setup the preview function + (with-selected-window (consult--original-window) + (funcall state 'setup nil)) + (setq consult--preview-function + (lambda () + (when-let ((cand (funcall candidate))) + ;; Drop properties to prevent bugs regarding candidate + ;; lookup, which must handle candidates without + ;; properties. Otherwise the arguments passed to the + ;; lookup function are confusing, since during preview + ;; the candidate has properties but for the final lookup + ;; after completion it does not. + (setq cand (substring-no-properties cand)) + (with-selected-window (active-minibuffer-window) + (let ((input (minibuffer-contents-no-properties)) + (narrow consult--narrow) + (win (consult--original-window))) + (with-selected-window win + (when-let ((transformed (funcall transform narrow input cand)) + (debounce (consult--preview-key-debounce preview-key transformed))) + (when timer + (cancel-timer timer) + (setq timer nil)) + ;; The transformed candidate may have text + ;; properties, which change the preview display. + ;; This matters for example for `consult-grep', + ;; where the current candidate and input may + ;; stay equal, but the highlighting of the + ;; candidate changes while the candidates list + ;; is lagging a bit behind and updates + ;; asynchronously. + ;; + ;; In older Consult versions we instead compared + ;; the input without properties, since I worried + ;; that comparing the transformed candidates + ;; could be potentially expensive. However + ;; comparing the transformed candidates is more + ;; correct. The transformed candidate is the + ;; thing which is actually previewed. + (unless (equal-including-properties previewed transformed) + (if (> debounce 0) + (setq timer + (run-at-time + debounce nil + (lambda () + ;; Preview only when a completion + ;; window is selected and when + ;; the preview window is alive. + (when (and (consult--completion-window-p) + (window-live-p win)) + (with-selected-window win + ;; STEP 2: Preview candidate + (funcall state 'preview (setq previewed transformed))))))) + ;; STEP 2: Preview candidate + (funcall state 'preview (setq previewed transformed))))))))))) + (consult--preview-append-local-pch + (lambda () + (setq mb-input (minibuffer-contents-no-properties) + mb-narrow consult--narrow) + (funcall consult--preview-function)))) + (lambda () + (consult--preview-append-local-pch + (lambda () + (setq mb-input (minibuffer-contents-no-properties) + mb-narrow consult--narrow))))) + (unwind-protect + (setq selected (when-let (result (funcall fun)) + (when-let ((save-input) + (list (symbol-value save-input)) + ((equal (car list) result))) + (set save-input (cdr list))) + (funcall transform mb-narrow mb-input result))) + (when save-input + (add-to-history save-input mb-input)) + (when state + ;; STEP 5: The preview function should perform its final action + (funcall state 'return selected)))))) + +(defmacro consult--with-preview (preview-key state transform candidate save-input &rest body) + "Add preview support to BODY. + +STATE is the state function. +TRANSFORM is the transformation function. +CANDIDATE is the function returning the current candidate. +PREVIEW-KEY are the keys which triggers the preview. +SAVE-INPUT can be a history variable symbol to save the input. + +The state function takes two arguments, an action argument and the +selected candidate. The candidate argument can be nil if no candidate is +selected or if the selection was aborted. The function is called in +sequence with the following arguments: + + 1. \\='setup nil After entering the mb (minibuffer-setup-hook). +⎧ 2. \\='preview CAND/nil Preview candidate CAND or reset if CAND is nil. +⎪ \\='preview CAND/nil +⎪ \\='preview CAND/nil +⎪ ... +⎩ 3. \\='preview nil Reset preview. + 4. \\='exit nil Before exiting the mb (minibuffer-exit-hook). + 5. \\='return CAND/nil After leaving the mb, CAND has been selected. + +The state function is always executed with the original window selected, +see `consult--original-window'. The state function is called once in +the beginning of the minibuffer setup with the `setup' argument. This is +useful in order to perform certain setup operations which require that +the minibuffer is initialized. During completion candidates are +previewed. Then the function is called with the `preview' argument and a +candidate CAND or nil if no candidate is selected. Furthermore if nil is +passed for CAND, then the preview must be undone and the original state +must be restored. The call with the `exit' argument happens once at the +end of the completion process, just before exiting the minibuffer. The +minibuffer is still alive at that point. Both `setup' and `exit' are +only useful for setup and cleanup operations. They don't receive a +candidate as argument. After leaving the minibuffer, the selected +candidate or nil is passed to the state function with the action +argument `return'. At this point the state function can perform the +actual action on the candidate. The state function with the `return' +argument is the continuation of `consult--read'. Via `unwind-protect' it +is guaranteed, that if the `setup' action of a state function is +invoked, the state function will also be called with `exit' and +`return'." + (declare (indent 5)) + `(consult--with-preview-1 ,preview-key ,state ,transform ,candidate ,save-input (lambda () ,@body))) + +;;;; Narrowing and grouping + +(defun consult--prefix-group (cand transform) + "Return title for CAND or TRANSFORM the candidate. +The candidate must have a `consult--prefix-group' property." + (if transform + (substring cand (1+ (length (get-text-property 0 'consult--prefix-group cand)))) + (get-text-property 0 'consult--prefix-group cand))) + +(defun consult--type-group (types) + "Return group function for TYPES." + (lambda (cand transform) + (if transform cand + (alist-get (get-text-property 0 'consult--type cand) types)))) + +(defun consult--type-narrow (types) + "Return narrowing configuration from TYPES." + (list :predicate + (lambda (cand) (eq (get-text-property 0 'consult--type cand) consult--narrow)) + :keys types)) + +(defun consult--widen-key () + "Return widening key, if `consult-widen-key' is not set. +The default is twice the `consult-narrow-key'." + (cond + (consult-widen-key + (consult--key-parse consult-widen-key)) + (consult-narrow-key + (let ((key (consult--key-parse consult-narrow-key))) + (vconcat key key))))) + +(defun consult-narrow (key) + "Narrow current completion with KEY. + +This command is used internally by the narrowing system of `consult--read'." + (declare (completion ignore)) + (interactive + (list (unless (equal (this-single-command-keys) (consult--widen-key)) + last-command-event))) + (consult--require-minibuffer) + (setq consult--narrow key) + (when consult--narrow-predicate + (setq minibuffer-completion-predicate (and consult--narrow consult--narrow-predicate))) + (when consult--narrow-overlay + (delete-overlay consult--narrow-overlay)) + (when consult--narrow + (setq consult--narrow-overlay + (consult--make-overlay + (1- (minibuffer-prompt-end)) (minibuffer-prompt-end) + 'before-string + (propertize (format " [%s]" (alist-get consult--narrow + consult--narrow-keys)) + 'face 'consult-narrow-indicator)))) + (run-hooks 'consult--completion-refresh-hook)) + +(defconst consult--narrow-delete + `(menu-item + "" nil :filter + ,(lambda (&optional _) + (when (equal (minibuffer-contents-no-properties) "") + (lambda () + (interactive) + (consult-narrow nil)))))) + +(defconst consult--narrow-space + `(menu-item + "" nil :filter + ,(lambda (&optional _) + (let ((str (minibuffer-contents-no-properties))) + (when-let (pair (or (and (length= str 1) + (assoc (aref str 0) consult--narrow-keys)) + (and (equal str "") + (assoc ?\s consult--narrow-keys)))) + (lambda () + (interactive) + (delete-minibuffer-contents) + (consult-narrow (car pair)))))))) + +(defun consult-narrow-help () + "Print narrowing help as a `minibuffer-message'. + +This command can be bound to a key in `consult-narrow-map', +to make it available for commands with narrowing." + (declare (completion ignore)) + (interactive) + (consult--require-minibuffer) + (let ((minibuffer-message-timeout 1000000)) + (minibuffer-message + (mapconcat (lambda (x) + (concat + (propertize (key-description (list (car x))) 'face 'consult-key) + " " + (propertize (cdr x) 'face 'consult-help))) + consult--narrow-keys + " ")))) + +(defun consult--narrow-setup (settings map) + "Setup narrowing with SETTINGS and keymap MAP." + (if (memq :keys settings) + (setq consult--narrow-predicate (plist-get settings :predicate) + consult--narrow-keys (plist-get settings :keys)) + (setq consult--narrow-predicate nil + consult--narrow-keys settings)) + (when-let ((key consult-narrow-key)) + (setq key (consult--key-parse key)) + (dolist (pair consult--narrow-keys) + (define-key map (vconcat key (vector (car pair))) + (cons (cdr pair) #'consult-narrow)))) + (when-let ((widen (consult--widen-key))) + (define-key map widen (cons "All" #'consult-narrow))) + (when-let ((init (and (memq :keys settings) (plist-get settings :initial)))) + (consult-narrow init))) + +;;;; Splitting completion style + +(defun consult--split-perl (str &optional _plist) + "Split input STR in async input and filtering part. + +The function returns a list with three elements: The async +string, the start position of the completion filter string and a +force flag. If the first character is a punctuation character it +determines the separator. Examples: \"/async/filter\", +\"#async#filter\"." + (if (string-match-p "^[[:punct:]]" str) + (save-match-data + (let ((q (regexp-quote (substring str 0 1)))) + (string-match (concat "^" q "\\([^" q "]*\\)\\(" q "\\)?") str) + `(,(match-string 1 str) + ,(match-end 0) + ;; Force update it two punctuation characters are entered. + ,(match-end 2) + ;; List of highlights + (0 . ,(match-beginning 1)) + ,@(and (match-end 2) `((,(match-beginning 2) . ,(match-end 2))))))) + `(,str ,(length str)))) + +(defun consult--split-nil (str &optional _plist) + "Treat the complete input STR as async input." + `(,str ,(length str))) + +(defun consult--split-separator (str plist) + "Split input STR in async input and filtering part at first separator. +PLIST is the splitter configuration, including the separator." + (let ((sep (regexp-quote (char-to-string (plist-get plist :separator))))) + (save-match-data + (if (string-match (format "^\\([^%s]+\\)\\(%s\\)?" sep sep) str) + `(,(match-string 1 str) + ,(match-end 0) + ;; Force update it space is entered. + ,(match-end 2) + ;; List of highlights + ,@(and (match-end 2) `((,(match-beginning 2) . ,(match-end 2))))) + `(,str ,(length str)))))) + +(defun consult--split-setup (split) + "Setup splitting completion style with splitter function SPLIT." + (let* ((styles completion-styles) + (catdef completion-category-defaults) + (catovr completion-category-overrides) + (try (lambda (str table pred point) + (let ((completion-styles styles) + (completion-category-defaults catdef) + (completion-category-overrides catovr) + (pos (cadr (funcall split str)))) + (pcase (completion-try-completion (substring str pos) table pred + (max 0 (- point pos))) + ('t t) + (`(,newstr . ,newpt) + (cons (concat (substring str 0 pos) newstr) + (+ pos newpt))))))) + (all (lambda (str table pred point) + (let ((completion-styles styles) + (completion-category-defaults catdef) + (completion-category-overrides catovr) + (pos (cadr (funcall split str)))) + (completion-all-completions (substring str pos) table pred + (max 0 (- point pos))))))) + (setq-local completion-styles-alist (cons `(consult--split ,try ,all "") + completion-styles-alist) + completion-styles '(consult--split) + completion-category-defaults nil + completion-category-overrides nil))) + +;;;; Asynchronous filtering functions + +(defun consult--async-p (fun) + "Return t if FUN is an asynchronous completion function." + (and (functionp fun) + (condition-case nil + (progn (funcall fun "" nil 'metadata) nil) + (wrong-number-of-arguments t)))) + +(defmacro consult--with-async (bind &rest body) + "Setup asynchronous completion in BODY. + +BIND is the asynchronous function binding." + (declare (indent 1)) + (let ((async (car bind))) + `(let ((,async ,@(cdr bind)) + (new-chunk (max read-process-output-max consult--process-chunk)) + orig-chunk) + (minibuffer-with-setup-hook + ;; Append such that we overwrite the completion style setting of + ;; `fido-mode'. See `consult--async-split' and + ;; `consult--split-setup'. + (:append + (lambda () + (when (consult--async-p ,async) + (setq orig-chunk read-process-output-max + read-process-output-max new-chunk) + (funcall ,async 'setup) + (let* ((mb (current-buffer)) + (fun (lambda () + (when-let (win (active-minibuffer-window)) + (when (eq (window-buffer win) mb) + (with-current-buffer mb + (let ((inhibit-modification-hooks t)) + ;; Push input string to request refresh. + (funcall ,async (minibuffer-contents-no-properties)))))))) + ;; We use a symbol in order to avoid adding lambdas to + ;; the hook variable. Symbol indirection because of + ;; bug#46407. + (hook (make-symbol "consult--async-after-change-hook"))) + ;; Delay modification hook to ensure that minibuffer is still + ;; alive after the change, such that we don't restart a new + ;; asynchronous search right before exiting the minibuffer. + (fset hook (lambda (&rest _) (run-at-time 0 nil fun))) + (add-hook 'after-change-functions hook nil 'local) + (funcall hook))))) + (let ((,async (if (consult--async-p ,async) ,async (lambda (_) ,async)))) + (unwind-protect + ,(macroexp-progn body) + (funcall ,async 'destroy) + (when (and orig-chunk (eq read-process-output-max new-chunk)) + (setq read-process-output-max orig-chunk)))))))) + +(defun consult--async-sink () + "Create ASYNC sink function. + +An async function must accept a single action argument. For the +\\='setup action it is guaranteed that the call originates from +the minibuffer. For the other actions no assumption about the +context can be made. + +\\='setup Setup the internal closure state. Return nil. +\\='destroy Destroy the internal closure state. Return nil. +\\='flush Flush the list of candidates. Return nil. +\\='refresh Request UI refresh. Return nil. +nil Return the list of candidates. +list Append the list to the already existing candidates list and return it. +string Update with the current user input string. Return nil." + (let (candidates last buffer) + (lambda (action) + (pcase-exhaustive action + ('setup + (setq buffer (current-buffer)) + nil) + ((or (pred stringp) 'destroy) nil) + ('flush (setq candidates nil last nil)) + ('refresh + ;; Refresh the UI when the current minibuffer window belongs + ;; to the current asynchronous completion session. + (when-let (win (active-minibuffer-window)) + (when (eq (window-buffer win) buffer) + (with-selected-window win + (run-hooks 'consult--completion-refresh-hook) + ;; Interaction between asynchronous completion functions and + ;; preview: We have to trigger preview immediately when + ;; candidates arrive (gh:minad/consult#436). + (when (and consult--preview-function candidates) + (funcall consult--preview-function))))) + nil) + ('nil candidates) + ((pred consp) + (setq last (last (if last (setcdr last action) (setq candidates action)))) + candidates))))) + +(defun consult--async-split-style () + "Return the async splitting style function and initial string." + (or (alist-get consult-async-split-style consult-async-split-styles-alist) + (user-error "Splitting style `%s' not found" consult-async-split-style))) + +(defun consult--async-split-initial (initial) + "Return initial string for async command. +INITIAL is the additional initial string." + (concat (plist-get (consult--async-split-style) :initial) initial)) + +(defun consult--async-split-thingatpt (thing) + "Return THING at point with async initial prefix." + (when-let (str (thing-at-point thing)) + (consult--async-split-initial str))) + +(defun consult--async-split (async &optional split) + "Create async function, which splits the input string. +ASYNC is the async sink. +SPLIT is the splitting function." + (unless split + (let* ((style (consult--async-split-style)) + (fn (plist-get style :function))) + (setq split (lambda (str) (funcall fn str style))))) + (lambda (action) + (pcase action + ('setup + (consult--split-setup split) + (funcall async 'setup)) + ((pred stringp) + (pcase-let* ((`(,async-str ,_ ,force . ,highlights) + (funcall split action)) + (async-len (length async-str)) + (input-len (length action)) + (end (minibuffer-prompt-end))) + ;; Highlight punctuation characters + (remove-list-of-text-properties end (+ end input-len) '(face)) + (dolist (hl highlights) + (put-text-property (+ end (car hl)) (+ end (cdr hl)) + 'face 'consult-async-split)) + (funcall async + ;; Pass through if the input is long enough! + (if (or force (>= async-len consult-async-min-input)) + async-str + ;; Pretend that there is no input + "")))) + (_ (funcall async action))))) + +(defun consult--async-indicator (async) + "Create async function with a state indicator overlay. +ASYNC is the async sink." + (let (ov) + (lambda (action &optional state) + (pcase action + ('indicator + (overlay-put ov 'display + (pcase-exhaustive state + ('running #("*" 0 1 (face consult-async-running))) + ('finished #(":" 0 1 (face consult-async-finished))) + ('killed #(";" 0 1 (face consult-async-failed))) + ('failed #("!" 0 1 (face consult-async-failed)))))) + ('setup + (setq ov (make-overlay (- (minibuffer-prompt-end) 2) + (- (minibuffer-prompt-end) 1))) + (funcall async 'setup)) + ('destroy + (delete-overlay ov) + (funcall async 'destroy)) + (_ (funcall async action)))))) + +(defun consult--async-log (formatted &rest args) + "Log FORMATTED ARGS to variable `consult--async-log'." + (with-current-buffer (get-buffer-create consult--async-log) + (goto-char (point-max)) + (insert (apply #'format formatted args)))) + +(defun consult--async-process (async builder &rest props) + "Create process source async function. + +ASYNC is the async function which receives the candidates. +BUILDER is the command line builder function. +PROPS are optional properties passed to `make-process'." + (setq async (consult--async-indicator async)) + (let (proc proc-buf last-args count) + (lambda (action) + (pcase action + ("" ;; If no input is provided kill current process + (when proc + (delete-process proc) + (kill-buffer proc-buf) + (setq proc nil proc-buf nil)) + (setq last-args nil)) + ((pred stringp) + (funcall async action) + (let* ((args (funcall builder action))) + (unless (stringp (car args)) + (setq args (car args))) + (unless (equal args last-args) + (setq last-args args) + (when proc + (delete-process proc) + (kill-buffer proc-buf) + (setq proc nil proc-buf nil)) + (when args + (let* ((flush t) + (rest "") + (proc-filter + (lambda (_ out) + (when flush + (setq flush nil) + (funcall async 'flush)) + (let ((lines (split-string out "[\r\n]+"))) + (if (not (cdr lines)) + (setq rest (concat rest (car lines))) + (setcar lines (concat rest (car lines))) + (let* ((len (length lines)) + (last (nthcdr (- len 2) lines))) + (setq rest (cadr last) + count (+ count len -1)) + (setcdr last nil) + (funcall async lines)))))) + (proc-sentinel + (lambda (_ event) + (when flush + (setq flush nil) + (funcall async 'flush)) + (funcall async 'indicator + (cond + ((string-prefix-p "killed" event) 'killed) + ((string-prefix-p "finished" event) 'finished) + (t 'failed))) + (when (and (string-prefix-p "finished" event) (not (equal rest ""))) + (cl-incf count) + (funcall async (list rest))) + (consult--async-log + "consult--async-process sentinel: event=%s lines=%d\n" + (string-trim event) count) + (when (> (buffer-size proc-buf) 0) + (with-current-buffer (get-buffer-create consult--async-log) + (goto-char (point-max)) + (insert ">>>>> stderr >>>>>\n") + (let ((beg (point))) + (insert-buffer-substring proc-buf) + (save-excursion + (goto-char beg) + (message #("%s" 0 2 (face error)) + (buffer-substring-no-properties (pos-bol) (pos-eol))))) + (insert "<<<<< stderr <<<<<\n"))))) + (process-adaptive-read-buffering nil)) + (funcall async 'indicator 'running) + (consult--async-log "consult--async-process started: args=%S default-directory=%S\n" + args default-directory) + (setq count 0 + proc-buf (generate-new-buffer " *consult-async-stderr*") + proc (apply #'make-process + `(,@props + :connection-type pipe + :name ,(car args) + ;;; XXX tramp bug, the stderr buffer must be empty + :stderr ,proc-buf + :noquery t + :command ,args + :filter ,proc-filter + :sentinel ,proc-sentinel))))))) + nil) + ('destroy + (when proc + (delete-process proc) + (kill-buffer proc-buf) + (setq proc nil proc-buf nil)) + (funcall async 'destroy)) + (_ (funcall async action)))))) + +(defun consult--async-highlight (async builder) + "Return a new ASYNC function with candidate highlighting. +BUILDER is the command line builder function." + (let (highlight) + (lambda (action) + (cond + ((stringp action) + (setq highlight (cdr (funcall builder action))) + (funcall async action)) + ((and (consp action) highlight) + (dolist (str action) + (funcall highlight str)) + (funcall async action)) + (t (funcall async action)))))) + +(defun consult--async-throttle (async &optional throttle debounce) + "Create async function from ASYNC which throttles input. + +The THROTTLE delay defaults to `consult-async-input-throttle'. +The DEBOUNCE delay defaults to `consult-async-input-debounce'." + (setq throttle (or throttle consult-async-input-throttle) + debounce (or debounce consult-async-input-debounce)) + (let* ((input "") (timer (timer-create)) (last 0)) + (lambda (action) + (pcase action + ((pred stringp) + (unless (equal action input) + (cancel-timer timer) + (funcall async "") ;; cancel running process + (setq input action) + (unless (equal action "") + (timer-set-function timer (lambda () + (setq last (float-time)) + (funcall async action))) + (timer-set-time + timer + (timer-relative-time + nil (max debounce (- (+ last throttle) (float-time))))) + (timer-activate timer))) + nil) + ('destroy + (cancel-timer timer) + (funcall async 'destroy)) + (_ (funcall async action)))))) + +(defun consult--async-refresh-immediate (async) + "Create async function from ASYNC, which refreshes the display. + +The refresh happens immediately when candidates are pushed." + (lambda (action) + (pcase action + ((or (pred consp) 'flush) + (prog1 (funcall async action) + (funcall async 'refresh))) + (_ (funcall async action))))) + +(defun consult--async-refresh-timer (async &optional delay) + "Create async function from ASYNC, which refreshes the display. + +The refresh happens after a DELAY, defaulting to `consult-async-refresh-delay'." + (let ((delay (or delay consult-async-refresh-delay)) + (timer (timer-create))) + (timer-set-function timer async '(refresh)) + (lambda (action) + (prog1 (funcall async action) + (pcase action + ((or (pred consp) 'flush) + (unless (memq timer timer-list) + (timer-set-time timer (timer-relative-time nil delay)) + (timer-activate timer))) + ('destroy + (cancel-timer timer))))))) + +(defmacro consult--async-command (builder &rest args) + "Asynchronous command pipeline. +ARGS is a list of `make-process' properties and transforms. +BUILDER is the command line builder function, which takes the +input string and must either return a list of command line +arguments or a pair of the command line argument list and a +highlighting function." + (declare (indent 1)) + `(thread-first + (consult--async-sink) + (consult--async-refresh-timer) + ,@(seq-take-while (lambda (x) (not (keywordp x))) args) + (consult--async-process + ,builder + ,@(seq-drop-while (lambda (x) (not (keywordp x))) args)) + (consult--async-throttle) + (consult--async-split))) + +(defmacro consult--async-transform (async &rest transform) + "Use FUN to TRANSFORM candidates of ASYNC." + (cl-with-gensyms (async-var action-var) + `(let ((,async-var ,async)) + (lambda (,action-var) + (funcall ,async-var (if (consp ,action-var) (,@transform ,action-var) ,action-var)))))) + +(defun consult--async-map (async fun) + "Map candidates of ASYNC by FUN." + (consult--async-transform async mapcar fun)) + +(defun consult--async-filter (async fun) + "Filter candidates of ASYNC by FUN." + (consult--async-transform async seq-filter fun)) + +;;;; Dynamic collections based + +(defun consult--dynamic-compute (async fun &optional debounce) + "Dynamic computation of candidates. +ASYNC is the sink. +FUN computes the candidates given the input. +DEBOUNCE is the time after which an interrupted computation +should be restarted." + (setq debounce (or debounce consult-async-input-debounce)) + (setq async (consult--async-indicator async)) + (let* ((request) (current) (timer) + (cancel (lambda () (when timer (cancel-timer timer) (setq timer nil)))) + (start (lambda (req) (setq request req) (funcall async 'refresh)))) + (lambda (action) + (pcase action + ((and 'nil (guard (not request))) + (funcall async nil)) + ('nil + (funcall cancel) + (let ((state 'killed)) + (unwind-protect + (progn + (funcall async 'indicator 'running) + (redisplay) + ;; Run computation + (let ((response (funcall fun request))) + ;; Flush and update candidate list + (funcall async 'flush) + (setq state 'finished current request) + (funcall async response))) + (funcall async 'indicator state) + ;; If the computation was killed, restart it after some time. + (when (eq state 'killed) + (setq timer (run-at-time debounce nil start request))) + (setq request nil)))) + ((pred stringp) + (funcall cancel) + (if (or (equal action "") (equal action current)) + (funcall async 'indicator 'finished) + (funcall start action))) + ('destroy + (funcall cancel) + (funcall async 'destroy)) + (_ (funcall async action)))))) + +(defun consult--dynamic-collection (fun) + "Dynamic collection with input splitting. +FUN computes the candidates given the input." + (thread-first + (consult--async-sink) + (consult--dynamic-compute fun) + (consult--async-throttle) + (consult--async-split))) + +;;;; Special keymaps + +(defvar-keymap consult-async-map + :doc "Keymap added for commands with asynchronous candidates." + ;; Overwriting some unusable defaults of default minibuffer completion. + "<remap> <minibuffer-complete-word>" #'self-insert-command + ;; Remap Emacs 29 history and default completion for now + ;; (gh:minad/consult#613). + "<remap> <minibuffer-complete-defaults>" #'ignore + "<remap> <minibuffer-complete-history>" #'consult-history) + +(defvar-keymap consult-narrow-map + :doc "Narrowing keymap which is added to the local minibuffer map. +Note that `consult-narrow-key' and `consult-widen-key' are bound dynamically." + "SPC" consult--narrow-space + "DEL" consult--narrow-delete) + +;;;; Internal API: consult--read + +(defun consult--annotate-align (cand ann) + "Align annotation ANN by computing the maximum CAND width." + (setq consult--annotate-align-width + (max consult--annotate-align-width + (* (ceiling (consult--display-width cand) + consult--annotate-align-step) + consult--annotate-align-step))) + (when ann + (concat + #(" " 0 1 (display (space :align-to (+ left consult--annotate-align-width)))) + ann))) + +(defun consult--add-history (async items) + "Add ITEMS to the minibuffer future history. +ASYNC must be non-nil for async completion functions." + (delete-dups + (append + ;; the defaults are at the beginning of the future history + (ensure-list minibuffer-default) + ;; then our custom items + (remove "" (remq nil (ensure-list items))) + ;; Add all the completions for non-async commands. For async commands this + ;; feature is not useful, since if one selects a completion candidate, the + ;; async search is restarted using that candidate string. This usually does + ;; not yield a desired result since the async input uses a special format, + ;; e.g., `#grep#filter'. + (unless async + (all-completions "" + minibuffer-completion-table + minibuffer-completion-predicate))))) + +(defun consult--setup-keymap (keymap async narrow preview-key) + "Setup minibuffer keymap. + +KEYMAP is a command-specific keymap. +ASYNC must be non-nil for async completion functions. +NARROW are the narrow settings. +PREVIEW-KEY are the preview keys." + (let ((old-map (current-local-map)) + (map (make-sparse-keymap))) + + ;; Add narrow keys + (when narrow + (consult--narrow-setup narrow map)) + + ;; Preview trigger keys + (when (and (consp preview-key) (memq :keys preview-key)) + (setq preview-key (plist-get preview-key :keys))) + (setq preview-key (mapcar #'car (consult--preview-key-normalize preview-key))) + (when preview-key + (dolist (key preview-key) + (unless (or (eq key 'any) (lookup-key old-map key)) + (define-key map key #'ignore)))) + + ;; Put the keymap together + (use-local-map + (make-composed-keymap + (delq nil (list keymap + (and async consult-async-map) + (and narrow consult-narrow-map) + map)) + old-map)))) + +(defun consult--tofu-hide-in-minibuffer (&rest _) + "Hide the tofus in the minibuffer." + (let* ((min (minibuffer-prompt-end)) + (max (point-max)) + (pos max)) + (while (and (> pos min) (consult--tofu-p (char-before pos))) + (cl-decf pos)) + (when (< pos max) + (add-text-properties pos max '(invisible t rear-nonsticky t cursor-intangible t))))) + +(defun consult--read-annotate (fun cand) + "Annotate CAND with annotation function FUN." + (pcase (funcall fun cand) + (`(,_ ,_ ,suffix) suffix) + (ann ann))) + +(defun consult--read-affixate (fun cands) + "Affixate CANDS with annotation function FUN." + (mapcar (lambda (cand) + (let ((ann (funcall fun cand))) + (if (consp ann) + ann + (setq ann (or ann "")) + (list cand "" + ;; The default completion UI adds the + ;; `completions-annotations' face if no other faces are + ;; present. + (if (text-property-not-all 0 (length ann) 'face nil ann) + ann + (propertize ann 'face 'completions-annotations)))))) + cands)) + +(cl-defun consult--read-1 (table &key + prompt predicate require-match history default + keymap category initial narrow add-history annotate + state preview-key sort lookup group inherit-input-method) + "See `consult--read' for the documentation of the arguments." + (minibuffer-with-setup-hook + (:append (lambda () + (add-hook 'after-change-functions #'consult--tofu-hide-in-minibuffer nil 'local) + (consult--setup-keymap keymap (consult--async-p table) narrow preview-key) + (setq-local minibuffer-default-add-function + (apply-partially #'consult--add-history (consult--async-p table) add-history)))) + (consult--with-async (async table) + (consult--with-preview + preview-key state + (lambda (narrow input cand) + (funcall lookup cand (funcall async nil) input narrow)) + (apply-partially #'run-hook-with-args-until-success + 'consult--completion-candidate-hook) + (pcase-exhaustive history + (`(:input ,var) var) + ((pred symbolp))) + ;; Do not unnecessarily let-bind the lambdas to avoid over-capturing in + ;; the interpreter. This will make closures and the lambda string + ;; representation larger, which makes debugging much worse. Fortunately + ;; the over-capturing problem does not affect the bytecode interpreter + ;; which does a proper scope analysis. + (let* ((metadata `(metadata + ,@(when category `((category . ,category))) + ,@(when group `((group-function . ,group))) + ,@(when annotate + `((affixation-function + . ,(apply-partially #'consult--read-affixate annotate)) + (annotation-function + . ,(apply-partially #'consult--read-annotate annotate)))) + ,@(unless sort '((cycle-sort-function . identity) + (display-sort-function . identity))))) + (consult--annotate-align-width 0) + (selected + (completing-read + prompt + (lambda (str pred action) + (let ((result (complete-with-action action (funcall async nil) str pred))) + (if (eq action 'metadata) + (if (and (eq (car result) 'metadata) (cdr result)) + ;; Merge metadata + `(metadata ,@(cdr metadata) ,@(cdr result)) + metadata) + result))) + predicate require-match initial + (if (symbolp history) history (cadr history)) + default + inherit-input-method))) + ;; Repair the null completion semantics. `completing-read' may return + ;; an empty string even if REQUIRE-MATCH is non-nil. One can always + ;; opt-in to null completion by passing the empty string for DEFAULT. + (when (and (eq require-match t) (not default) (equal selected "")) + (user-error "No selection")) + selected))))) + +(cl-defun consult--read (table &rest options &key + prompt predicate require-match history default + keymap category initial narrow add-history annotate + state preview-key sort lookup group inherit-input-method) + "Enhanced completing read function to select from TABLE. + +The function is a thin wrapper around `completing-read'. Keyword +arguments are used instead of positional arguments for code +clarity. On top of `completing-read' it additionally supports +computing the candidate list asynchronously, candidate preview +and narrowing. You should use `completing-read' instead of +`consult--read' if you don't use asynchronous candidate +computation or candidate preview. + +Keyword OPTIONS: + +PROMPT is the string which is shown as prompt in the minibuffer. +PREDICATE is a filter function called for each candidate, returns +nil or t. +REQUIRE-MATCH equals t means that an exact match is required. +HISTORY is the symbol of the history variable. +DEFAULT is the default selected value. +ADD-HISTORY is a list of items to add to the history. +CATEGORY is the completion category symbol. +SORT should be set to nil if the candidates are already sorted. +This will disable sorting in the completion UI. +LOOKUP is a lookup function passed the selected candidate string, +the list of candidates, the current input string and the current +narrowing value. +ANNOTATE is a function passed a candidate string. The function +should either return an annotation string or a list of three +strings (candidate prefix postfix). +INITIAL is the initial input string. +STATE is the state function, see `consult--with-preview'. +GROUP is a completion metadata `group-function' as documented in +the Elisp manual. +PREVIEW-KEY are the preview keys. Can be nil, `any', a single +key or a list of keys. +NARROW is an alist of narrowing prefix strings and description. +KEYMAP is a command-specific keymap. +INHERIT-INPUT-METHOD, if non-nil the minibuffer inherits the +input method." + ;; supported types + (cl-assert (or (functionp table) ;; dynamic table or asynchronous function + (obarrayp table) ;; obarray + (hash-table-p table) ;; hash table + (not table) ;; empty list + (stringp (car table)) ;; string list + (and (consp (car table)) (stringp (caar table))) ;; string alist + (and (consp (car table)) (symbolp (caar table))))) ;; symbol alist + (ignore prompt predicate require-match history default + keymap category initial narrow add-history annotate + state preview-key sort lookup group inherit-input-method) + (apply #'consult--read-1 table + (append + (consult--customize-get) + options + (list :prompt "Select: " + :preview-key consult-preview-key + :sort t + :lookup (lambda (selected &rest _) selected))))) + +;;;; Internal API: consult--prompt + +(cl-defun consult--prompt-1 (&key prompt history add-history initial default + keymap state preview-key transform inherit-input-method) + "See `consult--prompt' for documentation." + (minibuffer-with-setup-hook + (:append (lambda () + (consult--setup-keymap keymap nil nil preview-key) + (setq-local minibuffer-default-add-function + (apply-partially #'consult--add-history nil add-history)))) + (consult--with-preview + preview-key state + (lambda (_narrow inp _cand) (funcall transform inp)) + (lambda () "") + history + (read-from-minibuffer prompt initial nil nil history default inherit-input-method)))) + +(cl-defun consult--prompt (&rest options &key prompt history add-history initial default + keymap state preview-key transform inherit-input-method) + "Read from minibuffer. + +Keyword OPTIONS: + +PROMPT is the string to prompt with. +TRANSFORM is a function which is applied to the current input string. +HISTORY is the symbol of the history variable. +INITIAL is initial input. +DEFAULT is the default selected value. +ADD-HISTORY is a list of items to add to the history. +STATE is the state function, see `consult--with-preview'. +PREVIEW-KEY are the preview keys (nil, `any', a single key or a list of keys). +KEYMAP is a command-specific keymap." + (ignore prompt history add-history initial default + keymap state preview-key transform inherit-input-method) + (apply #'consult--prompt-1 + (append + (consult--customize-get) + options + (list :prompt "Input: " + :preview-key consult-preview-key + :transform #'identity)))) + +;;;; Internal API: consult--multi + +(defsubst consult--multi-source (sources cand) + "Lookup source for CAND in SOURCES list." + (aref sources (consult--tofu-get cand))) + +(defun consult--multi-predicate (sources cand) + "Predicate function called for each candidate CAND given SOURCES." + (let* ((src (consult--multi-source sources cand)) + (narrow (plist-get src :narrow)) + (type (or (car-safe narrow) narrow -1))) + (or (eq consult--narrow type) + (not (or consult--narrow (plist-get src :hidden)))))) + +(defun consult--multi-narrow (sources) + "Return narrow list from SOURCES." + (thread-last + sources + (mapcar (lambda (src) + (when-let (narrow (plist-get src :narrow)) + (if (consp narrow) + narrow + (when-let (name (plist-get src :name)) + (cons narrow name)))))) + (delq nil) + (delete-dups))) + +(defun consult--multi-annotate (sources cand) + "Annotate candidate CAND from multi SOURCES." + (consult--annotate-align + cand + (let ((src (consult--multi-source sources cand))) + (if-let ((fun (plist-get src :annotate))) + (funcall fun (cdr (get-text-property 0 'multi-category cand))) + (plist-get src :name))))) + +(defun consult--multi-group (sources cand transform) + "Return title of candidate CAND or TRANSFORM the candidate given SOURCES." + (if transform cand + (plist-get (consult--multi-source sources cand) :name))) + +(defun consult--multi-preview-key (sources) + "Return preview keys from SOURCES." + (list :predicate + (lambda (cand) + (if (plist-member (cdr cand) :preview-key) + (plist-get (cdr cand) :preview-key) + consult-preview-key)) + :keys + (delete-dups + (seq-filter (lambda (k) (or (eq k 'any) (stringp k))) + (seq-mapcat (lambda (src) + (ensure-list + (if (plist-member src :preview-key) + (plist-get src :preview-key) + consult-preview-key))) + sources))))) + +(defun consult--multi-lookup (sources selected candidates _input narrow &rest _) + "Lookup SELECTED in CANDIDATES given SOURCES, with potential NARROW." + (if (or (string-blank-p selected) + (not (consult--tofu-p (aref selected (1- (length selected)))))) + ;; Non-existing candidate without Tofu or default submitted (empty string) + (let* ((src (cond + (narrow (seq-find (lambda (src) + (let ((n (plist-get src :narrow))) + (eq (or (car-safe n) n -1) narrow))) + sources)) + ((seq-find (lambda (src) (plist-get src :default)) sources)) + ((seq-find (lambda (src) (not (plist-get src :hidden))) sources)) + ((aref sources 0)))) + (idx (seq-position sources src)) + (def (and (string-blank-p selected) ;; default candidate + (seq-find (lambda (cand) (eq idx (consult--tofu-get cand))) candidates)))) + (if def + (cons (cdr (get-text-property 0 'multi-category def)) src) + `(,selected :match nil ,@src))) + (if-let (found (member selected candidates)) + ;; Existing candidate submitted + (cons (cdr (get-text-property 0 'multi-category (car found))) + (consult--multi-source sources selected)) + ;; Non-existing Tofu'ed candidate submitted, e.g., via Embark + `(,(substring selected 0 -1) :match nil ,@(consult--multi-source sources selected))))) + +(defun consult--multi-candidates (sources) + "Return `consult--multi' candidates from SOURCES." + (let ((idx 0) candidates) + (seq-doseq (src sources) + (let* ((face (and (plist-member src :face) `(face ,(plist-get src :face)))) + (cat (plist-get src :category)) + (items (plist-get src :items)) + (items (if (functionp items) (funcall items) items))) + (dolist (item items) + (let* ((str (or (car-safe item) item)) + (cand (consult--tofu-append str idx))) + ;; Preserve existing `multi-category' datum of the candidate. + (if (and (eq str item) (get-text-property 0 'multi-category str)) + (when face (add-text-properties 0 (length str) face cand)) + ;; Attach `multi-category' datum and face. + (add-text-properties + 0 (length str) + `(multi-category (,cat . ,(or (cdr-safe item) item)) ,@face) cand)) + (push cand candidates)))) + (cl-incf idx)) + (nreverse candidates))) + +(defun consult--multi-enabled-sources (sources) + "Return vector of enabled SOURCES." + (vconcat + (seq-filter (lambda (src) + (if-let (pred (plist-get src :enabled)) + (funcall pred) + t)) + (mapcar (lambda (src) + (if (symbolp src) (symbol-value src) src)) + sources)))) + +(defun consult--multi-state (sources) + "State function given SOURCES." + (when-let (states (delq nil (mapcar (lambda (src) + (when-let (fun (plist-get src :state)) + (cons src (funcall fun)))) + sources))) + (let (last-fun) + (pcase-lambda (action `(,cand . ,src)) + (pcase action + ('setup + (pcase-dolist (`(,_ . ,fun) states) + (funcall fun 'setup nil))) + ('exit + (pcase-dolist (`(,_ . ,fun) states) + (funcall fun 'exit nil))) + ('preview + (let ((selected-fun (cdr (assq src states)))) + ;; If the candidate source changed during preview communicate to + ;; the last source, that none of its candidates is previewed anymore. + (when (and last-fun (not (eq last-fun selected-fun))) + (funcall last-fun 'preview nil)) + (setq last-fun selected-fun) + (when selected-fun + (funcall selected-fun 'preview cand)))) + ('return + (let ((selected-fun (cdr (assq src states)))) + ;; Finish all the sources, except the selected one. + (pcase-dolist (`(,_ . ,fun) states) + (unless (eq fun selected-fun) + (funcall fun 'return nil))) + ;; Finish the source with the selected candidate + (when selected-fun + (funcall selected-fun 'return cand))))))))) + +(defun consult--multi (sources &rest options) + "Select from candidates taken from a list of SOURCES. + +OPTIONS is the plist of options passed to `consult--read'. The following +options are supported: :require-match, :history, :keymap, :initial, +:add-history, :sort and :inherit-input-method. The other options of +`consult--read' are used by the implementation of `consult--multi' and +should not be overwritten, except in in special scenarios. + +The function returns the selected candidate in the form (cons candidate +source-plist). The plist has the key :match with a value nil if the +candidate does not exist, t if the candidate exists and `new' if the +candidate has been created. The sources of the source list can either be +symbols of source variables or source values. Source values must be +plists with fields from the following list. + +Required source fields: +* :category - Completion category symbol. +* :items - List of strings to select from or function returning + list of strings. Note that the strings can use text properties + to carry metadata, which is then available to the :annotate, + :action and :state functions. + +Optional source fields: +* :name - Name of the source as a string, used for narrowing, + group titles and annotations. +* :narrow - Narrowing character or (character . string) pair. +* :enabled - Function which must return t if the source is enabled. +* :hidden - When t candidates of this source are hidden by default. +* :face - Face used for highlighting the candidates. +* :annotate - Annotation function called for each candidate, returns string. +* :history - Name of history variable to add selected candidate. +* :default - Must be t if the first item of the source is the default value. +* :action - Function called with the selected candidate. +* :new - Function called with new candidate name, only if :require-match is nil. +* :state - State constructor for the source, must return the + state function. The state function is informed about state + changes of the UI and can be used to implement preview. +* Other custom source fields can be added depending on the use + case. Note that the source is returned by `consult--multi' + together with the selected candidate." + (let* ((sources (consult--multi-enabled-sources sources)) + (candidates (consult--with-increased-gc + (consult--multi-candidates sources))) + (selected + (apply #'consult--read + candidates + (append + options + (list + :category 'multi-category + :predicate (apply-partially #'consult--multi-predicate sources) + :annotate (apply-partially #'consult--multi-annotate sources) + :group (apply-partially #'consult--multi-group sources) + :lookup (apply-partially #'consult--multi-lookup sources) + :preview-key (consult--multi-preview-key sources) + :narrow (consult--multi-narrow sources) + :state (consult--multi-state sources)))))) + (when-let (history (plist-get (cdr selected) :history)) + (add-to-history history (car selected))) + (if (plist-member (cdr selected) :match) + (when-let (fun (plist-get (cdr selected) :new)) + (funcall fun (car selected)) + (plist-put (cdr selected) :match 'new)) + (when-let (fun (plist-get (cdr selected) :action)) + (funcall fun (car selected))) + (setq selected `(,(car selected) :match t ,@(cdr selected)))) + selected)) + +;;;; Customization macro + +(defun consult--customize-put (cmds prop form) + "Set property PROP to FORM of commands CMDS." + (dolist (cmd cmds) + (cond + ((and (boundp cmd) (consp (symbol-value cmd))) + (setf (plist-get (symbol-value cmd) prop) (eval form 'lexical))) + ((functionp cmd) + (setf (plist-get (alist-get cmd consult--customize-alist) prop) form)) + (t (user-error "%s is neither a Command command nor a source" cmd)))) + nil) + +(defmacro consult-customize (&rest args) + "Set properties of commands or sources. +ARGS is a list of commands or sources followed by the list of +keyword-value pairs. For `consult-customize' to succeed, the +customized sources and commands must exist. When a command is +invoked, the value of `this-command' is used to lookup the +corresponding customization options." + (let (setter) + (while args + (let ((cmds (seq-take-while (lambda (x) (not (keywordp x))) args))) + (setq args (seq-drop-while (lambda (x) (not (keywordp x))) args)) + (while (keywordp (car args)) + (push `(consult--customize-put ',cmds ,(car args) ',(cadr args)) setter) + (setq args (cddr args))))) + (macroexp-progn setter))) + +(defun consult--customize-get () + "Get configuration from `consult--customize-alist' for `this-command'." + (mapcar (lambda (x) (eval x 'lexical)) + (alist-get this-command consult--customize-alist))) + +;;;; Commands + +;;;;; Command: consult-completion-in-region + +(defun consult--insertion-preview (start end) + "State function for previewing a candidate in a specific region. +The candidates are previewed in the region from START to END. This function is +used as the `:state' argument for `consult--read' in the `consult-yank' family +of functions and in `consult-completion-in-region'." + (unless (or (minibufferp) + ;; Disable preview if anything odd is going on with the markers. + ;; Otherwise we get "Marker points into wrong buffer errors". See + ;; gh:minad/consult#375, where Org mode source blocks are + ;; completed in a different buffer than the original buffer. This + ;; completion is probably also problematic in my Corfu completion + ;; package. + (not (eq (window-buffer) (current-buffer))) + (and (markerp start) (not (eq (marker-buffer start) (current-buffer)))) + (and (markerp end) (not (eq (marker-buffer end) (current-buffer))))) + (let (ov) + (lambda (action cand) + (cond + ((and (not cand) ov) + (delete-overlay ov) + (setq ov nil)) + ((and (eq action 'preview) cand) + (unless ov + (setq ov (consult--make-overlay start end + 'invisible t + 'window (selected-window)))) + ;; Use `add-face-text-property' on a copy of "cand in order to merge face properties + (setq cand (copy-sequence cand)) + (add-face-text-property 0 (length cand) 'consult-preview-insertion t cand) + ;; Use the `before-string' property since the overlay might be empty. + (overlay-put ov 'before-string cand))))))) + +;;;###autoload +(defun consult-completion-in-region (start end collection &optional predicate) + "Use minibuffer completion as the UI for `completion-at-point'. + +The function is called with 4 arguments: START END COLLECTION +PREDICATE. The arguments and expected return value are as +specified for `completion-in-region'. Use this function as a +value for `completion-in-region-function'." + (barf-if-buffer-read-only) + (let* ((initial (buffer-substring-no-properties start end)) + (metadata (completion-metadata initial collection predicate)) + ;; TODO: `minibuffer-completing-file-name' is mostly deprecated, but + ;; still in use. Packages should instead use the completion metadata. + (minibuffer-completing-file-name + (eq 'file (completion-metadata-get metadata 'category))) + (threshold (completion--cycle-threshold metadata)) + (all (completion-all-completions initial collection predicate (length initial))) + ;; Wrap all annotation functions to ensure that they are executed + ;; in the original buffer. + (exit-fun (plist-get completion-extra-properties :exit-function)) + (ann-fun (plist-get completion-extra-properties :annotation-function)) + (aff-fun (plist-get completion-extra-properties :affixation-function)) + (docsig-fun (plist-get completion-extra-properties :company-docsig)) + (completion-extra-properties + `(,@(and ann-fun (list :annotation-function (consult--in-buffer ann-fun))) + ,@(and aff-fun (list :affixation-function (consult--in-buffer aff-fun))) + ;; Provide `:annotation-function' if `:company-docsig' is specified. + ,@(and docsig-fun (not ann-fun) (not aff-fun) + (list :annotation-function + (consult--in-buffer + (lambda (cand) + (concat (propertize " " 'display '(space :align-to center)) + (funcall docsig-fun cand))))))))) + ;; error if `threshold' is t or the improper list `all' is too short + (if (and threshold + (or (not (consp (ignore-errors (nthcdr threshold all)))) + (and completion-cycling completion-all-sorted-completions))) + (completion--in-region start end collection predicate) + (let* ((limit (car (completion-boundaries initial collection predicate ""))) + (this-command #'consult-completion-in-region) + (completion + (cond + ((atom all) nil) + ((and (consp all) (atom (cdr all))) + (concat (substring initial 0 limit) (car all))) + (t + (consult--local-let ((enable-recursive-minibuffers t)) + ;; Evaluate completion table in the original buffer. + ;; This is a reasonable thing to do and required by + ;; some completion tables in particular by lsp-mode. + ;; See gh:minad/vertico#61. + (consult--read (consult--completion-table-in-buffer collection) + :prompt "Completion: " + :state (consult--insertion-preview start end) + :predicate predicate + :initial initial)))))) + (if completion + (progn + ;; bug#55205: completion--replace removes properties! + (completion--replace start end (setq completion (concat completion))) + (when exit-fun + (funcall exit-fun completion + ;; If completion is finished and cannot be further + ;; completed, return `finished'. Otherwise return + ;; `exact'. + (if (eq (try-completion completion collection predicate) t) + 'finished 'exact))) + t) + (message "No completion") + nil))))) + +;;;;; Command: consult-outline + +(defun consult--outline-candidates () + "Return alist of outline headings and positions." + (consult--forbid-minibuffer) + (let* ((line (line-number-at-pos (point-min) consult-line-numbers-widen)) + (heading-regexp (concat "^\\(?:" + ;; default definition from outline.el + (or (bound-and-true-p outline-regexp) "[*\^L]+") + "\\)")) + (heading-alist (bound-and-true-p outline-heading-alist)) + (level-fun (or (bound-and-true-p outline-level) + (lambda () ;; as in the default from outline.el + (or (cdr (assoc (match-string 0) heading-alist)) + (- (match-end 0) (match-beginning 0)))))) + (buffer (current-buffer)) + candidates) + (save-excursion + (goto-char (point-min)) + (while (save-excursion + (if-let (fun (bound-and-true-p outline-search-function)) + (funcall fun) + (re-search-forward heading-regexp nil t))) + (cl-incf line (consult--count-lines (match-beginning 0))) + (push (consult--location-candidate + (consult--buffer-substring (pos-bol) (pos-eol) 'fontify) + (cons buffer (point)) (1- line) (1- line) + 'consult--outline-level (funcall level-fun)) + candidates) + (goto-char (1+ (pos-eol))))) + (unless candidates + (user-error "No headings")) + (nreverse candidates))) + +;;;###autoload +(defun consult-outline (&optional level) + "Jump to an outline heading, obtained by matching against `outline-regexp'. + +This command supports narrowing to a heading level and candidate +preview. The initial narrowing LEVEL can be given as prefix +argument. The symbol at point is added to the future history." + (interactive + (list (and current-prefix-arg (prefix-numeric-value current-prefix-arg)))) + (let* ((candidates (consult--slow-operation + "Collecting headings..." + (consult--outline-candidates))) + (min-level (- (cl-loop for cand in candidates minimize + (get-text-property 0 'consult--outline-level cand)) + ?1)) + (narrow-pred (lambda (cand) + (<= (get-text-property 0 'consult--outline-level cand) + (+ consult--narrow min-level)))) + (narrow-keys (mapcar (lambda (c) (cons c (format "Level %c" c))) + (number-sequence ?1 ?9))) + (narrow-init (and level (max ?1 (min ?9 (+ level ?0)))))) + (consult--read + candidates + :prompt "Go to heading: " + :annotate (consult--line-prefix) + :category 'consult-location + :sort nil + :require-match t + :lookup #'consult--line-match + :narrow `(:predicate ,narrow-pred :keys ,narrow-keys :initial ,narrow-init) + :history '(:input consult--line-history) + :add-history (thing-at-point 'symbol) + :state (consult--location-state candidates)))) + +;;;;; Command: consult-mark + +(defun consult--mark-candidates (markers) + "Return list of candidates strings for MARKERS." + (consult--forbid-minibuffer) + (let ((candidates) + (current-buf (current-buffer))) + (save-excursion + (dolist (marker markers) + (when-let ((pos (marker-position marker)) + (buf (marker-buffer marker))) + (when (and (eq buf current-buf) + (consult--in-range-p pos)) + (goto-char pos) + ;; `line-number-at-pos' is a very slow function, which should be + ;; replaced everywhere. However in this case the slow + ;; line-number-at-pos does not hurt much, since the mark ring is + ;; usually small since it is limited by `mark-ring-max'. + (push (consult--location-candidate + (consult--line-with-mark marker) marker + (line-number-at-pos pos consult-line-numbers-widen) + marker) + candidates))))) + (unless candidates + (user-error "No marks")) + (nreverse (delete-dups candidates)))) + +;;;###autoload +(defun consult-mark (&optional markers) + "Jump to a marker in MARKERS list (defaults to buffer-local `mark-ring'). + +The command supports preview of the currently selected marker position. +The symbol at point is added to the future history." + (interactive) + (consult--read + (consult--mark-candidates + (or markers (cons (mark-marker) mark-ring))) + :prompt "Go to mark: " + :annotate (consult--line-prefix) + :category 'consult-location + :sort nil + :require-match t + :lookup #'consult--lookup-location + :history '(:input consult--line-history) + :add-history (thing-at-point 'symbol) + :state (consult--jump-state))) + +;;;;; Command: consult-global-mark + +(defun consult--global-mark-candidates (markers) + "Return list of candidates strings for MARKERS." + (consult--forbid-minibuffer) + (let ((candidates)) + (save-excursion + (dolist (marker markers) + (when-let ((pos (marker-position marker)) + (buf (marker-buffer marker))) + (unless (minibufferp buf) + (with-current-buffer buf + (when (consult--in-range-p pos) + (goto-char pos) + ;; `line-number-at-pos' is slow, see comment in `consult--mark-candidates'. + (let* ((line (line-number-at-pos pos consult-line-numbers-widen)) + (prefix (consult--format-file-line-match (buffer-name buf) line "")) + (cand (concat prefix (consult--line-with-mark marker) (consult--tofu-encode marker)))) + (put-text-property 0 (length prefix) 'consult-strip t cand) + (put-text-property 0 (length cand) 'consult-location (cons marker line) cand) + (push cand candidates)))))))) + (unless candidates + (user-error "No global marks")) + (nreverse (delete-dups candidates)))) + +;;;###autoload +(defun consult-global-mark (&optional markers) + "Jump to a marker in MARKERS list (defaults to `global-mark-ring'). + +The command supports preview of the currently selected marker position. +The symbol at point is added to the future history." + (interactive) + (consult--read + (consult--global-mark-candidates + (or markers global-mark-ring)) + :prompt "Go to global mark: " + ;; Despite `consult-global-mark' formatting the candidates in grep-like + ;; style, we are not using the `consult-grep' category, since the candidates + ;; have location markers attached. + :category 'consult-location + :sort nil + :require-match t + :lookup #'consult--lookup-location + :history '(:input consult--line-history) + :add-history (thing-at-point 'symbol) + :state (consult--jump-state))) + +;;;;; Command: consult-line + +(defun consult--line-candidates (top curr-line) + "Return list of line candidates. +Start from top if TOP non-nil. +CURR-LINE is the current line number." + (consult--forbid-minibuffer) + (consult--fontify-all) + (let* ((buffer (current-buffer)) + (line (line-number-at-pos (point-min) consult-line-numbers-widen)) + default-cand candidates) + (consult--each-line beg end + (unless (looking-at-p "^\\s-*$") + (push (consult--location-candidate + (consult--buffer-substring beg end) + (cons buffer beg) line line) + candidates) + (when (and (not default-cand) (>= line curr-line)) + (setq default-cand candidates))) + (cl-incf line)) + (unless candidates + (user-error "No lines")) + (nreverse + (if (or top (not default-cand)) + candidates + (let ((before (cdr default-cand))) + (setcdr default-cand nil) + (nconc before candidates)))))) + +(defun consult--line-point-placement (selected candidates highlighted &rest ignored-faces) + "Find point position on matching line. +SELECTED is the currently selected candidate. +CANDIDATES is the list of candidates. +HIGHLIGHTED is the highlighted string to determine the match position. +IGNORED-FACES are ignored when determining the match position." + (when-let (pos (consult--lookup-location selected candidates)) + (if highlighted + (let* ((matches (apply #'consult--point-placement highlighted 0 ignored-faces)) + (dest (+ pos (car matches)))) + ;; Only create a new marker when jumping across buffers (for example + ;; `consult-line-multi'). Avoid creating unnecessary markers, when + ;; scrolling through candidates, since creating markers is not free. + (when (and (markerp pos) (not (eq (marker-buffer pos) (current-buffer)))) + (setq dest (move-marker (make-marker) dest (marker-buffer pos)))) + (cons dest (cdr matches))) + pos))) + +(defun consult--line-match (selected candidates input &rest _) + "Lookup position of match. +SELECTED is the currently selected candidate. +CANDIDATES is the list of candidates. +INPUT is the input string entered by the user." + (consult--line-point-placement selected candidates + (and (not (string-blank-p input)) + (car (consult--completion-filter + input + (list (substring-no-properties selected)) + 'consult-location 'highlight))) + 'completions-first-difference)) + +;;;###autoload +(defun consult-line (&optional initial start) + "Search for a matching line. + +Depending on the setting `consult-point-placement' the command +jumps to the beginning or the end of the first match on the line +or the line beginning. The default candidate is the non-empty +line next to point. This command obeys narrowing. Optional +INITIAL input can be provided. The search starting point is +changed if the START prefix argument is set. The symbol at point +and the last `isearch-string' is added to the future history." + (interactive (list nil (not (not current-prefix-arg)))) + (let* ((curr-line (line-number-at-pos (point) consult-line-numbers-widen)) + (top (not (eq start consult-line-start-from-top))) + (candidates (consult--slow-operation "Collecting lines..." + (consult--line-candidates top curr-line)))) + (consult--read + candidates + :prompt (if top "Go to line from top: " "Go to line: ") + :annotate (consult--line-prefix curr-line) + :category 'consult-location + :sort nil + :require-match t + ;; Always add last `isearch-string' to future history + :add-history (list (thing-at-point 'symbol) isearch-string) + :history '(:input consult--line-history) + :lookup #'consult--line-match + :default (car candidates) + ;; Add `isearch-string' as initial input if starting from Isearch + :initial (or initial + (and isearch-mode + (prog1 isearch-string (isearch-done)))) + :state (consult--location-state candidates)))) + +;;;;; Command: consult-line-multi + +(defun consult--line-multi-match (selected candidates &rest _) + "Lookup position of match. +SELECTED is the currently selected candidate. +CANDIDATES is the list of candidates." + (consult--line-point-placement selected candidates + (car (member selected candidates)))) + +(defun consult--line-multi-group (cand transform) + "Group function used by `consult-line-multi'. +If TRANSFORM non-nil, return transformed CAND, otherwise return title." + (if transform cand + (let* ((marker (car (get-text-property 0 'consult-location cand))) + (buf (if (consp marker) + (car marker) ;; Handle cheap marker + (marker-buffer marker)))) + (if buf (buffer-name buf) "Dead buffer")))) + +(defun consult--line-multi-candidates (buffers input) + "Collect matching candidates from multiple buffers. +INPUT is the user input which should be matched. +BUFFERS is the list of buffers." + (pcase-let ((`(,regexps . ,hl) + (funcall consult--regexp-compiler + input 'emacs completion-ignore-case)) + (candidates nil) + (cand-idx 0)) + (save-match-data + (dolist (buf buffers (nreverse candidates)) + (with-current-buffer buf + (save-excursion + (let ((line (line-number-at-pos (point-min) consult-line-numbers-widen))) + (goto-char (point-min)) + (while (and (not (eobp)) + (save-excursion (re-search-forward (car regexps) nil t))) + (cl-incf line (consult--count-lines (match-beginning 0))) + (let ((bol (pos-bol)) + (eol (pos-eol))) + (goto-char bol) + (when (and (not (looking-at-p "^\\s-*$")) + (seq-every-p (lambda (r) + (goto-char bol) + (re-search-forward r eol t)) + (cdr regexps))) + (push (consult--location-candidate + (funcall hl (buffer-substring-no-properties bol eol)) + (cons buf bol) (1- line) cand-idx) + candidates) + (cl-incf cand-idx)) + (goto-char (1+ eol))))))))))) + +;;;###autoload +(defun consult-line-multi (query &optional initial) + "Search for a matching line in multiple buffers. + +By default search across all project buffers. If the prefix +argument QUERY is non-nil, all buffers are searched. Optional +INITIAL input can be provided. The symbol at point and the last +`isearch-string' is added to the future history. In order to +search a subset of buffers, QUERY can be set to a plist according +to `consult--buffer-query'." + (interactive "P") + (unless (keywordp (car-safe query)) + (setq query (list :sort 'alpha-current :directory (and (not query) 'project)))) + (pcase-let* ((`(,prompt . ,buffers) (consult--buffer-query-prompt "Go to line" query)) + (collection (consult--dynamic-collection + (apply-partially #'consult--line-multi-candidates + buffers)))) + (consult--read + collection + :prompt prompt + :annotate (consult--line-prefix) + :category 'consult-location + :sort nil + :require-match t + ;; Always add last Isearch string to future history + :add-history (mapcar #'consult--async-split-initial + (delq nil (list (thing-at-point 'symbol) + isearch-string))) + :history '(:input consult--line-multi-history) + :lookup #'consult--line-multi-match + ;; Add `isearch-string' as initial input if starting from Isearch + :initial (consult--async-split-initial + (or initial + (and isearch-mode + (prog1 isearch-string (isearch-done))))) + :state (consult--location-state (lambda () (funcall collection nil))) + :group #'consult--line-multi-group))) + +;;;;; Command: consult-keep-lines + +(defun consult--keep-lines-state (filter) + "State function for `consult-keep-lines' with FILTER function." + (let ((font-lock-orig font-lock-mode) + (whitespace-orig (bound-and-true-p whitespace-mode)) + (hl-line-orig (bound-and-true-p hl-line-mode)) + (point-orig (point)) + lines content-orig replace last-input) + (if (use-region-p) + (save-restriction + ;; Use the same behavior as `keep-lines'. + (let ((rbeg (region-beginning)) + (rend (save-excursion + (goto-char (region-end)) + (unless (or (bolp) (eobp)) + (forward-line 0)) + (point)))) + (consult--fontify-region rbeg rend) + (narrow-to-region rbeg rend) + (consult--each-line beg end + (push (consult--buffer-substring beg end) lines)) + (setq content-orig (buffer-string) + replace (lambda (content &optional pos) + (delete-region rbeg rend) + (insert-before-markers content) + (goto-char (or pos rbeg)) + (setq rend (+ rbeg (length content))) + (add-face-text-property rbeg rend 'region t))))) + (consult--fontify-all) + (setq content-orig (buffer-string) + replace (lambda (content &optional pos) + (delete-region (point-min) (point-max)) + (insert content) + (goto-char (or pos (point-min))))) + (consult--each-line beg end + (push (consult--buffer-substring beg end) lines))) + (setq lines (nreverse lines)) + (lambda (action input) + ;; Restoring content and point position + (when (and (eq action 'return) last-input) + ;; No undo recording, modification hooks, buffer modified-status + (with-silent-modifications (funcall replace content-orig point-orig))) + ;; Committing or new input provided -> Update + (when (and input ;; Input has been provided + (or + ;; Committing, but not with empty input + (and (eq action 'return) (not (string-match-p "\\`!? ?\\'" input))) + ;; Input has changed + (not (equal input last-input)))) + (let ((filtered-content + (if (string-match-p "\\`!? ?\\'" input) + ;; Special case the empty input for performance. + ;; Otherwise it could happen that the minibuffer is empty, + ;; but the buffer has not been updated. + content-orig + (if (eq action 'return) + (apply #'concat (mapcan (lambda (x) (list x "\n")) + (funcall filter input lines))) + (while-no-input + ;; Heavy computation is interruptible if *not* committing! + ;; Allocate new string candidates since the matching function mutates! + (apply #'concat (mapcan (lambda (x) (list x "\n")) + (funcall filter input (mapcar #'copy-sequence lines))))))))) + (when (stringp filtered-content) + (when font-lock-mode (font-lock-mode -1)) + (when (bound-and-true-p whitespace-mode) (whitespace-mode -1)) + (when (bound-and-true-p hl-line-mode) (hl-line-mode -1)) + (if (eq action 'return) + (atomic-change-group + ;; Disable modification hooks for performance + (let ((inhibit-modification-hooks t)) + (funcall replace filtered-content))) + ;; No undo recording, modification hooks, buffer modified-status + (with-silent-modifications + (funcall replace filtered-content) + (setq last-input input)))))) + ;; Restore modes + (when (eq action 'return) + (when hl-line-orig (hl-line-mode 1)) + (when whitespace-orig (whitespace-mode 1)) + (when font-lock-orig (font-lock-mode 1)))))) + +;;;###autoload +(defun consult-keep-lines (filter &optional initial) + "Select a subset of the lines in the current buffer with live preview. + +The selected lines are kept and the other lines are deleted. When called +interactively, the lines selected are those that match the minibuffer input. In +order to match the inverse of the input, prefix the input with `! '. When +called from Elisp, the filtering is performed by a FILTER function. This +command obeys narrowing. + +FILTER is the filter function. +INITIAL is the initial input." + (interactive + (list (lambda (pattern cands) + ;; Use consult-location completion category when filtering lines + (consult--completion-filter-dispatch + pattern cands 'consult-location 'highlight)))) + (consult--forbid-minibuffer) + (let ((ro buffer-read-only)) + (unwind-protect + (minibuffer-with-setup-hook + (lambda () + (when ro + (minibuffer-message + (substitute-command-keys + " [Unlocked read-only buffer. \\[minibuffer-keyboard-quit] to quit.]")))) + (setq buffer-read-only nil) + (consult--with-increased-gc + (consult--prompt + :prompt "Keep lines: " + :initial initial + :history 'consult--line-history + :state (consult--keep-lines-state filter)))) + (setq buffer-read-only ro)))) + +;;;;; Command: consult-focus-lines + +(defun consult--focus-lines-state (filter) + "State function for `consult-focus-lines' with FILTER function." + (let (lines overlays last-input pt-orig pt-min pt-max) + (save-excursion + (save-restriction + (if (not (use-region-p)) + (consult--fontify-all) + (consult--fontify-region (region-beginning) (region-end)) + (narrow-to-region + (region-beginning) + ;; Behave the same as `keep-lines'. + ;; Move to the next line. + (save-excursion + (goto-char (region-end)) + (unless (or (bolp) (eobp)) + (forward-line 0)) + (point)))) + (setq pt-orig (point) pt-min (point-min) pt-max (point-max)) + (let ((i 0)) + (consult--each-line beg end + ;; Use "\n" for empty lines, since we need a non-empty string to + ;; attach the text property to. + (let ((line (if (eq beg end) (char-to-string ?\n) + (buffer-substring-no-properties beg end)))) + (put-text-property 0 1 'consult--focus-line (cons (cl-incf i) beg) line) + (push line lines))) + (setq lines (nreverse lines))))) + (lambda (action input) + ;; New input provided -> Update + (when (and input (not (equal input last-input))) + (let (new-overlays) + (pcase (while-no-input + (unless (string-match-p "\\`!? ?\\'" input) ;; Empty input. + (let* ((inhibit-quit (eq action 'return)) ;; Non interruptible, when quitting! + (not (string-prefix-p "! " input)) + (stripped (string-remove-prefix "! " input)) + (matches (funcall filter stripped lines)) + (old-ind 0) + (block-beg pt-min) + (block-end pt-min)) + (while old-ind + (let ((match (pop matches)) (ind nil) (beg pt-max) (end pt-max) prop) + (when match + (setq prop (get-text-property 0 'consult--focus-line match) + ind (car prop) + beg (cdr prop) + ;; Check for empty lines, see above. + end (+ 1 beg (if (equal match "\n") 0 (length match))))) + (unless (eq ind (1+ old-ind)) + (let ((a (if not block-beg block-end)) + (b (if not block-end beg))) + (when (/= a b) + (push (consult--make-overlay a b 'invisible t) new-overlays))) + (setq block-beg beg)) + (setq block-end end old-ind ind))))) + 'commit) + ('commit + (mapc #'delete-overlay overlays) + (setq last-input input overlays new-overlays)) + (_ (mapc #'delete-overlay new-overlays))))) + (when (eq action 'return) + (cond + ((not input) + (mapc #'delete-overlay overlays) + (goto-char pt-orig)) + ((equal input "") + (consult-focus-lines nil 'show) + (goto-char pt-orig)) + (t + ;; Successfully terminated -> Remember invisible overlays + (setq consult--focus-lines-overlays + (nconc consult--focus-lines-overlays overlays)) + ;; move point past invisible + (goto-char (if-let (ov (and (invisible-p pt-orig) + (seq-find (lambda (ov) (overlay-get ov 'invisible)) + (overlays-at pt-orig)))) + (overlay-end ov) + pt-orig)))))))) + +;;;###autoload +(defun consult-focus-lines (filter &optional show initial) + "Hide or show lines using overlays. + +The selected lines are shown and the other lines hidden. When called +interactively, the lines selected are those that match the minibuffer input. In +order to match the inverse of the input, prefix the input with `! '. With +optional prefix argument SHOW reveal the hidden lines. Alternatively the +command can be restarted to reveal the lines. When called from Elisp, the +filtering is performed by a FILTER function. This command obeys narrowing. + +FILTER is the filter function. +INITIAL is the initial input." + (interactive + (list (lambda (pattern cands) + ;; Use consult-location completion category when filtering lines + (consult--completion-filter-dispatch + pattern cands 'consult-location nil)) + current-prefix-arg)) + (if show + (progn + (mapc #'delete-overlay consult--focus-lines-overlays) + (setq consult--focus-lines-overlays nil) + (message "All lines revealed")) + (consult--forbid-minibuffer) + (consult--with-increased-gc + (consult--prompt + :prompt + (if consult--focus-lines-overlays + "Focus on lines (RET to reveal): " + "Focus on lines: ") + :initial initial + :history 'consult--line-history + :state (consult--focus-lines-state filter))))) + +;;;;; Command: consult-goto-line + +(defun consult--goto-line-position (str msg) + "Transform input STR to line number. +Print an error message with MSG function." + (save-match-data + (if (and str (string-match "\\`\\([[:digit:]]+\\):?\\([[:digit:]]*\\)\\'" str)) + (let ((line (string-to-number (match-string 1 str))) + (col (string-to-number (match-string 2 str)))) + (save-excursion + (save-restriction + (when consult-line-numbers-widen + (widen)) + (goto-char (point-min)) + (forward-line (1- line)) + (goto-char (min (+ (point) col) (pos-eol))) + (point)))) + (when (and str (not (equal str ""))) + (funcall msg "Please enter a number.")) + nil))) + +;;;###autoload +(defun consult-goto-line (&optional arg) + "Read line number and jump to the line with preview. + +Enter either a line number to jump to the first column of the +given line or line:column in order to jump to a specific column. +Jump directly if a line number is given as prefix ARG. The +command respects narrowing and the settings +`consult-goto-line-numbers' and `consult-line-numbers-widen'." + (interactive "P") + (if arg + (call-interactively #'goto-line) + (consult--forbid-minibuffer) + (consult--local-let ((display-line-numbers consult-goto-line-numbers) + (display-line-numbers-widen consult-line-numbers-widen)) + (while (if-let (pos (consult--goto-line-position + (consult--prompt + :prompt "Go to line: " + :history 'goto-line-history + :state + (let ((preview (consult--jump-preview))) + (lambda (action str) + (funcall preview action + (consult--goto-line-position str #'ignore))))) + #'minibuffer-message)) + (consult--jump pos) + t))))) + +;;;;; Command: consult-recent-file + +(defun consult--file-preview () + "Create preview function for files." + (let ((open (consult--temporary-files)) + (preview (consult--buffer-preview))) + (lambda (action cand) + (unless cand + (funcall open)) + (funcall preview action + (and cand + (eq action 'preview) + (funcall open cand)))))) + +(defun consult--file-action (file) + "Open FILE via `consult--buffer-action'." + ;; Try to preserve the buffer as is, if it has already been opened, for + ;; example in literal or raw mode. + (setq file (abbreviate-file-name (expand-file-name file))) + (consult--buffer-action (or (get-file-buffer file) (find-file-noselect file)))) + +(consult--define-state file) + +;;;###autoload +(defun consult-recent-file () + "Find recent file using `completing-read'." + (interactive) + (find-file + (consult--read + (or + (mapcar #'consult--fast-abbreviate-file-name (bound-and-true-p recentf-list)) + (user-error "No recent files, `recentf-mode' is %s" + (if recentf-mode "enabled" "disabled"))) + :prompt "Find recent file: " + :sort nil + :require-match t + :category 'file + :state (consult--file-preview) + :history 'file-name-history))) + +;;;;; Command: consult-mode-command + +(defun consult--mode-name (mode) + "Return name part of MODE." + (replace-regexp-in-string + "global-\\(.*\\)-mode" "\\1" + (replace-regexp-in-string + "\\(-global\\)?-mode\\'" "" + (if (eq mode 'c-mode) + "cc" + (symbol-name mode)) + 'fixedcase) + 'fixedcase)) + +(defun consult--mode-command-candidates (modes) + "Extract commands from MODES. + +The list of features is searched for files belonging to the modes. +From these files, the commands are extracted." + (let* ((case-fold-search) + (buffer (current-buffer)) + (command-filter (consult--regexp-filter (seq-filter #'stringp consult-mode-command-filter))) + (feature-filter (seq-filter #'symbolp consult-mode-command-filter)) + (minor-hash (consult--string-hash minor-mode-list)) + (minor-local-modes (seq-filter (lambda (m) + (and (gethash m minor-hash) + (local-variable-if-set-p m))) + modes)) + (minor-global-modes (seq-filter (lambda (m) + (and (gethash m minor-hash) + (not (local-variable-if-set-p m)))) + modes)) + (major-modes (seq-remove (lambda (m) + (gethash m minor-hash)) + modes)) + (major-paths-hash (consult--string-hash (mapcar #'symbol-file major-modes))) + (minor-local-paths-hash (consult--string-hash (mapcar #'symbol-file minor-local-modes))) + (minor-global-paths-hash (consult--string-hash (mapcar #'symbol-file minor-global-modes))) + (major-name-regexp (regexp-opt (mapcar #'consult--mode-name major-modes))) + (minor-local-name-regexp (regexp-opt (mapcar #'consult--mode-name minor-local-modes))) + (minor-global-name-regexp (regexp-opt (mapcar #'consult--mode-name minor-global-modes))) + (commands)) + (dolist (feature load-history commands) + (when-let (name (alist-get 'provide feature)) + (let* ((path (car feature)) + (file (file-name-nondirectory path)) + (key (cond + ((memq name feature-filter) nil) + ((or (gethash path major-paths-hash) + (string-match-p major-name-regexp file)) + ?m) + ((or (gethash path minor-local-paths-hash) + (string-match-p minor-local-name-regexp file)) + ?l) + ((or (gethash path minor-global-paths-hash) + (string-match-p minor-global-name-regexp file)) + ?g)))) + (when key + (dolist (cmd (cdr feature)) + (let ((sym (cdr-safe cmd))) + (when (and (consp cmd) + (eq (car cmd) 'defun) + (commandp sym) + (not (get sym 'byte-obsolete-info)) + (or (not read-extended-command-predicate) + (funcall read-extended-command-predicate sym buffer))) + (let ((name (symbol-name sym))) + (unless (string-match-p command-filter name) + (push (propertize name + 'consult--candidate sym + 'consult--type key) + commands)))))))))))) + +;;;###autoload +(defun consult-mode-command (&rest modes) + "Run a command from any of the given MODES. + +If no MODES are specified, use currently active major and minor modes." + (interactive) + (unless modes + (setq modes (cons major-mode + (seq-filter (lambda (m) + (and (boundp m) (symbol-value m))) + minor-mode-list)))) + (let ((narrow `((?m . ,(format "Major: %s" major-mode)) + (?l . "Local Minor") + (?g . "Global Minor")))) + (command-execute + (consult--read + (consult--mode-command-candidates modes) + :prompt "Mode command: " + :predicate + (lambda (cand) + (let ((key (get-text-property 0 'consult--type cand))) + (if consult--narrow + (= key consult--narrow) + (/= key ?g)))) + :lookup #'consult--lookup-candidate + :group (consult--type-group narrow) + :narrow narrow + :require-match t + :history 'extended-command-history + :category 'command)))) + +;;;;; Command: consult-yank + +(defun consult--read-from-kill-ring () + "Open kill ring menu and return selected string." + ;; `current-kill' updates `kill-ring' with interprogram paste, see + ;; gh:minad/consult#443. + (current-kill 0) + ;; Do not specify a :lookup function in order to preserve completion-styles + ;; highlighting of the current candidate. We have to perform a final lookup to + ;; obtain the original candidate which may be propertized with yank-specific + ;; properties, like 'yank-handler. + (consult--lookup-member + (consult--read + (consult--remove-dups + (or (if yank-from-kill-ring-rotate + (append kill-ring-yank-pointer + (butlast kill-ring (length kill-ring-yank-pointer))) + kill-ring) + (user-error "Kill ring is empty"))) + :prompt "Yank from kill-ring: " + :history t ;; disable history + :sort nil + :category 'kill-ring + :require-match t + :state + (consult--insertion-preview + (point) + ;; If previous command is yank, hide previously yanked string + (or (and (eq last-command 'yank) (mark t)) (point)))) + kill-ring)) + +;; Adapted from the Emacs `yank-from-kill-ring' function. +;;;###autoload +(defun consult-yank-from-kill-ring (string &optional arg) + "Select STRING from the kill ring and insert it. +With prefix ARG, put point at beginning, and mark at end, like `yank' does. + +This command behaves like `yank-from-kill-ring', which also offers a +`completing-read' interface to the `kill-ring'. Additionally the +Consult version supports preview of the selected string." + (interactive (list (consult--read-from-kill-ring) current-prefix-arg)) + (when string + (setq yank-window-start (window-start)) + (push-mark) + (insert-for-yank string) + (setq this-command 'yank) + (when yank-from-kill-ring-rotate + (if-let (pos (seq-position kill-ring string)) + (setq kill-ring-yank-pointer (nthcdr pos kill-ring)) + (kill-new string))) + (when (consp arg) + ;; Swap point and mark like in `yank'. + (goto-char (prog1 (mark t) + (set-marker (mark-marker) (point) (current-buffer))))))) + +(put 'consult-yank-replace 'delete-selection 'yank) +(put 'consult-yank-pop 'delete-selection 'yank) +(put 'consult-yank-from-kill-ring 'delete-selection 'yank) + +;;;###autoload +(defun consult-yank-pop (&optional arg) + "If there is a recent yank act like `yank-pop'. + +Otherwise select string from the kill ring and insert it. +See `yank-pop' for the meaning of ARG. + +This command behaves like `yank-pop', which also offers a +`completing-read' interface to the `kill-ring'. Additionally the +Consult version supports preview of the selected string." + (interactive "*p") + (if (eq last-command 'yank) + (yank-pop (or arg 1)) + (call-interactively #'consult-yank-from-kill-ring))) + +;; Adapted from the Emacs yank-pop function. +;;;###autoload +(defun consult-yank-replace (string) + "Select STRING from the kill ring. + +If there was no recent yank, insert the string. +Otherwise replace the just-yanked string with the selected string." + (interactive (list (consult--read-from-kill-ring))) + (when string + (if (not (eq last-command 'yank)) + (consult-yank-from-kill-ring string) + (let ((inhibit-read-only t) + (pt (point)) + (mk (mark t))) + (setq this-command 'yank) + (funcall (or yank-undo-function 'delete-region) (min pt mk) (max pt mk)) + (setq yank-undo-function nil) + (set-marker (mark-marker) pt (current-buffer)) + (insert-for-yank string) + (set-window-start (selected-window) yank-window-start t) + (if (< pt mk) + (goto-char (prog1 (mark t) + (set-marker (mark-marker) (point) (current-buffer))))))))) + +;;;;; Command: consult-bookmark + +(defun consult--bookmark-preview () + "Create preview function for bookmarks." + (let ((preview (consult--jump-preview)) + (open (consult--temporary-files))) + (lambda (action cand) + (unless cand + (funcall open)) + (funcall + preview action + ;; Only preview bookmarks with the default handler. + (when-let ((bm (and cand (eq action 'preview) (assoc cand bookmark-alist))) + (handler (or (bookmark-get-handler bm) #'bookmark-default-handler)) + ((eq handler #'bookmark-default-handler)) + (file (bookmark-get-filename bm)) + (pos (bookmark-get-position bm)) + (buf (funcall open file))) + (set-marker (make-marker) pos buf)))))) + +(defun consult--bookmark-action (bm) + "Open BM via `consult--buffer-action'." + (bookmark-jump bm consult--buffer-display)) + +(consult--define-state bookmark) + +(defun consult--bookmark-candidates () + "Return bookmark candidates." + (bookmark-maybe-load-default-file) + (let ((narrow (cl-loop for (y _ . xs) in consult-bookmark-narrow nconc + (cl-loop for x in xs collect (cons x y))))) + (cl-loop for bm in bookmark-alist collect + (propertize (car bm) + 'consult--type + (alist-get + (or (bookmark-get-handler bm) #'bookmark-default-handler) + narrow))))) + +;;;###autoload +(defun consult-bookmark (name) + "If bookmark NAME exists, open it, otherwise create a new bookmark with NAME. + +The command supports preview of file bookmarks and narrowing. See the +variable `consult-bookmark-narrow' for the narrowing configuration." + (interactive + (list + (let ((narrow (cl-loop for (x y . _) in consult-bookmark-narrow collect (cons x y)))) + (consult--read + (consult--bookmark-candidates) + :prompt "Bookmark: " + :state (consult--bookmark-preview) + :category 'bookmark + :history 'bookmark-history + ;; Add default names to future history. + ;; Ignore errors such that `consult-bookmark' can be used in + ;; buffers which are not backed by a file. + :add-history (ignore-errors (bookmark-prop-get (bookmark-make-record) 'defaults)) + :group (consult--type-group narrow) + :narrow (consult--type-narrow narrow))))) + (bookmark-maybe-load-default-file) + (if (assoc name bookmark-alist) + (bookmark-jump name) + (bookmark-set name))) + +;;;;; Command: consult-complex-command + +;;;###autoload +(defun consult-complex-command () + "Select and evaluate command from the command history. + +This command can act as a drop-in replacement for `repeat-complex-command'." + (interactive) + (let* ((history (or (delete-dups (mapcar #'prin1-to-string command-history)) + (user-error "There are no previous complex commands"))) + (cmd (read (consult--read + history + :prompt "Command: " + :default (car history) + :sort nil + :history t ;; disable history + :category 'expression)))) + ;; Taken from `repeat-complex-command' + (add-to-history 'command-history cmd) + (apply #'funcall-interactively + (car cmd) + (mapcar (lambda (e) (eval e t)) (cdr cmd))))) + +;;;;; Command: consult-history + +(declare-function ring-elements "ring") + +(defun consult--current-history () + "Return the history and index variable relevant to the current buffer. +If the minibuffer is active, the minibuffer history is returned, +otherwise the history corresponding to the mode. There is a +special case for `repeat-complex-command', for which the command +history is used." + (cond + ;; In the minibuffer we use the current minibuffer history, + ;; which can be configured by setting `minibuffer-history-variable'. + ((minibufferp) + (when (eq minibuffer-history-variable t) + (user-error "Minibuffer history is disabled for `%s'" this-command)) + (list (mapcar #'consult--tofu-hide + (if (eq minibuffer-history-variable 'command-history) + ;; If pressing "C-x M-:", i.e., `repeat-complex-command', + ;; we are instead querying the `command-history' and get a + ;; full s-expression. Alternatively you might want to use + ;; `consult-complex-command', which can also be bound to + ;; "C-x M-:"! + (mapcar #'prin1-to-string command-history) + (symbol-value minibuffer-history-variable))))) + ;; Otherwise we use a mode-specific history, see `consult-mode-histories'. + (t (let ((found (seq-find (lambda (h) + (and (derived-mode-p (car h)) + (boundp (if (consp (cdr h)) (cadr h) (cdr h))))) + consult-mode-histories))) + (unless found + (user-error "No history configured for `%s', see `consult-mode-histories'" + major-mode)) + (cons (symbol-value (cadr found)) (cddr found)))))) + +;;;###autoload +(defun consult-history (&optional history index bol) + "Insert string from HISTORY of current buffer. +In order to select from a specific HISTORY, pass the history +variable as argument. INDEX is the name of the index variable to +update, if any. BOL is the function which jumps to the beginning +of the prompt. See also `cape-history' from the Cape package." + (interactive) + (pcase-let* ((`(,history ,index ,bol) (if history + (list history index bol) + (consult--current-history))) + (history (if (ring-p history) (ring-elements history) history)) + (`(,beg . ,end) + (if (minibufferp) + (cons (minibuffer-prompt-end) (point-max)) + (if bol + (save-excursion + (funcall bol) + (cons (point) (pos-eol))) + (cons (point) (point))))) + (str (consult--local-let ((enable-recursive-minibuffers t)) + (consult--read + (or (consult--remove-dups history) + (user-error "History is empty")) + :prompt "History: " + :history t ;; disable history + :category ;; Report category depending on history variable + (and (minibufferp) + (pcase minibuffer-history-variable + ('extended-command-history 'command) + ('buffer-name-history 'buffer) + ('face-name-history 'face) + ('read-envvar-name-history 'environment-variable) + ('bookmark-history 'bookmark) + ('file-name-history 'file))) + :sort nil + :initial (buffer-substring-no-properties beg end) + :state (consult--insertion-preview beg end))))) + (delete-region beg end) + (when index + (set index (seq-position history str))) + (insert (substring-no-properties str)))) + +;;;;; Command: consult-isearch-history + +(defun consult-isearch-forward (&optional reverse) + "Continue Isearch forward optionally in REVERSE." + (declare (completion ignore)) + (interactive) + (consult--require-minibuffer) + (setq isearch-new-forward (not reverse) isearch-new-nonincremental nil) + (funcall (or (command-remapping #'exit-minibuffer) #'exit-minibuffer))) + +(defun consult-isearch-backward (&optional reverse) + "Continue Isearch backward optionally in REVERSE." + (declare (completion ignore)) + (interactive) + (consult-isearch-forward (not reverse))) + +(defvar-keymap consult-isearch-history-map + :doc "Additional keymap used by `consult-isearch-history'." + "<remap> <isearch-forward>" #'consult-isearch-forward + "<remap> <isearch-backward>" #'consult-isearch-backward) + +(defun consult--isearch-history-candidates () + "Return Isearch history candidates." + ;; Do not throw an error on empty history, in order to allow starting a + ;; search. We do not :require-match here. + (let ((history (if (eq t search-default-mode) + (append regexp-search-ring search-ring) + (append search-ring regexp-search-ring)))) + (delete-dups + (mapcar + (lambda (cand) + ;; The search type can be distinguished via text properties. + (let* ((props (plist-member (text-properties-at 0 cand) + 'isearch-regexp-function)) + (type (pcase (cadr props) + ((and 'nil (guard (not props))) ?r) + ('nil ?l) + ('word-search-regexp ?w) + ('isearch-symbol-regexp ?s) + ('char-fold-to-regexp ?c) + (_ ?u)))) + ;; Disambiguate history items. The same string could + ;; occur with different search types. + (consult--tofu-append cand type))) + history)))) + +(defconst consult--isearch-history-narrow + '((?c . "Char") + (?u . "Custom") + (?l . "Literal") + (?r . "Regexp") + (?s . "Symbol") + (?w . "Word"))) + +;;;###autoload +(defun consult-isearch-history () + "Read a search string with completion from the Isearch history. + +This replaces the current search string if Isearch is active, and +starts a new Isearch session otherwise." + (interactive) + (consult--forbid-minibuffer) + (let* ((isearch-message-function #'ignore) + (cursor-in-echo-area t) ;; Avoid cursor flickering + (candidates (consult--isearch-history-candidates))) + (unless isearch-mode (isearch-mode t)) + (with-isearch-suspended + (setq isearch-new-string + (consult--read + candidates + :prompt "I-search: " + :category 'consult-isearch-history + :history t ;; disable history + :sort nil + :initial isearch-string + :keymap consult-isearch-history-map + :annotate + (lambda (cand) + (consult--annotate-align + cand + (alist-get (consult--tofu-get cand) consult--isearch-history-narrow))) + :group + (lambda (cand transform) + (if transform + cand + (alist-get (consult--tofu-get cand) consult--isearch-history-narrow))) + :lookup + (lambda (selected candidates &rest _) + (if-let (found (member selected candidates)) + (substring (car found) 0 -1) + selected)) + :state + (lambda (action cand) + (when (and (eq action 'preview) cand) + (setq isearch-string cand) + (isearch-update-from-string-properties cand) + (isearch-update))) + :narrow + (list :predicate + (lambda (cand) (= (consult--tofu-get cand) consult--narrow)) + :keys consult--isearch-history-narrow)) + isearch-new-message + (mapconcat 'isearch-text-char-description isearch-new-string ""))) + ;; Setting `isearch-regexp' etc only works outside of `with-isearch-suspended'. + (unless (plist-member (text-properties-at 0 isearch-string) 'isearch-regexp-function) + (setq isearch-regexp t + isearch-regexp-function nil)))) + +;;;;; Command: consult-minor-mode-menu + +(defun consult--minor-mode-candidates () + "Return list of minor-mode candidate strings." + (mapcar + (pcase-lambda (`(,name . ,sym)) + (propertize + name + 'consult--candidate sym + 'consult--minor-mode-narrow + (logior + (ash (if (local-variable-if-set-p sym) ?l ?g) 8) + (if (and (boundp sym) (symbol-value sym)) ?i ?o)) + 'consult--minor-mode-group + (concat + (if (local-variable-if-set-p sym) "Local " "Global ") + (if (and (boundp sym) (symbol-value sym)) "On" "Off")))) + (nconc + ;; according to describe-minor-mode-completion-table-for-symbol + ;; the minor-mode-list contains *all* minor modes + (mapcar (lambda (sym) (cons (symbol-name sym) sym)) minor-mode-list) + ;; take the lighters from minor-mode-alist + (delq nil + (mapcar (pcase-lambda (`(,sym ,lighter)) + (when (and lighter (not (equal "" lighter))) + (let (message-log-max) + (setq lighter (string-trim (format-mode-line lighter))) + (unless (string-blank-p lighter) + (cons lighter sym))))) + minor-mode-alist))))) + +(defconst consult--minor-mode-menu-narrow + '((?l . "Local") + (?g . "Global") + (?i . "On") + (?o . "Off"))) + +;;;###autoload +(defun consult-minor-mode-menu () + "Enable or disable minor mode. + +This is an alternative to `minor-mode-menu-from-indicator'." + (interactive) + (call-interactively + (consult--read + (consult--minor-mode-candidates) + :prompt "Minor mode: " + :require-match t + :category 'minor-mode + :group + (lambda (cand transform) + (if transform cand (get-text-property 0 'consult--minor-mode-group cand))) + :narrow + (list :predicate + (lambda (cand) + (let ((narrow (get-text-property 0 'consult--minor-mode-narrow cand))) + (or (= (logand narrow 255) consult--narrow) + (= (ash narrow -8) consult--narrow)))) + :keys + consult--minor-mode-menu-narrow) + :lookup #'consult--lookup-candidate + :history 'consult--minor-mode-menu-history))) + +;;;;; Command: consult-theme + +;;;###autoload +(defun consult-theme (theme) + "Disable current themes and enable THEME from `consult-themes'. + +The command supports previewing the currently selected theme." + (interactive + (list + (let* ((regexp (consult--regexp-filter + (mapcar (lambda (x) (if (stringp x) x (format "\\`%s\\'" x))) + consult-themes))) + (avail-themes (seq-filter + (lambda (x) (string-match-p regexp (symbol-name x))) + (cons 'default (custom-available-themes)))) + (saved-theme (car custom-enabled-themes))) + (consult--read + (mapcar #'symbol-name avail-themes) + :prompt "Theme: " + :require-match t + :category 'theme + :history 'consult--theme-history + :lookup (lambda (selected &rest _) + (setq selected (and selected (intern-soft selected))) + (or (and selected (car (memq selected avail-themes))) + saved-theme)) + :state (lambda (action theme) + (pcase action + ('return (consult-theme (or theme saved-theme))) + ((and 'preview (guard theme)) (consult-theme theme)))) + :default (symbol-name (or saved-theme 'default)))))) + (when (eq theme 'default) (setq theme nil)) + (unless (eq theme (car custom-enabled-themes)) + (mapc #'disable-theme custom-enabled-themes) + (when theme + (if (custom-theme-p theme) + (enable-theme theme) + (load-theme theme :no-confirm))))) + +;;;;; Command: consult-buffer + +(defun consult--buffer-sort-alpha (buffers) + "Sort BUFFERS alphabetically, put starred buffers at the end." + (sort buffers + (lambda (x y) + (setq x (buffer-name x) y (buffer-name y)) + (let ((a (and (length> x 0) (eq (aref x 0) ?*))) + (b (and (length> y 0) (eq (aref y 0) ?*)))) + (if (eq a b) + (string< x y) + (not a)))))) + +(defun consult--buffer-sort-alpha-current (buffers) + "Sort BUFFERS alphabetically, put current at the beginning." + (let ((buffers (consult--buffer-sort-alpha buffers)) + (current (current-buffer))) + (if (memq current buffers) + (cons current (delq current buffers)) + buffers))) + +(defun consult--buffer-sort-visibility (buffers) + "Sort BUFFERS by visibility." + (let ((hidden) + (current (car (memq (current-buffer) buffers)))) + (consult--keep! buffers + (unless (eq it current) + (if (get-buffer-window it 'visible) + it + (push it hidden) + nil))) + (nconc (nreverse hidden) buffers (and current (list current))))) + +(defun consult--normalize-directory (dir) + "Normalize directory DIR. +DIR can be project, nil or a path." + (cond + ((eq dir 'project) (consult--project-root)) + (dir (expand-file-name dir)))) + +(defun consult--buffer-query-prompt (prompt query) + "Return a list of buffers and create an appropriate prompt string. +Return a pair of a prompt string and a list of buffers. PROMPT +is the prefix of the prompt string. QUERY specifies the buffers +to search and is passed to `consult--buffer-query'." + (let* ((dir (plist-get query :directory)) + (ndir (consult--normalize-directory dir)) + (buffers (apply #'consult--buffer-query :directory ndir query)) + (count (length buffers))) + (cons (format "%s (%d buffer%s%s): " prompt count + (if (= count 1) "" "s") + (cond + ((and ndir (eq dir 'project)) + (format ", Project %s" (consult--project-name ndir))) + (ndir (concat ", " (consult--left-truncate-file ndir))) + (t ""))) + buffers))) + +(cl-defun consult--buffer-query (&key sort directory mode as predicate (filter t) + include (exclude consult-buffer-filter) + (buffer-list t)) + "Query for a list of matching buffers. +The function supports filtering by various criteria which are +used throughout Consult. In particular it is the backbone of +most `consult-buffer-sources'. +DIRECTORY can either be the symbol project or a file name. +SORT can be visibility, alpha or nil. +FILTER can be either t, nil or invert. +EXCLUDE is a list of regexps. +INCLUDE is a list of regexps. +MODE can be a mode or a list of modes to restrict the returned buffers. +PREDICATE is a predicate function. +BUFFER-LIST is the unfiltered list of buffers. +AS is a conversion function." + (let ((root (consult--normalize-directory directory))) + (setq buffer-list (if (eq buffer-list t) (buffer-list) (copy-sequence buffer-list))) + (when sort + (setq buffer-list (funcall (intern (format "consult--buffer-sort-%s" sort)) buffer-list))) + (when (or filter mode as root) + (let ((exclude-re (consult--regexp-filter exclude)) + (include-re (consult--regexp-filter include)) + (case-fold-search)) + (consult--keep! buffer-list + (and + (or (not mode) + (let ((mm (buffer-local-value 'major-mode it))) + (if (consp mode) + (seq-some (lambda (m) (provided-mode-derived-p mm m)) mode) + (provided-mode-derived-p mm mode)))) + (pcase-exhaustive filter + ('nil t) + ((or 't 'invert) + (eq (eq filter t) + (and + (or (not exclude) + (not (string-match-p exclude-re (buffer-name it)))) + (or (not include) + (not (not (string-match-p include-re (buffer-name it))))))))) + (or (not root) + (when-let (dir (buffer-local-value 'default-directory it)) + (string-prefix-p root + (if (and (/= 0 (length dir)) (eq (aref dir 0) ?/)) + dir + (expand-file-name dir))))) + (or (not predicate) (funcall predicate it)) + (if as (funcall as it) it))))) + buffer-list)) + +(defun consult--buffer-file-hash () + "Return hash table of all buffer file names." + (consult--string-hash (consult--buffer-query :as #'buffer-file-name))) + +(defun consult--buffer-pair (buffer) + "Return a pair of name of BUFFER and BUFFER." + (cons (buffer-name buffer) buffer)) + +(defun consult--buffer-preview () + "Buffer preview function." + (let ((orig-buf (window-buffer (consult--original-window))) + (orig-prev (copy-sequence (window-prev-buffers))) + (orig-next (copy-sequence (window-next-buffers))) + other-win) + (lambda (action cand) + (pcase action + ('exit + (set-window-prev-buffers other-win orig-prev) + (set-window-next-buffers other-win orig-next)) + ('preview + (when (and (eq consult--buffer-display #'switch-to-buffer-other-window) + (not other-win)) + (switch-to-buffer-other-window orig-buf 'norecord) + (setq other-win (selected-window))) + (let ((win (or other-win (selected-window))) + (buf (or (and cand (get-buffer cand)) orig-buf))) + (when (and (window-live-p win) (buffer-live-p buf) + (not (buffer-match-p consult-preview-excluded-buffers buf))) + (with-selected-window win + (unless (or orig-prev orig-next) + (setq orig-prev (copy-sequence (window-prev-buffers)) + orig-next (copy-sequence (window-next-buffers)))) + (switch-to-buffer buf 'norecord))))))))) + +(defun consult--buffer-action (buffer &optional norecord) + "Switch to BUFFER via `consult--buffer-display' function. +If NORECORD is non-nil, do not record the buffer switch in the buffer list." + (funcall consult--buffer-display buffer norecord)) + +(consult--define-state buffer) + +(defvar consult--source-bookmark + `( :name "Bookmark" + :narrow ?m + :category bookmark + :face consult-bookmark + :history bookmark-history + :items ,#'bookmark-all-names + :state ,#'consult--bookmark-state) + "Bookmark candidate source for `consult-buffer'.") + +(defvar consult--source-project-buffer + `( :name "Project Buffer" + :narrow ?b + :category buffer + :face consult-buffer + :history buffer-name-history + :state ,#'consult--buffer-state + :enabled ,(lambda () consult-project-function) + :items + ,(lambda () + (when-let (root (consult--project-root)) + (consult--buffer-query :sort 'visibility + :directory root + :as #'consult--buffer-pair)))) + "Project buffer candidate source for `consult-buffer'.") + +(defvar consult--source-project-recent-file + `( :name "Project File" + :narrow ?f + :category file + :face consult-file + :history file-name-history + :state ,#'consult--file-state + :new + ,(lambda (file) + (consult--file-action + (expand-file-name file (consult--project-root)))) + :enabled + ,(lambda () + (and consult-project-function + recentf-mode)) + :items + ,(lambda () + (when-let (root (consult--project-root)) + (let ((len (length root)) + (ht (consult--buffer-file-hash)) + items) + (dolist (file (bound-and-true-p recentf-list) (nreverse items)) + ;; Emacs 29 abbreviates file paths by default, see + ;; `recentf-filename-handlers'. I recommend to set + ;; `recentf-filename-handlers' to nil to avoid any slow down. + (unless (eq (aref file 0) ?/) + (let (file-name-handler-alist) ;; No Tramp slowdown please. + (setq file (expand-file-name file)))) + (when (and (not (gethash file ht)) (string-prefix-p root file)) + (let ((part (substring file len))) + (when (equal part "") (setq part "./")) + (put-text-property 0 1 'multi-category `(file . ,file) part) + (push part items)))))))) + "Project file candidate source for `consult-buffer'.") + +(defvar consult--source-project-buffer-hidden + `(:hidden t :narrow (?p . "Project") ,@consult--source-project-buffer) + "Like `consult--source-project-buffer' but hidden by default.") + +(defvar consult--source-project-recent-file-hidden + `(:hidden t :narrow (?p . "Project") ,@consult--source-project-recent-file) + "Like `consult--source-project-recent-file' but hidden by default.") + +(defvar consult--source-hidden-buffer + `( :name "Hidden Buffer" + :narrow ?\s + :hidden t + :category buffer + :face consult-buffer + :history buffer-name-history + :action ,#'consult--buffer-action + :items + ,(lambda () (consult--buffer-query :sort 'visibility + :filter 'invert + :as #'consult--buffer-pair))) + "Hidden buffer candidate source for `consult-buffer'.") + +(defvar consult--source-modified-buffer + `( :name "Modified Buffer" + :narrow ?* + :hidden t + :category buffer + :face consult-buffer + :history buffer-name-history + :state ,#'consult--buffer-state + :items + ,(lambda () (consult--buffer-query :sort 'visibility + :as #'consult--buffer-pair + :predicate + (lambda (buf) + (and (buffer-modified-p buf) + (buffer-file-name buf)))))) + "Modified buffer candidate source for `consult-buffer'.") + +(defvar consult--source-buffer + `( :name "Buffer" + :narrow ?b + :category buffer + :face consult-buffer + :history buffer-name-history + :state ,#'consult--buffer-state + :default t + :items + ,(lambda () (consult--buffer-query :sort 'visibility + :as #'consult--buffer-pair))) + "Buffer candidate source for `consult-buffer'.") + +(defun consult--file-register-p (reg) + "Return non-nil if REG is a file register." + (memq (car-safe (cdr reg)) '(file-query file))) + +(autoload 'consult-register--candidates "consult-register") +(defvar consult--source-file-register + `( :name "File Register" + :narrow (?r . "Register") + :category file + :state ,#'consult--file-state + :enabled ,(lambda () (seq-some #'consult--file-register-p register-alist)) + :items ,(lambda () (consult-register--candidates #'consult--file-register-p))) + "File register source.") + +(defvar consult--source-recent-file + `( :name "File" + :narrow ?f + :category file + :face consult-file + :history file-name-history + :state ,#'consult--file-state + :new ,#'consult--file-action + :enabled ,(lambda () recentf-mode) + :items + ,(lambda () + (let ((ht (consult--buffer-file-hash)) + items) + (dolist (file (bound-and-true-p recentf-list) (nreverse items)) + ;; Emacs 29 abbreviates file paths by default, see + ;; `recentf-filename-handlers'. I recommend to set + ;; `recentf-filename-handlers' to nil to avoid any slow down. + (unless (eq (aref file 0) ?/) + (let (file-name-handler-alist) ;; No Tramp slowdown please. + (setq file (expand-file-name file)))) + (unless (gethash file ht) + (push (consult--fast-abbreviate-file-name file) items)))))) + "Recent file candidate source for `consult-buffer'.") + +;;;###autoload +(defun consult-buffer (&optional sources) + "Enhanced `switch-to-buffer' command with support for virtual buffers. + +The command supports recent files, bookmarks, views and project files as +virtual buffers. Buffers are previewed. Narrowing to buffers (b), files (f), +bookmarks (m) and project files (p) is supported via the corresponding +keys. In order to determine the project-specific files and buffers, the +`consult-project-function' is used. The virtual buffer SOURCES +default to `consult-buffer-sources'. See `consult--multi' for the +configuration of the virtual buffer sources." + (interactive) + (let ((selected (consult--multi (or sources consult-buffer-sources) + :require-match + (confirm-nonexistent-file-or-buffer) + :prompt "Switch to: " + :history 'consult--buffer-history + :sort nil))) + ;; For non-matching candidates, fall back to buffer creation. + (unless (plist-get (cdr selected) :match) + (consult--buffer-action (car selected))))) + +(defmacro consult--with-project (&rest body) + "Ensure that BODY is executed with a project root." + ;; We have to work quite hard here to ensure that the project root is + ;; only overridden at the current recursion level. When entering a + ;; recursive minibuffer session, we should be able to still switch the + ;; project. But who does that? Working on the first level on project A + ;; and on the second level on project B and on the third level on project C? + ;; You mustn't be afraid to dream a little bigger, darling. + `(let ((consult-project-function + (let ((root (or (consult--project-root t) (user-error "No project found"))) + (depth (recursion-depth)) + (orig consult-project-function)) + (lambda (may-prompt) + (if (= depth (recursion-depth)) + root + (funcall orig may-prompt)))))) + ,@body)) + +;;;###autoload +(defun consult-project-buffer () + "Enhanced `project-switch-to-buffer' command with support for virtual buffers. +The command may prompt you for a project directory if it is invoked from +outside a project. See `consult-buffer' for more details." + (interactive) + (consult--with-project + (consult-buffer consult-project-buffer-sources))) + +;;;###autoload +(defun consult-buffer-other-window () + "Variant of `consult-buffer', switching to a buffer in another window." + (interactive) + (let ((consult--buffer-display #'switch-to-buffer-other-window)) + (consult-buffer))) + +;;;###autoload +(defun consult-buffer-other-frame () + "Variant of `consult-buffer', switching to a buffer in another frame." + (interactive) + (let ((consult--buffer-display #'switch-to-buffer-other-frame)) + (consult-buffer))) + +;;;###autoload +(defun consult-buffer-other-tab () + "Variant of `consult-buffer', switching to a buffer in another tab." + (interactive) + (let ((consult--buffer-display #'switch-to-buffer-other-tab)) + (consult-buffer))) + +;;;;; Command: consult-grep + +(defun consult--grep-format (async builder) + "Return ASYNC function highlighting grep match results. +BUILDER is the command line builder function." + (let (highlight) + (lambda (action) + (cond + ((stringp action) + (setq highlight (cdr (funcall builder action))) + (funcall async action)) + ((consp action) + (let ((file "") (file-len 0) result) + (save-match-data + (dolist (str action) + (when (and (string-match consult--grep-match-regexp str) + ;; Filter out empty context lines + (or (/= (aref str (match-beginning 3)) ?-) + (/= (match-end 0) (length str)))) + ;; We share the file name across candidates to reduce + ;; the amount of allocated memory. + (unless (and (= file-len (- (match-end 1) (match-beginning 1))) + (eq t (compare-strings + file 0 file-len + str (match-beginning 1) (match-end 1) nil))) + (setq file (match-string 1 str) + file-len (length file))) + (let* ((line (match-string 2 str)) + (ctx (= (aref str (match-beginning 3)) ?-)) + (sep (if ctx "-" ":")) + (content (substring str (match-end 0))) + (line-len (length line))) + (when (and consult-grep-max-columns + (length> content consult-grep-max-columns)) + (setq content (substring content 0 consult-grep-max-columns))) + (when highlight + (funcall highlight content)) + (setq str (concat file sep line sep content)) + ;; Store file name in order to avoid allocations in `consult--prefix-group' + (add-text-properties 0 file-len `(face consult-file consult--prefix-group ,file) str) + (put-text-property (1+ file-len) (+ 1 file-len line-len) 'face 'consult-line-number str) + (when ctx + (add-face-text-property (+ 2 file-len line-len) (length str) 'consult-grep-context 'append str)) + (push str result))))) + (funcall async (nreverse result)))) + (t (funcall async action)))))) + +(defun consult--grep-position (cand &optional find-file) + "Return the grep position marker for CAND. +FIND-FILE is the file open function, defaulting to `find-file-noselect'." + (when cand + (let* ((file-end (next-single-property-change 0 'face cand)) + (line-end (next-single-property-change (1+ file-end) 'face cand)) + (matches (consult--point-placement cand (1+ line-end) 'consult-grep-context)) + (file (substring-no-properties cand 0 file-end)) + (line (string-to-number (substring-no-properties cand (+ 1 file-end) line-end)))) + (when-let (pos (consult--marker-from-line-column + (funcall (or find-file #'consult--file-action) file) + line (or (car matches) 0))) + (cons pos (cdr matches)))))) + +(defun consult--grep-state () + "Grep state function." + (let ((open (consult--temporary-files)) + (jump (consult--jump-state))) + (lambda (action cand) + (unless cand + (funcall open)) + (funcall jump action (consult--grep-position + cand + (and (not (eq action 'return)) open)))))) + +(defun consult--grep-exclude-args () + "Produce grep exclude arguments. +Take the variables `grep-find-ignored-directories' and +`grep-find-ignored-files' into account." + (unless (boundp 'grep-find-ignored-files) (require 'grep)) + (nconc (mapcar (lambda (s) (concat "--exclude=" s)) + (bound-and-true-p grep-find-ignored-files)) + (mapcar (lambda (s) (concat "--exclude-dir=" s)) + (bound-and-true-p grep-find-ignored-directories)))) + +(defun consult--grep (prompt make-builder dir initial) + "Run asynchronous grep. + +MAKE-BUILDER is the function that returns the command line +builder function. DIR is a directory or a list of file or +directories. PROMPT is the prompt string. INITIAL is initial +input." + (pcase-let* ((`(,prompt ,paths ,dir) (consult--directory-prompt prompt dir)) + (default-directory dir) + (builder (funcall make-builder paths))) + (consult--read + (consult--async-command builder + (consult--grep-format builder) + :file-handler t) ;; allow tramp + :prompt prompt + :lookup #'consult--lookup-member + :state (consult--grep-state) + :initial (consult--async-split-initial initial) + :add-history (consult--async-split-thingatpt 'symbol) + :require-match t + :category 'consult-grep + :group #'consult--prefix-group + :history '(:input consult--grep-history) + :sort nil))) + +(defun consult--grep-lookahead-p (&rest cmd) + "Return t if grep CMD supports look-ahead." + (eq 0 (process-file-shell-command + (concat "echo xaxbx | " + (mapconcat #'shell-quote-argument `(,@cmd "^(?=.*b)(?=.*a)") " "))))) + +(defun consult--grep-make-builder (paths) + "Build grep command line and grep across PATHS." + (let* ((cmd (consult--build-args consult-grep-args)) + (type (if (consult--grep-lookahead-p (car cmd) "-P") 'pcre 'extended))) + (lambda (input) + (pcase-let* ((`(,arg . ,opts) (consult--command-split input)) + (flags (append cmd opts)) + (ignore-case (or (member "-i" flags) (member "--ignore-case" flags)))) + (if (or (member "-F" flags) (member "--fixed-strings" flags)) + (cons (append cmd (list "-e" arg) opts paths) + (apply-partially #'consult--highlight-regexps + (list (regexp-quote arg)) ignore-case)) + (pcase-let ((`(,re . ,hl) (funcall consult--regexp-compiler arg type ignore-case))) + (when re + (cons (append cmd + (list (if (eq type 'pcre) "-P" "-E") ;; perl or extended + "-e" (consult--join-regexps re type)) + opts paths) + hl)))))))) + +;;;###autoload +(defun consult-grep (&optional dir initial) + "Search with `grep' for files in DIR where the content matches a regexp. + +The initial input is given by the INITIAL argument. DIR can be nil, a +directory string or a list of file/directory paths. If `consult-grep' +is called interactively with a prefix argument, the user can specify the +directories or files to search in. Multiple directories or files must +be separated by comma in the minibuffer, since they are read via +`completing-read-multiple'. By default the project directory is used if +`consult-project-function' is defined and returns non-nil. Otherwise +the `default-directory' is searched. If the command is invoked with a +double prefix argument (twice `C-u') the user is asked for a project, if +not yet inside a project, or the current project is searched. + +The input string is split, the first part of the string (grep input) is +passed to the asynchronous grep process and the second part of the +string is passed to the completion-style filtering. + +The input string is split at a punctuation character, which is given as +the first character of the input string. The format is similar to +Perl-style regular expressions, e.g., /regexp/. Furthermore command +line options can be passed to grep, specified behind --. The overall +prompt input has the form `#async-input -- grep-opts#filter-string'. + +Note that the grep input string is transformed from Emacs regular +expressions to Posix regular expressions. Always enter Emacs regular +expressions at the prompt. `consult-grep' behaves like builtin Emacs +search commands, e.g., Isearch, which take Emacs regular expressions. +Furthermore the asynchronous input split into words, each word must +match separately and in any order. See `consult--regexp-compiler' for +the inner workings. In order to disable transformations of the grep +input, adjust `consult--regexp-compiler' accordingly. + +Here we give a few example inputs: + +#alpha beta : Search for alpha and beta in any order. +#alpha.*beta : Search for alpha before beta. +#\\(alpha\\|beta\\) : Search for alpha or beta (Note Emacs syntax!) +#word -- -C3 : Search for word, include 3 lines as context +#first#second : Search for first, quick filter for second. + +The symbol at point is added to the future history." + (interactive "P") + (consult--grep "Grep" #'consult--grep-make-builder dir initial)) + +;;;;; Command: consult-git-grep + +(defun consult--git-grep-make-builder (paths) + "Create grep command line builder given PATHS." + (let ((cmd (consult--build-args consult-git-grep-args))) + (lambda (input) + (pcase-let* ((`(,arg . ,opts) (consult--command-split input)) + (flags (append cmd opts)) + (ignore-case (or (member "-i" flags) (member "--ignore-case" flags)))) + (if (or (member "-F" flags) (member "--fixed-strings" flags)) + (cons (append cmd (list "-e" arg) opts paths) + (apply-partially #'consult--highlight-regexps + (list (regexp-quote arg)) ignore-case)) + (pcase-let ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'extended ignore-case))) + (when re + (cons (append cmd + (cdr (mapcan (lambda (x) (list "--and" "-e" x)) re)) + opts paths) + hl)))))))) + +;;;###autoload +(defun consult-git-grep (&optional dir initial) + "Search with `git grep' for files in DIR with INITIAL input. +See `consult-grep' for details." + (interactive "P") + (consult--grep "Git-grep" #'consult--git-grep-make-builder dir initial)) + +;;;;; Command: consult-ripgrep + +(defun consult--ripgrep-make-builder (paths) + "Create ripgrep command line builder given PATHS." + (let* ((cmd (consult--build-args consult-ripgrep-args)) + (type (if (consult--grep-lookahead-p (car cmd) "-P") 'pcre 'extended))) + (lambda (input) + (pcase-let* ((`(,arg . ,opts) (consult--command-split input)) + (flags (append cmd opts)) + (ignore-case + (and (not (or (member "-s" flags) (member "--case-sensitive" flags))) + (or (member "-i" flags) (member "--ignore-case" flags) + (and (or (member "-S" flags) (member "--smart-case" flags)) + (let (case-fold-search) + ;; Case insensitive if there are no uppercase letters + (not (string-match-p "[[:upper:]]" arg)))))))) + (if (or (member "-F" flags) (member "--fixed-strings" flags)) + (cons (append cmd (list "-e" arg) opts paths) + (apply-partially #'consult--highlight-regexps + (list (regexp-quote arg)) ignore-case)) + (pcase-let ((`(,re . ,hl) (funcall consult--regexp-compiler arg type ignore-case))) + (when re + (cons (append cmd (and (eq type 'pcre) '("-P")) + (list "-e" (consult--join-regexps re type)) + opts paths) + hl)))))))) + +;;;###autoload +(defun consult-ripgrep (&optional dir initial) + "Search with `rg' for files in DIR with INITIAL input. +See `consult-grep' for details." + (interactive "P") + (consult--grep "Ripgrep" #'consult--ripgrep-make-builder dir initial)) + +;;;;; Command: consult-find + +(defun consult--find (prompt builder initial) + "Run find command in current directory. + +The function returns the selected file. +The filename at point is added to the future history. + +BUILDER is the command line builder function. +PROMPT is the prompt. +INITIAL is initial input." + (consult--read + (consult--async-command builder + (consult--async-map (lambda (x) (string-remove-prefix "./" x))) + (consult--async-highlight builder) + :file-handler t) ;; allow tramp + :prompt prompt + :sort nil + :require-match t + :initial (consult--async-split-initial initial) + :add-history (consult--async-split-thingatpt 'filename) + :category 'file + :history '(:input consult--find-history))) + +(defun consult--find-make-builder (paths) + "Build find command line, finding across PATHS." + (let* ((cmd (seq-mapcat (lambda (x) + (if (equal x ".") paths (list x))) + (consult--build-args consult-find-args))) + (type (if (eq 0 (process-file-shell-command + (concat (car cmd) " -regextype emacs -version"))) + 'emacs 'basic))) + (lambda (input) + (pcase-let* ((`(,arg . ,opts) (consult--command-split input)) + ;; ignore-case=t since -iregex is used below + (`(,re . ,hl) (funcall consult--regexp-compiler arg type t))) + (when re + (cons (append cmd + (cdr (mapcan + (lambda (x) + `("-and" "-iregex" + ,(format ".*%s.*" + ;; Replace non-capturing groups with capturing groups. + ;; GNU find does not support non-capturing groups. + (replace-regexp-in-string + "\\\\(\\?:" "\\(" x 'fixedcase 'literal)))) + re)) + opts) + hl)))))) + +;;;###autoload +(defun consult-find (&optional dir initial) + "Search for files with `find' in DIR. +The file names must match the input regexp. INITIAL is the +initial minibuffer input. See `consult-grep' for details +regarding the asynchronous search and the arguments." + (interactive "P") + (pcase-let* ((`(,prompt ,paths ,dir) (consult--directory-prompt "Find" dir)) + (default-directory dir) + (builder (consult--find-make-builder paths))) + (find-file (consult--find prompt builder initial)))) + +;;;;; Command: consult-fd + +(defun consult--fd-make-builder (paths) + "Build find command line, finding across PATHS." + (let ((cmd (consult--build-args consult-fd-args))) + (lambda (input) + (pcase-let* ((`(,arg . ,opts) (consult--command-split input)) + (flags (append cmd opts)) + (ignore-case + (and (not (or (member "-s" flags) (member "--case-sensitive" flags))) + (or (member "-i" flags) (member "--ignore-case" flags) + (let (case-fold-search) + ;; Case insensitive if there are no uppercase letters + (not (string-match-p "[[:upper:]]" arg))))))) + (if (or (member "-F" flags) (member "--fixed-strings" flags)) + (cons (append cmd (list arg) opts paths) + (apply-partially #'consult--highlight-regexps + (list (regexp-quote arg)) ignore-case)) + (pcase-let ((`(,re . ,hl) (funcall consult--regexp-compiler arg 'pcre ignore-case))) + (when re + (cons (append cmd + (mapcan (lambda (x) `("--and" ,x)) re) + opts + (mapcan (lambda (x) `("--search-path" ,x)) paths)) + hl)))))))) + +;;;###autoload +(defun consult-fd (&optional dir initial) + "Search for files with `fd' in DIR. +The file names must match the input regexp. INITIAL is the +initial minibuffer input. See `consult-grep' for details +regarding the asynchronous search and the arguments." + (interactive "P") + (pcase-let* ((`(,prompt ,paths ,dir) (consult--directory-prompt "Fd" dir)) + (default-directory dir) + (builder (consult--fd-make-builder paths))) + (find-file (consult--find prompt builder initial)))) + +;;;;; Command: consult-locate + +(defun consult--locate-builder (input) + "Build command line from INPUT." + (pcase-let ((`(,arg . ,opts) (consult--command-split input))) + (unless (string-blank-p arg) + (cons (append (consult--build-args consult-locate-args) + (consult--split-escaped arg) opts) + (cdr (consult--default-regexp-compiler input 'basic t)))))) + +;;;###autoload +(defun consult-locate (&optional initial) + "Search with `locate' for files which match input given INITIAL input. + +The input is treated literally such that locate can take advantage of +the locate database index. Regular expressions would often force a slow +linear search through the entire database. The locate process is started +asynchronously, similar to `consult-grep'. See `consult-grep' for more +details regarding the asynchronous search." + (interactive) + (find-file (consult--find "Locate: " #'consult--locate-builder initial))) + +;;;;; Command: consult-man + +(defun consult--man-builder (input) + "Build command line from INPUT." + (pcase-let* ((`(,arg . ,opts) (consult--command-split input)) + (`(,re . ,hl) (funcall consult--regexp-compiler arg 'extended t))) + (when re + (cons (append (consult--build-args consult-man-args) + (list (consult--join-regexps re 'extended)) + opts) + hl)))) + +(defun consult--man-format (lines) + "Format man candidates from LINES." + (let ((candidates)) + (save-match-data + (dolist (str lines) + (when (string-match "\\`\\(.*?\\([^ ]+\\) *(\\([^,)]+\\)[^)]*).*?\\) +- +\\(.*\\)\\'" str) + (let* ((names (match-string 1 str)) + (name (match-string 2 str)) + (section (match-string 3 str)) + (desc (match-string 4 str)) + (cand (format "%s - %s" names desc))) + (add-text-properties 0 (length names) + (list 'face 'consult-file + 'consult-man (concat section " " name)) + cand) + (push cand candidates))))) + (nreverse candidates))) + +;;;###autoload +(defun consult-man (&optional initial) + "Search for man page given INITIAL input. + +The input string is not preprocessed and passed literally to the +underlying man commands. The man process is started asynchronously, +similar to `consult-grep'. See `consult-grep' for more details regarding +the asynchronous search." + (interactive) + (man (consult--read + (consult--async-command #'consult--man-builder + (consult--async-transform consult--man-format) + (consult--async-highlight #'consult--man-builder)) + :prompt "Manual entry: " + :require-match t + :category 'consult-man + :lookup (apply-partially #'consult--lookup-prop 'consult-man) + :initial (consult--async-split-initial initial) + :add-history (consult--async-split-thingatpt 'symbol) + :history '(:input consult--man-history)))) + +;;;; Preview at point in completions buffers + +(define-minor-mode consult-preview-at-point-mode + "Preview minor mode for *Completions* buffers. +When moving around in the *Completions* buffer, the candidate at point is +automatically previewed." + :group 'consult + (if consult-preview-at-point-mode + (add-hook 'post-command-hook #'consult-preview-at-point nil 'local) + (remove-hook 'post-command-hook #'consult-preview-at-point 'local))) + +(defun consult-preview-at-point () + "Preview candidate at point in *Completions* buffer." + (interactive) + (when-let ((win (active-minibuffer-window)) + (buf (window-buffer win)) + (fun (buffer-local-value 'consult--preview-function buf))) + (funcall fun))) + +;;;; Integration with completion systems + +;;;;; Integration: Default *Completions* + +(defun consult--default-completion-minibuffer-candidate () + "Return current minibuffer candidate from default completion system or Icomplete." + (when (and (minibufferp) + (eq completing-read-function #'completing-read-default)) + (let ((content (minibuffer-contents-no-properties))) + ;; When the current minibuffer content matches a candidate, return it! + (if (test-completion content + minibuffer-completion-table + minibuffer-completion-predicate) + content + ;; Return the full first candidate of the sorted completion list. + (when-let ((completions (completion-all-sorted-completions))) + (concat + (substring content 0 (or (cdr (last completions)) 0)) + (car completions))))))) + +(defun consult--default-completion-list-candidate () + "Return current candidate at point from completions buffer." + ;; See feature request bug#74408 for `completion-list-candidate-at-point'. + (let (beg) + (when (and + (derived-mode-p 'completion-list-mode) + (cond + ((and (not (eobp)) (get-text-property (point) 'completion--string)) + (setq beg (1+ (point)))) + ((and (not (bobp)) (get-text-property (1- (point)) 'completion--string)) + (setq beg (point))))) + (get-text-property (previous-single-property-change beg 'completion--string) + 'completion--string)))) + +;;;;; Integration: Vertico + +(defvar vertico--input) +(declare-function vertico--exhibit "ext:vertico") +(declare-function vertico--candidate "ext:vertico") +(declare-function vertico--filter-completions "ext:vertico") + +(defun consult--vertico-candidate () + "Return current candidate for Consult preview." + (and vertico--input (vertico--candidate 'highlight))) + +(defun consult--vertico-refresh () + "Refresh completion UI." + (when vertico--input + (setq vertico--input t) + (vertico--exhibit))) + +(defun consult--vertico-filter-adv (orig pattern cands category highlight) + "Advice for ORIG `consult--completion-filter' function. +See `consult--completion-filter' for arguments PATTERN, CANDS, CATEGORY +and HIGHLIGHT." + (if (and (not highlight) (bound-and-true-p vertico-mode)) + ;; Optimize `consult--completion-filter' using the deferred highlighting + ;; from Vertico. The advice is not necessary - it is a pure optimization. + (nconc (car (vertico--filter-completions pattern cands nil (length pattern) + `(metadata (category . ,category)))) + nil) + (funcall orig pattern cands category highlight))) + +(with-eval-after-load 'vertico + (advice-add #'consult--completion-filter :around #'consult--vertico-filter-adv) + (add-hook 'consult--completion-candidate-hook #'consult--vertico-candidate) + (add-hook 'consult--completion-refresh-hook #'consult--vertico-refresh) + (define-key consult-async-map [remap vertico-insert] 'vertico-next-group)) + +;;;;; Integration: Mct + +(with-eval-after-load 'mct (add-hook 'consult--completion-refresh-hook + 'mct--live-completions-refresh)) + +;;;;; Integration: Icomplete + +(defvar icomplete-mode) +(declare-function icomplete-exhibit "icomplete") + +(defun consult--icomplete-refresh () + "Refresh icomplete view." + (when icomplete-mode + (let ((top (car completion-all-sorted-completions))) + (completion--flush-all-sorted-completions) + ;; force flushing, otherwise narrowing is broken! + (setq completion-all-sorted-completions nil) + (when top + (let* ((completions (completion-all-sorted-completions)) + (last (last completions)) + (before)) ;; completions before top + ;; warning: completions is an improper list + (while (consp completions) + (if (equal (car completions) top) + (progn + (setcdr last (append (nreverse before) (cdr last))) + (setq completion-all-sorted-completions completions + completions nil)) + (push (car completions) before) + (setq completions (cdr completions))))))) + (icomplete-exhibit))) + +(with-eval-after-load 'icomplete + (add-hook 'consult--completion-refresh-hook #'consult--icomplete-refresh)) + +(provide 'consult) +;;; consult.el ends here diff --git a/emacs/elpa/consult-20241117.2113/consult.elc b/emacs/elpa/consult-20241117.2113/consult.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-autotools.el b/emacs/elpa/lsp-mode-20241113.743/lsp-autotools.el @@ -1,78 +0,0 @@ -;;; lsp-autotools.el --- Support configure.ac, Makefile.am, Makefile -*- lexical-binding: t; -*- - -;; Copyright (C) 2023 Jen-Chieh Shen - -;; Author: Jen-Chieh Shen <jcs090218@gmail.com> -;; Keywords: autotools lsp - -;; 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: - -;; Support configure.ac, Makefile.am, Makefile - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-autotools nil - "LSP support for Autotools." - :group 'lsp-mode - :link '(url-link "https://github.com/Freed-Wu/autotools-language-server") - :package-version `(lsp-mode . "9.0.0")) - -(defcustom lsp-autotools-active-modes - '( autoconf-mode - makefile-mode - makefile-automake-mode - makefile-gmake-mode - makefile-makepp-mode - makefile-bsdmake-mode - makefile-imake-mode) - "List of major mode that work with Autotools." - :type 'list - :group 'lsp-autotools) - -(defun lsp-autotools--download-server (_client callback error-callback update?) - "Install/update Autotools language server using `pip - -Will invoke CALLBACK or ERROR-CALLBACK based on result. -Will update if UPDATE? is t." - (lsp-async-start-process - callback - error-callback - "pip" "install" "autotools-language-server" (when update? "-U"))) - -(defun lsp-autotools--server-command () - "Startup command for Autotools language server." - (list "autotools-language-server")) - -(defun lsp-autotools--test-present () - "Return non-nil if Autotools language server is installed globally." - (executable-find "autotools-language-server")) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection - #'lsp-autotools--server-command - #'lsp-autotools--test-present) - :major-modes lsp-autotools-active-modes - :priority -1 - :server-id 'autotools-ls - :download-server-fn #'lsp-autotools--download-server)) - -(lsp-consistency-check lsp-autotools) - -(provide 'lsp-autotools) -;;; lsp-autotools.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-autotools.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-autotools.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-awk.el b/emacs/elpa/lsp-mode-20241113.743/lsp-awk.el @@ -1,49 +0,0 @@ -;;; lsp-awk.el --- AWK client -*- lexical-binding: t; -*- - -;; Copyright (C) 2023 emacs-lsp maintainers - -;; Author: Konstantin Kharlamov <Hi-Angel@yandex.ru> -;; Keywords: languages lsp awk - -;; 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: -;; -;; LSP client for AWK language. -;; - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-awk nil - "LSP support for AWK." - :group 'lsp-mode - :link '(url-link "https://github.com/Beaglefoot/awk-language-server")) - -(defcustom lsp-awk-executable '("awk-language-server") - "Command to run the AWK language server." - :group 'lsp-awk - :risky t - :type 'list) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection (lambda () lsp-awk-executable)) - :activation-fn (lsp-activate-on "awk") - :priority -1 - :server-id 'awkls)) - -(provide 'lsp-awk) -;;; lsp-awk.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-awk.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-awk.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-camel.el b/emacs/elpa/lsp-mode-20241113.743/lsp-camel.el @@ -1,68 +0,0 @@ -;;; lsp-camel.el --- LSP Camel server integration -*- lexical-binding: t; -*- - - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-camel nil - "LSP support for Camel, using camel-language-server" - :group 'lsp-mode - :tag "Language Server" - :package-version '(lsp-mode . "9.0.0")) - -;; Define a variable to store camel language server jar version -(defconst lsp-camel-jar-version "1.5.0") - -;; Define a variable to store camel language server jar name -(defconst lsp-camel-jar-name (format "camel-lsp-server-%s.jar" lsp-camel-jar-version)) - -;; Directory in which the servers will be installed. Lsp Server Install Dir: ~/.emacs.d/.cache/camells -(defcustom lsp-camel-jar-file (f-join lsp-server-install-dir "camells" lsp-camel-jar-name) - "Camel Language server jar command." - :type 'string - :group 'lsp-camel - :type 'file - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-camel-jar-download-url - (format "https://repo1.maven.org/maven2/com/github/camel-tooling/camel-lsp-server/%s/%s" lsp-camel-jar-version lsp-camel-jar-name) - "Automatic download url for lsp-camel." - :type 'string - :group 'lsp-camel - :package-version '(lsp-mode . "9.0.0")) - -(lsp-dependency - 'camells - '(:system lsp-camel-jar-file) - `(:download :url lsp-camel-jar-download-url - :store-path lsp-camel-jar-file)) - -(defcustom lsp-camel-server-command `("java" "-jar" , lsp-camel-jar-file) - "Camel server command." - :type '(repeat string) - :group 'lsp-camel - :package-version '(lsp-mode . "9.0.0")) - -(defun lsp-camel--create-connection () - (lsp-stdio-connection - (lambda () lsp-camel-server-command) - (lambda () (f-exists? lsp-camel-jar-file)))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-camel--create-connection) - :activation-fn (lsp-activate-on "xml" "java") - :priority 0 - :server-id 'camells - :add-on? t - :multi-root t - :initialized-fn (lambda (workspace) - (with-lsp-workspace workspace - (lsp--set-configuration (lsp-configuration-section "camel")))) - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'camells callback error-callback)))) - -(lsp-consistency-check lsp-camel) - -(provide 'lsp-camel) -;;; lsp-camel.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-camel.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-camel.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-clangd.el b/emacs/elpa/lsp-mode-20241113.743/lsp-clangd.el @@ -1,318 +0,0 @@ -;;; lsp-clangd.el --- LSP clients for the C Languages Family -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 Daniel Martin & emacs-lsp maintainers -;; URL: https://github.com/emacs-lsp/lsp-mode -;; Keywords: languages, c, cpp, clang - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; LSP clients for the C Languages Family. - -;; ** Clang-tidy Flycheck integration (Clangd) ** -;; -;; If you invoke `flycheck-display-error-explanation' on a -;; `clang-tidy' error (if Clangd is configured to show `clang-tidy' -;; diagnostics), Emacs will open a detailed explanation about the -;; message by querying the LLVM website. As an embedded web browser is -;; used to show the documentation, this feature requires that Emacs is -;; compiled with libxml2 support. - -;;; Code: - -(require 'lsp-mode) -(require 'cl-lib) -(require 'rx) -(require 'seq) -(require 'dom) -(eval-when-compile (require 'subr-x)) - -(require 'dash) -(require 's) - -(defvar flycheck-explain-error-buffer) -(declare-function flycheck-error-id "ext:flycheck" (err) t) -(declare-function flycheck-error-group "ext:flycheck" (err) t) -(declare-function flycheck-error-message "ext:flycheck" (err) t) - -(defcustom lsp-clangd-version "15.0.6" - "Clangd version to download. -It has to be set before `lsp-clangd.el' is loaded and it has to -be available here: https://github.com/clangd/clangd/releases/" - :type 'string - :group 'lsp-clangd - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-clangd-download-url - (format (pcase system-type - ('darwin "https://github.com/clangd/clangd/releases/download/%s/clangd-mac-%s.zip") - ('windows-nt "https://github.com/clangd/clangd/releases/download/%s/clangd-windows-%s.zip") - (_ "https://github.com/clangd/clangd/releases/download/%s/clangd-linux-%s.zip")) - lsp-clangd-version - lsp-clangd-version) - "Automatic download url for clangd" - :type 'string - :group 'lsp-clangd - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-clangd-binary-path - (f-join lsp-server-install-dir (format "clangd/clangd_%s/bin" - lsp-clangd-version) - (pcase system-type - ('windows-nt "clangd.exe") - (_ "clangd"))) - "The path to `clangd' binary." - :type 'file - :group 'lsp-clangd - :package-version '(lsp-mode . "8.0.0")) - -(lsp-dependency - 'clangd - `(:download :url lsp-clangd-download-url - :decompress :zip - :store-path ,(f-join lsp-server-install-dir "clangd" "clangd.zip") - :binary-path lsp-clangd-binary-path - :set-executable? t)) - -(defun lsp-cpp-flycheck-clang-tidy--skip-http-headers () - "Position point just after HTTP headers." - (re-search-forward "^$")) - -(defun lsp-cpp-flycheck-clang-tidy--narrow-to-http-body () - "Narrow the current buffer to contain the body of an HTTP response." - (lsp-cpp-flycheck-clang-tidy--skip-http-headers) - (narrow-to-region (point) (point-max))) - -(defun lsp-cpp-flycheck-clang-tidy--decode-region-as-utf8 (start end) - "Decode a region from START to END in UTF-8." - (condition-case nil - (decode-coding-region start end 'utf-8) - (coding-system-error nil))) - -(defun lsp-cpp-flycheck-clang-tidy--remove-crlf () - "Remove carriage return and line feeds from the current buffer." - (save-excursion - (while (re-search-forward "\r$" nil t) - (replace-match "" t t)))) - -(defun lsp-cpp-flycheck-clang-tidy--extract-relevant-doc-section () - "Extract the parts of the LLVM clang-tidy documentation that are relevant. - -This function assumes that the current buffer contains the result -of browsing `clang.llvm.org', as returned by `url-retrieve'. -More concretely, this function returns the main <div> element -with class `section', and also removes `headerlinks'." - (goto-char (point-min)) - (lsp-cpp-flycheck-clang-tidy--narrow-to-http-body) - (lsp-cpp-flycheck-clang-tidy--decode-region-as-utf8 (point-min) (point-max)) - (lsp-cpp-flycheck-clang-tidy--remove-crlf) - (let* ((dom (libxml-parse-html-region (point-min) (point-max))) - (section (dom-by-class dom "section"))) - (dolist (headerlink (dom-by-class section "headerlink")) - (dom-remove-node section headerlink)) - section)) - -(defun lsp-cpp-flycheck-clang-tidy--explain-error (explanation &rest args) - "Explain an error in the Flycheck error explanation buffer using EXPLANATION. - -EXPLANATION is a function with optional ARGS that, when -evaluated, inserts the content in the appropriate Flycheck -buffer." - (with-current-buffer flycheck-explain-error-buffer - (let ((inhibit-read-only t) - (inhibit-modification-hooks t)) - (erase-buffer) - (apply explanation args) - (goto-char (point-min))))) - -(defun lsp-cpp-flycheck-clang-tidy--show-loading-status () - "Show a loading string while clang-tidy documentation is fetched from llvm.org. -Recent versions of `flycheck' call `display-message-or-buffer' to -display error explanations. `display-message-or-buffer' displays -the documentation string either in the echo area or in a separate -window, depending on the string's height. This function forces to -always display it in a separate window by appending the required -number of newlines." - (let* ((num-lines-threshold - (round (if resize-mini-windows - (cond ((floatp max-mini-window-height) - (* (frame-height) - max-mini-window-height)) - ((integerp max-mini-window-height) - max-mini-window-height) - (t - 1)) - 1))) - (extra-new-lines (make-string (1+ num-lines-threshold) ?\n))) - (concat "Loading documentation..." extra-new-lines))) - -(defun lsp-cpp-flycheck-clang-tidy--show-documentation (error-id) - "Show clang-tidy documentation about ERROR-ID. - -Information comes from the clang.llvm.org website." - ;; Example error-id: modernize-loop-convert - ;; Example url: https://clang.llvm.org/extra/clang-tidy/checks/modernize/loop-convert.html - (setq error-id (s-join "/" (s-split-up-to "-" error-id 1 t))) - (url-retrieve (format - "https://clang.llvm.org/extra/clang-tidy/checks/%s.html" error-id) - (lambda (status) - (if-let ((error-status (plist-get status :error))) - (lsp-cpp-flycheck-clang-tidy--explain-error - #'insert - (format - "Error accessing clang-tidy documentation: %s" - (error-message-string error-status))) - (let ((doc-contents - (lsp-cpp-flycheck-clang-tidy--extract-relevant-doc-section))) - (lsp-cpp-flycheck-clang-tidy--explain-error - #'shr-insert-document doc-contents))))) - (lsp-cpp-flycheck-clang-tidy--show-loading-status)) - -;;;###autoload -(defun lsp-cpp-flycheck-clang-tidy-error-explainer (error) - "Explain a clang-tidy ERROR by scraping documentation from llvm.org." - (unless (fboundp 'libxml-parse-html-region) - (error "This function requires Emacs to be compiled with libxml2")) - (if-let ((clang-tidy-error-id (flycheck-error-id error))) - (condition-case err - (lsp-cpp-flycheck-clang-tidy--show-documentation clang-tidy-error-id) - (error - (format - "Error accessing clang-tidy documentation: %s" - (error-message-string err)))) - (error "The clang-tidy error message does not contain an [error-id]"))) - - -;;; lsp-clangd -(defgroup lsp-clangd nil - "LSP support for C-family languages (C, C++, Objective-C, Objective-C++, CUDA), using clangd." - :group 'lsp-mode - :link '(url-link "https://clang.llvm.org/extra/clangd")) - -(defcustom lsp-clients-clangd-executable nil - "The clangd executable to use. -When `'non-nil' use the name of the clangd executable file -available in your path to use. Otherwise the system will try to -find a suitable one. Set this variable before loading lsp." - :group 'lsp-clangd - :risky t - :type '(choice (file :tag "Path") - (const :tag "Auto" nil))) - -(defvar lsp-clients--clangd-default-executable nil - "Clang default executable full path when found. -This must be set only once after loading the clang client.") - -(defcustom lsp-clients-clangd-args '("--header-insertion-decorators=0") - "Extra arguments for the clangd executable." - :group 'lsp-clangd - :risky t - :type '(repeat string)) - -(defcustom lsp-clients-clangd-library-directories '("/usr") - "List of directories which will be considered to be libraries." - :risky t - :type '(repeat string) - :group 'lsp-clangd - :package-version '(lsp-mode . "9.0.0")) - -(defun lsp-clients--clangd-command () - "Generate the language server startup command." - (unless lsp-clients--clangd-default-executable - (setq lsp-clients--clangd-default-executable - (or (lsp-package-path 'clangd) - (-first #'executable-find - (-map (lambda (version) - (concat "clangd" version)) - ;; Prefer `clangd` without a version number appended. - (cl-list* "" (-map - (lambda (vernum) (format "-%d" vernum)) - (number-sequence 17 6 -1))))) - (lsp-clients-executable-find "xcodebuild" "-find-executable" "clangd") - (lsp-clients-executable-find "xcrun" "--find" "clangd")))) - - `(,(or lsp-clients-clangd-executable lsp-clients--clangd-default-executable "clangd") - ,@lsp-clients-clangd-args)) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection - 'lsp-clients--clangd-command) - :activation-fn (lsp-activate-on "c" "cpp" "objective-c" "cuda") - :priority -1 - :server-id 'clangd - :library-folders-fn (lambda (_workspace) lsp-clients-clangd-library-directories) - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'clangd callback error-callback)))) - -(defun lsp-clangd-join-region (beg end) - "Apply join-line from BEG to END. -This function is useful when an indented function prototype needs -to be shown in a single line." - (save-excursion - (let ((end (copy-marker end))) - (goto-char beg) - (while (< (point) end) - (join-line 1))) - (s-trim (buffer-string)))) - -(cl-defmethod lsp-clients-extract-signature-on-hover (contents (_server-id (eql clangd))) - "Extract a representative line from clangd's CONTENTS, to show in the echo area. -This function tries to extract the type signature from CONTENTS, -or the first line if it cannot do so. A single line is always -returned to avoid that the echo area grows uncomfortably." - (with-temp-buffer - (-let [value (lsp:markup-content-value contents)] - (insert value) - (goto-char (point-min)) - (if (re-search-forward (rx (seq "```cpp\n" - (opt (group "//" - (zero-or-more nonl) - "\n")) - (group - (one-or-more - (not (any "`"))) - "\n") - "```")) nil t nil) - (progn (narrow-to-region (match-beginning 2) (match-end 2)) - (lsp--render-element (lsp-make-marked-string - :language "cpp" - :value (lsp-clangd-join-region (point-min) (point-max))))) - (car (s-lines (lsp--render-element contents))))))) - -(cl-defmethod lsp-diagnostics-flycheck-error-explainer (e (_server-id (eql clangd))) - "Explain a `flycheck-error' E that was generated by the Clangd language server." - (cond ((string-equal "clang-tidy" (flycheck-error-group e)) - (lsp-cpp-flycheck-clang-tidy-error-explainer e)) - (t (flycheck-error-message e)))) - -(defun lsp-clangd-find-other-file (&optional new-window) - "Switch between the corresponding C/C++ source and header file. -If NEW-WINDOW (interactively the prefix argument) is non-nil, -open in a new window. - -Only works with clangd." - (interactive "P") - (let ((other (lsp-send-request (lsp-make-request - "textDocument/switchSourceHeader" - (lsp--text-document-identifier))))) - (unless (s-present? other) - (user-error "Could not find other file")) - (funcall (if new-window #'find-file-other-window #'find-file) - (lsp--uri-to-path other)))) - -(lsp-consistency-check lsp-clangd) - -(provide 'lsp-clangd) -;;; lsp-clangd.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-clojure.el b/emacs/elpa/lsp-mode-20241113.743/lsp-clojure.el @@ -1,618 +0,0 @@ -;;; lsp-clojure.el --- Clojure Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Benedek Fazekas - -;; Author: Benedek Fazekas <benedek.fazekas@gmail.com> -;; Keywords: languages,tools - -;; 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: - -;; lsp-clojure client - -;;; Code: - -(require 'lsp-mode) -(require 'lsp-protocol) -(require 'cl-lib) -(require 'lsp-semantic-tokens) - -(defgroup lsp-clojure nil - "LSP support for Clojure." - :link '(url-link "https://github.com/snoe/clojure-lsp") - :group 'lsp-mode - :tag "Lsp Clojure") - -(define-obsolete-variable-alias 'lsp-clojure-server-command - 'lsp-clojure-custom-server-command "lsp-mode 8.0.0") - -(defcustom lsp-clojure-custom-server-command nil - "The clojure-lisp server command." - :group 'lsp-clojure - :risky t - :type '(repeat string)) - -(defcustom lsp-clojure-server-download-url - (format "https://github.com/clojure-lsp/clojure-lsp/releases/latest/download/clojure-lsp-native-%s.zip" - (let ((arch (car (split-string system-configuration "-")))) - (pcase system-type - ('gnu/linux (concat "linux-" - (cond - ((string= "x86_64" arch) "amd64") - (t arch)))) - ('darwin (concat "macos-" - (cond - ((string= "x86_64" arch) "amd64") - (t arch)))) - ('windows-nt "windows-amd64")))) - "Automatic download url for lsp-clojure." - :type 'string - :group 'lsp-clojure - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-clojure-server-store-path - (f-join lsp-server-install-dir - "clojure" - (if (eq system-type 'windows-nt) - "clojure-lsp.exe" - "clojure-lsp")) - "The path to the file in which `clojure-lsp' will be stored." - :type 'file - :group 'lsp-clojure - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-clojure-trace-enable nil - "Enable trace logs between client and clojure-lsp server." - :group 'lsp-clojure - :type 'boolean) - -(defcustom lsp-clojure-workspace-dir (expand-file-name (locate-user-emacs-file "workspace/")) - "LSP clojure workspace directory." - :group 'lsp-clojure - :risky t - :type 'directory) - -(defcustom lsp-clojure-workspace-cache-dir (expand-file-name ".cache/" lsp-clojure-workspace-dir) - "LSP clojure workspace cache directory." - :group 'lsp-clojure - :risky t - :type 'directory) - -(defcustom lsp-clojure-library-dirs (list lsp-clojure-workspace-cache-dir - (expand-file-name "~/.gitlibs/libs")) - "LSP clojure dirs that should be considered library folders." - :group 'lsp-clojure - :type 'list) - -(defcustom lsp-clojure-test-tree-position-params nil - "The optional test tree position params. -Defaults to side following treemacs default." - :type 'alist - :group 'lsp-clojure) - -(defcustom lsp-clojure-project-tree-position-params nil - "The optional project tree position params. -Defaults to side following treemacs default." - :type 'alist - :group 'lsp-clojure) - -;; Internal - -(lsp-interface - (Clojure:CursorInfoParams (:textDocument :position) nil)) - -(lsp-dependency - 'clojure-lsp - `(:download :url lsp-clojure-server-download-url - :decompress :zip - :store-path lsp-clojure-server-store-path - :set-executable? t) - '(:system "clojure-lsp")) - -;; Refactorings - -(defun lsp-clojure--execute-command (command &optional args) - "Send an executeCommand request for COMMAND with ARGS." - (lsp--cur-workspace-check) - (lsp-send-execute-command command (apply #'vector args))) - -(defun lsp-clojure--refactoring-call (refactor-name &rest additional-args) - "Send an executeCommand request for REFACTOR-NAME with ADDITIONAL-ARGS. -If there are more arguments expected after the line and column numbers." - (lsp--cur-workspace-check) - (lsp-clojure--execute-command refactor-name (cl-list* (lsp--buffer-uri) - (- (line-number-at-pos) 1) ;; clojure-lsp expects line numbers to start at 0 - (current-column) - additional-args))) - -(defun lsp-clojure-add-import-to-namespace (import-name) - "Add to IMPORT-NAME to :import form." - (interactive "MImport name: ") - (lsp-clojure--refactoring-call "add-import-to-namespace" import-name)) - -(defun lsp-clojure-add-missing-libspec () - "Apply add-missing-libspec refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "add-missing-libspec")) - -(defun lsp-clojure-clean-ns () - "Apply clean-ns refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "clean-ns")) - -(defun lsp-clojure-cycle-coll () - "Apply cycle-coll refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "cycle-coll")) - -(defun lsp-clojure-cycle-privacy () - "Apply cycle-privacy refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "cycle-privacy")) - -(defun lsp-clojure-expand-let () - "Apply expand-let refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "expand-let")) - -(defun lsp-clojure-extract-function (function-name) - "Move form at point into a new function named FUNCTION-NAME." - (interactive "MFunction name: ") ;; Name of the function - (lsp-clojure--refactoring-call "extract-function" function-name)) - -(defun lsp-clojure-inline-symbol () - "Apply inline-symbol refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "inline-symbol")) - -(defun lsp-clojure-introduce-let (binding-name) - "Move form at point into a new let binding as BINDING-NAME." - (interactive "MBinding name: ") ;; Name of the let binding - (lsp-clojure--refactoring-call "introduce-let" binding-name)) - -(defun lsp-clojure-move-to-let (binding-name) - "Move form at point into nearest existing let binding as BINDING-NAME." - (interactive "MBinding name: ") ;; Name of the let binding - (lsp-clojure--refactoring-call "move-to-let" binding-name)) - -(defun lsp-clojure-thread-first () - "Apply thread-first refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "thread-first")) - -(defun lsp-clojure-thread-first-all () - "Apply thread-first-all refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "thread-first-all")) - -(defun lsp-clojure-thread-last () - "Apply thread-last refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "thread-last")) - -(defun lsp-clojure-thread-last-all () - "Apply thread-last-all refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "thread-last-all")) - -(defun lsp-clojure-unwind-all () - "Apply unwind-all refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "unwind-all")) - -(defun lsp-clojure-unwind-thread () - "Apply unwind-thread refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "unwind-thread")) - -(defun lsp-clojure-create-function () - "Apply create-function refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "create-function")) - -(defun lsp-clojure-create-test () - "Apply create-test refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "create-test")) - -(defun lsp-clojure-sort-map () - "Apply sort-map refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "sort-map")) - -(defun lsp-clojure-move-coll-entry-up () - "Apply move coll entry up refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "move-coll-entry-up")) - -(defun lsp-clojure-move-coll-entry-down () - "Apply move coll entry down refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "move-coll-entry-down")) - -(defun lsp-clojure-forward-slurp () - "Apply forward slurp refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "forward-slurp")) - -(defun lsp-clojure-forward-barf () - "Apply forward barf refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "forward-barf")) - -(defun lsp-clojure-backward-slurp () - "Apply backward slurp refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "backward-slurp")) - -(defun lsp-clojure-backward-barf () - "Apply backward slurp refactoring at point." - (interactive) - (lsp-clojure--refactoring-call "backward-barf")) - -(defun lsp-clojure-move-form (dest-filename) - "Apply move-form refactoring at point to DEST-FILENAME." - (interactive - (list (or (read-file-name "Move form to: ") - (user-error "No filename selected. Aborting")))) - (lsp-clojure--refactoring-call "move-form" (expand-file-name dest-filename))) - -(defun lsp-clojure-server-info () - "Request server info." - (interactive) - (lsp--cur-workspace-check) - (lsp-notify "clojure/serverInfo/log" nil)) - -(defvar lsp-clojure-server-buffer-name "*lsp-clojure-server-log*") - -(defun lsp-clojure--server-log-revert-function (original-file-log-buffer &rest _) - "Spit contents to ORIGINAL-FILE-LOG-BUFFER." - (with-current-buffer (get-buffer-create lsp-clojure-server-buffer-name) - (erase-buffer) - (insert (with-current-buffer original-file-log-buffer (buffer-string))) - (goto-char (point-max)) - (read-only-mode))) - -(defun lsp-clojure-server-log () - "Open a buffer with the server logs." - (interactive) - (lsp--cur-workspace-check) - (let* ((log-path (-> (lsp--json-serialize (lsp-request "clojure/serverInfo/raw" nil)) - (lsp--read-json) - (lsp-get :log-path)))) - (with-current-buffer (find-file log-path) - (read-only-mode) - (goto-char (point-max))))) - -(defun lsp-clojure-server-info-raw () - "Request server info raw data." - (interactive) - (lsp--cur-workspace-check) - (message "%s" (lsp--json-serialize (lsp-request "clojure/serverInfo/raw" nil)))) - -(defun lsp-clojure-cursor-info () - "Request cursor info at point." - (interactive) - (lsp--cur-workspace-check) - (lsp-notify "clojure/cursorInfo/log" - (lsp-make-clojure-cursor-info-params - :textDocument (lsp-make-text-document-identifier :uri (lsp--buffer-uri)) - :position (lsp-make-position :line (- (line-number-at-pos) 1) - :character (current-column))))) - -(defun lsp-clojure-resolve-macro-as () - "Ask to user how the unresolved macro should be resolved." - (interactive) - (lsp--cur-workspace-check) - (lsp-clojure--execute-command "resolve-macro-as" - (list (lsp--buffer-uri) - (- (line-number-at-pos) 1) ;; clojure-lsp expects line numbers to start at 0 - (current-column)))) - -(defun lsp-clojure--ensure-dir (path) - "Ensure that directory PATH exists." - (unless (file-directory-p path) - (make-directory path t))) - -(defun lsp-clojure--get-metadata-location (file-location) - "Given a FILE-LOCATION return the file containing the metadata for the file." - (format "%s.%s.metadata" - (file-name-directory file-location) - (file-name-base file-location))) - -(defun lsp-clojure--file-in-jar (uri) - "Check URI for a valid jar and include it in workspace." - (string-match "^\\(jar\\|zip\\):\\(file:.+\\)!/\\(.+\\)" uri) - (let* ((ns-path (match-string 3 uri)) - (ns (s-replace "/" "." ns-path)) - (file-location (concat lsp-clojure-workspace-cache-dir ns))) - (unless (file-readable-p file-location) - (lsp-clojure--ensure-dir (file-name-directory file-location)) - (with-lsp-workspace (lsp-find-workspace 'clojure-lsp nil) - (let ((content (lsp-send-request (lsp-make-request "clojure/dependencyContents" (list :uri uri))))) - (with-temp-file file-location - (insert content)) - (with-temp-file (lsp-clojure--get-metadata-location file-location) - (insert uri))))) - file-location)) - -(defun lsp-clojure--server-executable-path () - "Return the clojure-lsp server command." - (or (executable-find "clojure-lsp") - (lsp-package-path 'clojure-lsp))) - -(lsp-defun lsp-clojure--show-references ((&Command :arguments? args)) - "Show references for command with ARGS. -ARGS is a vector which the first element is the uri, the second the line -and the third the column." - (lsp-show-xrefs - (lsp--locations-to-xref-items - (lsp-request "textDocument/references" - (lsp--make-reference-params - (lsp--text-document-position-params - (list :uri (seq-elt args 0)) - (list :line (1- (seq-elt args 1)) - :character (1- (seq-elt args 2))))))) - nil - t)) - -;; Test tree - -(defvar-local lsp-clojure--test-tree-data nil) -(defconst lsp-clojure--test-tree-buffer-name "*Clojure Test Tree*") - -(defvar treemacs-position) -(defvar treemacs-width) -(declare-function lsp-treemacs-render "ext:lsp-treemacs" (tree title expand-depth &optional buffer-name right-click-actions clear-cache?)) -(declare-function lsp-treemacs--open-file-in-mru "ext:lsp-treemacs" (file)) - -(defun lsp-clojure--test-tree-ret-action (uri range) - "Build the ret action for an item in the test tree view. -URI is the source of the item. -RANGE is the range of positions to where this item should point." - (interactive) - (lsp-treemacs--open-file-in-mru (lsp--uri-to-path uri)) - (goto-char (lsp--position-to-point (lsp:range-start range))) - (run-hooks 'xref-after-jump-hook)) - -(lsp-defun lsp-clojure--test-tree-data->tree (uri (&clojure-lsp:TestTreeNode :name :range :kind :children?)) - "Builds a test tree. -URI is the source of the test tree. -NODE is the node with all test children data." - (-let* ((icon (cl-case kind - (1 'namespace) - (2 'method) - (3 'field))) - (base-tree (list :key name - :label name - :icon icon - :ret-action (lambda (&rest _) (lsp-clojure--test-tree-ret-action uri range)) - :uri uri))) - (if (seq-empty-p children?) - base-tree - (plist-put base-tree :children (seq-map (-partial #'lsp-clojure--test-tree-data->tree uri) children?))))) - -(lsp-defun lsp-clojure--render-test-tree ((&clojure-lsp:TestTreeParams :uri :tree)) - "Render a test tree view for current test tree buffer data." - (save-excursion - (lsp-treemacs-render - (list (lsp-clojure--test-tree-data->tree uri tree)) - "Clojure Test Tree" - t - lsp-clojure--test-tree-buffer-name))) - -(defun lsp-clojure--show-test-tree (ignore-focus?) - "Show a test tree for current buffer. -Focus on it if IGNORE-FOCUS? is nil." - (if lsp-clojure--test-tree-data - (-let* ((tree-buffer (lsp-clojure--render-test-tree lsp-clojure--test-tree-data)) - (position-params (or lsp-clojure-test-tree-position-params - `((side . ,treemacs-position) - (slot . 2) - (window-width . ,treemacs-width)))) - (window (display-buffer-in-side-window tree-buffer position-params))) - (unless ignore-focus? - (select-window window) - (set-window-dedicated-p window t))) - (unless ignore-focus? - (lsp-log "No Clojure test tree data found.")))) - -(lsp-defun lsp-clojure--handle-test-tree (_workspace (notification &as &clojure-lsp:TestTreeParams :uri)) - "Test tree notification handler for workspace WORKSPACE. -NOTIFICATION is the test tree notification data received from server. -It updates the test tree view data." - (when (require 'lsp-treemacs nil t) - (when-let (buffer (find-buffer-visiting (lsp--uri-to-path uri))) - (with-current-buffer buffer - (setq lsp-clojure--test-tree-data notification) - (when (get-buffer-window lsp-clojure--test-tree-buffer-name) - (lsp-clojure--show-test-tree t)))))) - -;;;###autoload -(defun lsp-clojure-show-test-tree (ignore-focus?) - "Show a test tree and focus on it if IGNORE-FOCUS? is nil." - (interactive "P") - (if (require 'lsp-treemacs nil t) - (lsp-clojure--show-test-tree ignore-focus?) - (error "The package lsp-treemacs is not installed"))) - -;; Project Tree - -(defconst lsp-clojure--project-tree-buffer-name "*Clojure Project Tree*") - -(defun lsp-clojure--project-tree-type->icon (type) - "Convert the project tree type TYPE to icon." - (cl-case type - (1 'project) - (2 'folder) - (3 'library) - (4 'jar) - (5 'namespace) - (6 'class) - (7 'method) - (8 'variable) - (9 'interface))) - -(defun lsp-clojure--project-tree-ret-action (uri range) - "Build the ret action for an item in the project tree view. -URI is the source of the item." - (interactive) - (lsp-treemacs--open-file-in-mru (lsp--uri-to-path uri)) - (goto-char (lsp--position-to-point (lsp:range-start range))) - (run-hooks 'xref-after-jump-hook)) - -(lsp-defun lsp-clojure--project-tree-children-data->tree (buffer current-node &optional _ callback) - "Builds a project tree considering CURRENT-NODE." - (with-current-buffer buffer - (lsp-request-async - "clojure/workspace/projectTree/nodes" - current-node - (-lambda ((&clojure-lsp:ProjectTreeNode :nodes?)) - (funcall - callback - (-map - (-lambda ((node &as &clojure-lsp:ProjectTreeNode :id? :name :type :uri? :range? :detail? :final?)) - (-let ((label (if detail? - (format "%s %s" name (propertize detail? 'face 'lsp-details-face)) - name))) - `(:label ,label - :key ,(or id? name) - :icon ,(lsp-clojure--project-tree-type->icon type) - ,@(unless final? - (list :children-async (-partial #'lsp-clojure--project-tree-children-data->tree buffer node))) - ,@(when uri? - (list :uri uri? - :ret-action (lambda (&rest _) - (interactive) - (lsp-clojure--project-tree-ret-action uri? range?))))))) - nodes?))) - :mode 'detached))) - -(defun lsp-clojure--project-tree-data->tree () - "Builds a project tree considering CURRENT-NODE." - (-let* (((&clojure-lsp:ProjectTreeNode :id? :name :nodes? :uri?) (lsp-request "clojure/workspace/projectTree/nodes" nil)) - (buffer (current-buffer))) - (list :key (or id? name) - :label name - :icon "clj" - :children (seq-map (-lambda ((node &as &clojure-lsp:ProjectTreeNode :id? :name :type :uri?)) - (list :key (or id? name) - :label name - :icon (lsp-clojure--project-tree-type->icon type) - :children-async (-partial #'lsp-clojure--project-tree-children-data->tree buffer node) - :uri uri?)) - nodes?) - :uri uri?))) - -(defun lsp-clojure--render-project-tree () - "Render a project tree view." - (save-excursion - (lsp-treemacs-render - (list (lsp-clojure--project-tree-data->tree)) - "Clojure Project Tree" - nil - lsp-clojure--project-tree-buffer-name - nil - t))) - -(defun lsp-clojure--show-project-tree (ignore-focus?) - "Show a project tree for current project. -Focus on it if IGNORE-FOCUS? is nil." - (-let* ((tree-buffer (lsp-clojure--render-project-tree)) - (position-params (or lsp-clojure-project-tree-position-params - `((side . ,treemacs-position) - (slot . 2) - (window-width . ,treemacs-width)))) - (window (display-buffer-in-side-window tree-buffer position-params))) - (unless ignore-focus? - (select-window window) - (set-window-dedicated-p window t)))) - -;;;###autoload -(defun lsp-clojure-show-project-tree (ignore-focus?) - "Show a project tree with source-paths and dependencies. -Focus on it if IGNORE-FOCUS? is nil." - (interactive "P") - (if (require 'lsp-treemacs nil t) - (lsp-clojure--show-project-tree ignore-focus?) - (error "The package lsp-treemacs is not installed"))) - -(defun lsp-clojure--build-command () - "Build clojure-lsp start command." - (let* ((base-command (or lsp-clojure-custom-server-command - (-some-> (lsp-clojure--server-executable-path) list)))) - (if lsp-clojure-trace-enable - (-map-last #'stringp - (lambda (command) - (concat command " --trace")) - base-command) - base-command))) - -(lsp-register-client - (make-lsp-client - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'clojure-lsp callback error-callback)) - :semantic-tokens-faces-overrides '(:types (("macro" . font-lock-keyword-face) - ("keyword" . clojure-keyword-face) - ("event" . default))) - :new-connection (lsp-stdio-connection - #'lsp-clojure--build-command - #'lsp-clojure--build-command) - :major-modes '(clojure-mode clojurec-mode clojurescript-mode - clojure-ts-mode clojure-ts-clojurec-mode clojure-ts-clojurescript-mode) - :library-folders-fn (lambda (_workspace) lsp-clojure-library-dirs) - :uri-handlers (lsp-ht ("jar" #'lsp-clojure--file-in-jar)) - :action-handlers (lsp-ht ("code-lens-references" #'lsp-clojure--show-references)) - :notification-handlers (lsp-ht ("clojure/textDocument/testTree" #'lsp-clojure--handle-test-tree)) - :initialization-options '(:dependency-scheme "jar" - :show-docs-arity-on-same-line? t) - :custom-capabilities `((experimental . ((testTree . ,(and (require 'lsp-treemacs nil t) t))))) - :server-id 'clojure-lsp)) - -(lsp-consistency-check lsp-clojure) - -;; For debugging - -(declare-function cider-connect-clj "ext:cider" (params)) - -(defun lsp-clojure-nrepl-connect () - "Connect to the running nrepl debug server of clojure-lsp." - (interactive) - (let ((info (lsp-clojure-server-info-raw))) - (save-match-data - (when (functionp 'cider-connect-clj) - (when-let (port (and (string-match "\"port\":\\([0-9]+\\)" info) - (match-string 1 info))) - (cider-connect-clj `(:host "localhost" - :port ,port))))))) - -;; Cider integration - -(defun lsp-clojure-semantic-tokens-refresh (&rest _) - "Force refresh semantic tokens." - (when-let ((workspace (and lsp-semantic-tokens-enable - (lsp-find-workspace 'clojure-lsp (buffer-file-name))))) - (--each (lsp--workspace-buffers workspace) - (when (lsp-buffer-live-p it) - (lsp-with-current-buffer it - (lsp-semantic-tokens--enable)))))) - -(with-eval-after-load 'cider - (when lsp-semantic-tokens-enable - ;; refresh tokens as cider flush font-faces after disconnected - (add-hook 'cider-mode-hook #'lsp-clojure-semantic-tokens-refresh))) - -(provide 'lsp-clojure) -;;; lsp-clojure.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-clojure.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-clojure.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-cobol.el b/emacs/elpa/lsp-mode-20241113.743/lsp-cobol.el @@ -1,154 +0,0 @@ -;;; lsp-cobol.el --- COBOL support -*- lexical-binding: t; -*- - -;; Copyright (C) 2024 Shen, Jen-Chieh - -;; 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 this program. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; COBOL support. -;; - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-cobol nil - "LSP support for COBOL." - :group 'lsp-mode - :link '(url-link "https://github.com/eclipse-che4z/che-che4z-lsp-for-cobol") - :package-version `(lsp-mode . "9.0.0")) - -(defcustom lsp-cobol-server-path nil - "Path points for COBOL language service. - -This is only for development use." - :type 'string - :group 'lsp-cobol) - -(defcustom lsp-cobol-port 1044 - "Port to connect server to." - :type 'integer - :group 'lsp-cobol) - -;; -;;; Installation - -(defcustom lsp-cobol-server-store-path - (expand-file-name "cobol/" lsp-server-install-dir) - "The path to the file in which COBOL language service will be stored." - :type 'file - :group 'lsp-cobol) - -(defcustom lsp-cobol-server-version "2.1.1" - "The COBOL language service version to install." - :type 'file - :group 'lsp-cobol) - -(defconst lsp-cobol-download-url-format - "https://github.com/eclipse-che4z/che-che4z-lsp-for-cobol/releases/download/%s/cobol-language-support-%s-%s-%s%s.vsix" - "Format to the download url link.") - -(defun lsp-cobol--server-url () - "Return Url points to the cobol language service's zip/tar file." - (let* ((x86 (string-prefix-p "x86_64" system-configuration)) - (arch (if x86 "x64" "arm64")) - (version lsp-cobol-server-version)) - (cl-case system-type - ((cygwin windows-nt ms-dos) - (format lsp-cobol-download-url-format - version "win32" arch version "-signed")) - (darwin - (format lsp-cobol-download-url-format - version "darwin" arch version "")) - (gnu/linux - (format lsp-cobol-download-url-format - version "linux" arch version ""))))) - -(defun lsp-cobol--stored-executable () - "Return the stored COBOL language service executable." - (f-join lsp-cobol-server-store-path - (concat "extension/server/native/" - (cl-case system-type - ((cygwin windows-nt ms-dos) "engine.exe") - (darwin "server-mac") - (gnu/linux "server-linux"))))) - -(lsp-dependency - 'cobol-ls - '(:system "cobol-ls") - `(:download :url ,(lsp-cobol--server-url) - :decompress :zip - :store-path ,(f-join lsp-cobol-server-store-path "temp") - :set-executable? t) - `(:system ,(lsp-cobol--stored-executable))) - -;; -;;; Server - -;;;###autoload -(add-hook 'cobol-mode-hook #'lsp-cobol-start-ls) - -;;;###autoload -(defun lsp-cobol-start-ls () - "Start the COBOL language service." - (interactive) - (when-let ((exe (lsp-cobol--executable)) - ((lsp--port-available "localhost" lsp-cobol-port))) - (lsp-async-start-process #'ignore #'ignore exe))) - -;; -;;; Core - -(defun lsp-cobol--executable () - "Return the COBOL language service executable." - (or lsp-cobol-server-path - (lsp-cobol--stored-executable))) - -(defun lsp-cobol-server-start-fn (&rest _) - "Define COOBL language service start function." - `(,(lsp-cobol--executable))) - -(defun lsp-cobol--tcp-connect-to-port () - "Define a TCP connection to language server." - (list - :connect - (lambda (filter sentinel name _environment-fn _workspace) - (let* ((host "localhost") - (port lsp-cobol-port) - (tcp-proc (lsp--open-network-stream host port (concat name "::tcp")))) - - ;; TODO: Same :noquery issue (see above) - (set-process-query-on-exit-flag tcp-proc nil) - (set-process-filter tcp-proc filter) - (set-process-sentinel tcp-proc sentinel) - (cons tcp-proc tcp-proc))) - :test? (lambda () (file-executable-p (lsp-cobol--executable))))) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-cobol--tcp-connect-to-port) - :activation-fn (lsp-activate-on "cobol") - :priority -1 - :server-id 'cobol-ls - :download-server-fn - (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'cobol-ls callback error-callback)))) - -(lsp-consistency-check lsp-cobol) - -(provide 'lsp-cobol) -;;; lsp-cobol.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-completion.el b/emacs/elpa/lsp-mode-20241113.743/lsp-completion.el @@ -1,876 +0,0 @@ -;;; lsp-completion.el --- LSP completion -*- lexical-binding: t; -*- -;; -;; Copyright (C) 2020 emacs-lsp maintainers -;; -;; 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: -;; -;; LSP completion -;; -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-completion nil - "LSP support for completion." - :prefix "lsp-completion-" - :group 'lsp-mode - :tag "LSP Completion") - -;;;###autoload -(define-obsolete-variable-alias 'lsp-prefer-capf - 'lsp-completion-provider "lsp-mode 7.0.1") - -(defcustom lsp-completion-provider :capf - "The completion backend provider." - :type '(choice - (const :tag "Use company-capf" :capf) - (const :tag "None" :none)) - :group 'lsp-completion - :package-version '(lsp-mode . "7.0.1")) - -;;;###autoload -(define-obsolete-variable-alias 'lsp-enable-completion-at-point - 'lsp-completion-enable "lsp-mode 7.0.1") - -(defcustom lsp-completion-enable t - "Enable `completion-at-point' integration." - :type 'boolean - :group 'lsp-completion) - -(defcustom lsp-completion-enable-additional-text-edit t - "Whether or not to apply additional text edit when performing completion. - -If set to non-nil, `lsp-mode' will apply additional text edits -from the server. Otherwise, the additional text edits are -ignored." - :type 'boolean - :group 'lsp-completion - :package-version '(lsp-mode . "6.3.2")) - -(defcustom lsp-completion-show-kind t - "Whether or not to show kind of completion candidates." - :type 'boolean - :group 'lsp-completion - :package-version '(lsp-mode . "7.0.1")) - -(defcustom lsp-completion-show-detail t - "Whether or not to show detail of completion candidates." - :type 'boolean - :group 'lsp-completion) - -(defcustom lsp-completion-show-label-description t - "Whether or not to show description of completion candidates." - :type 'boolean - :group 'lsp-completion - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-completion-no-cache nil - "Whether or not caching the returned completions from server." - :type 'boolean - :group 'lsp-completion - :package-version '(lsp-mode . "7.0.1")) - -(defcustom lsp-completion-filter-on-incomplete t - "Whether or not filter incomplete results." - :type 'boolean - :group 'lsp-completion - :package-version '(lsp-mode . "7.0.1")) - -(defcustom lsp-completion-sort-initial-results t - "Whether or not filter initial results from server." - :type 'boolean - :group 'lsp-completion - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-completion-use-last-result t - "Temporarily use last server result when interrupted by keyboard. -This will help minimize popup flickering issue in `company-mode'." - :type 'boolean - :group 'lsp-completion - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-completion-default-behaviour :replace - "Default behaviour of `InsertReplaceEdit'." - :type '(choice - (const :tag "Default completion inserts" :insert) - (const :tag "Default completion replaces" :replace)) - :group 'lsp-completion - :package-version '(lsp-mode . "8.0.0")) - -(defconst lsp-completion--item-kind - [nil - "Text" - "Method" - "Function" - "Constructor" - "Field" - "Variable" - "Class" - "Interface" - "Module" - "Property" - "Unit" - "Value" - "Enum" - "Keyword" - "Snippet" - "Color" - "File" - "Reference" - "Folder" - "EnumMember" - "Constant" - "Struct" - "Event" - "Operator" - "TypeParameter"]) - -(defvar yas-indent-line) -(defvar company-backends) -(defvar company-abort-on-unique-match) - -(defvar lsp-completion--no-reordering nil - "Dont do client-side reordering completion items when set.") - -(declare-function company-mode "ext:company") -(declare-function yas-expand-snippet "ext:yasnippet") - -(defun lsp-doc-buffer (&optional string) - "Return doc for STRING." - (with-current-buffer (get-buffer-create "*lsp-documentation*") - (erase-buffer) - (fundamental-mode) - (when string - (save-excursion - (insert string) - (visual-line-mode))) - (current-buffer))) - -(defun lsp-falsy? (val) - "Non-nil if VAL is falsy." - ;; https://developer.mozilla.org/en-US/docs/Glossary/Falsy - (or (not val) (equal val "") (equal val 0))) - -(cl-defun lsp-completion--make-item (item &key markers prefix) - "Make completion item from lsp ITEM and with MARKERS and PREFIX." - (-let (((&CompletionItem :label - :sort-text? - :_emacsStartPoint start-point) - item)) - (propertize label - 'lsp-completion-item item - 'lsp-sort-text sort-text? - 'lsp-completion-start-point start-point - 'lsp-completion-markers markers - 'lsp-completion-prefix prefix))) - -(defun lsp-completion--fix-resolve-data (item) - "Patch `CompletionItem' ITEM for rust-analyzer otherwise resolve will fail. -See #2675" - (let ((data (lsp:completion-item-data? item))) - (when (lsp-member? data :import_for_trait_assoc_item) - (unless (lsp-get data :import_for_trait_assoc_item) - (lsp-put data :import_for_trait_assoc_item :json-false))))) - -(defun lsp-completion--resolve (item) - "Resolve completion ITEM. -ITEM can be string or a CompletionItem" - (cl-assert item nil "Completion item must not be nil") - (-let (((completion-item . resolved) - (pcase item - ((pred stringp) (cons (get-text-property 0 'lsp-completion-item item) - (get-text-property 0 'lsp-completion-resolved item))) - (_ (cons item nil))))) - (if resolved item - (lsp-completion--fix-resolve-data completion-item) - (setq completion-item - (or (ignore-errors - (when (lsp-feature? "completionItem/resolve") - (lsp-request "completionItem/resolve" - (lsp-delete (lsp-copy completion-item) :_emacsStartPoint)))) - completion-item)) - (pcase item - ((pred stringp) - (let ((len (length item))) - (put-text-property 0 len 'lsp-completion-item completion-item item) - (put-text-property 0 len 'lsp-completion-resolved t item) - item)) - (_ completion-item))))) - -(defun lsp-completion--resolve-async (item callback &optional cleanup-fn) - "Resolve completion ITEM asynchronously with CALLBACK. -The CLEANUP-FN will be called to cleanup." - (cl-assert item nil "Completion item must not be nil") - (-let (((completion-item . resolved) - (pcase item - ((pred stringp) (cons (get-text-property 0 'lsp-completion-item item) - (get-text-property 0 'lsp-completion-resolved item))) - (_ (cons item nil))))) - (ignore-errors - (if (and (lsp-feature? "completionItem/resolve") (not resolved)) - (progn - (lsp-completion--fix-resolve-data completion-item) - (lsp-request-async "completionItem/resolve" - (lsp-delete (lsp-copy completion-item) :_emacsStartPoint) - (lambda (completion-item) - (when (stringp item) - (let ((len (length item))) - (put-text-property 0 len 'lsp-completion-item completion-item item) - (put-text-property 0 len 'lsp-completion-resolved t item) - item)) - (funcall callback completion-item) - (when cleanup-fn (funcall cleanup-fn))) - :error-handler (lambda (err) - (when cleanup-fn (funcall cleanup-fn)) - (error (lsp:json-error-message err))) - :cancel-handler cleanup-fn - :mode 'alive)) - (funcall callback completion-item) - (when cleanup-fn (funcall cleanup-fn)))))) - -(defun lsp-completion--annotate (item) - "Annotate ITEM detail." - (-let (((completion-item &as &CompletionItem :detail? :kind? :label-details?) - (get-text-property 0 'lsp-completion-item item))) - (lsp-completion--resolve-async item #'ignore) - - (concat (when (and lsp-completion-show-detail detail?) - (concat " " (s-replace "\r" "" detail?))) - (when (and lsp-completion-show-label-description label-details?) - (when-let ((description (and label-details? (lsp:label-details-description label-details?)))) - (format " %s" description))) - (when lsp-completion-show-kind - (when-let ((kind-name (and kind? (aref lsp-completion--item-kind kind?)))) - (format " (%s)" kind-name)))))) - -(defun lsp-completion--looking-back-trigger-characterp (trigger-characters) - "Return character if text before point match any of the TRIGGER-CHARACTERS." - (unless (= (point) (line-beginning-position)) - (seq-some - (lambda (trigger-char) - (and (equal (buffer-substring-no-properties (- (point) (length trigger-char)) (point)) - trigger-char) - trigger-char)) - trigger-characters))) - -(defvar lsp-completion--cache nil - "Cached candidates for completion at point function. -In the form of plist (prefix-pos items :lsp-items :prefix ...). -When the completion is incomplete, `items' contains value of :incomplete.") - -(defvar lsp-completion--last-result nil - "Last completion result.") - -(defun lsp-completion--clear-cache (&optional keep-last-result) - "Clear completion caches. -KEEP-LAST-RESULT if specified." - (-some-> lsp-completion--cache - (cddr) - (plist-get :markers) - (cl-second) - (set-marker nil)) - (setq lsp-completion--cache nil) - (unless keep-last-result (setq lsp-completion--last-result nil))) - -(lsp-defun lsp-completion--guess-prefix ((item &as &CompletionItem :text-edit?)) - "Guess ITEM's prefix start point according to following heuristics: -- If `textEdit' exists, use insertion range start as prefix start point. -- Else, find the point before current point is longest prefix match of -`insertText' or `label'. And: - - The character before prefix is not word constitute -Return `nil' when fails to guess prefix." - (cond - ((lsp-insert-replace-edit? text-edit?) - (lsp--position-to-point (lsp:range-start (lsp:insert-replace-edit-insert text-edit?)))) - (text-edit? - (lsp--position-to-point (lsp:range-start (lsp:text-edit-range text-edit?)))) - (t - (-let* (((&CompletionItem :label :insert-text?) item) - (text (or (unless (lsp-falsy? insert-text?) insert-text?) label)) - (point (point)) - (start (max 1 (- point (length text)))) - (char-before (char-before start)) - start-point) - (while (and (< start point) (not start-point)) - (unless (or (and char-before (equal (char-syntax char-before) ?w)) - (not (string-prefix-p (buffer-substring-no-properties start point) - text))) - (setq start-point start)) - (cl-incf start) - (setq char-before (char-before start))) - start-point)))) - -(defun lsp-completion--to-internal (items) - "Convert ITEMS into internal form." - (--> items - (-map (-lambda ((item &as &CompletionItem - :label - :filter-text? - :_emacsStartPoint start-point - :score?)) - `( :label ,(or (unless (lsp-falsy? filter-text?) filter-text?) label) - :item ,item - :start-point ,start-point - :score ,score?)) - it))) - -(cl-defun lsp-completion--filter-candidates (items &key - lsp-items - markers - prefix - &allow-other-keys) - "List all possible completions in cached ITEMS with their prefixes. -We can pass LSP-ITEMS, which will be used when there's no cache. -The MARKERS and PREFIX value will be attached to each candidate." - (lsp--while-no-input - (->> - (if items - (--> (let (queries fuz-queries) - (-keep (-lambda ((cand &as &plist :label :start-point :score)) - (let* ((query (or (plist-get queries start-point) - (let ((s (buffer-substring-no-properties - start-point (point)))) - (setq queries (plist-put queries start-point s)) - s))) - (fuz-query (or (plist-get fuz-queries start-point) - (let ((s (lsp-completion--regex-fuz query))) - (setq fuz-queries - (plist-put fuz-queries start-point s)) - s))) - (label-len (length label))) - (when (string-match fuz-query label) - (put-text-property 0 label-len 'match-data (match-data) label) - (plist-put cand - :sort-score - (* (or (lsp-completion--fuz-score query label) 1e-05) - (or score 0.001))) - cand))) - items)) - (if lsp-completion--no-reordering - it - (sort it (lambda (o1 o2) - (> (plist-get o1 :sort-score) - (plist-get o2 :sort-score))))) - ;; TODO: pass additional function to sort the candidates - (-map (-rpartial #'plist-get :item) it)) - lsp-items) - (-map (lambda (item) (lsp-completion--make-item item - :markers markers - :prefix prefix)))))) - -(defconst lsp-completion--kind->symbol - '((1 . text) - (2 . method) - (3 . function) - (4 . constructor) - (5 . field) - (6 . variable) - (7 . class) - (8 . interface) - (9 . module) - (10 . property) - (11 . unit) - (12 . value) - (13 . enum) - (14 . keyword) - (15 . snippet) - (16 . color) - (17 . file) - (18 . reference) - (19 . folder) - (20 . enum-member) - (21 . constant) - (22 . struct) - (23 . event) - (24 . operator) - (25 . type-parameter))) - -(defun lsp-completion--candidate-kind (item) - "Return ITEM's kind." - (alist-get (lsp:completion-item-kind? (get-text-property 0 'lsp-completion-item item)) - lsp-completion--kind->symbol)) - -(defun lsp-completion--candidate-deprecated (item) - "Return if ITEM is deprecated." - (let ((completion-item (get-text-property 0 'lsp-completion-item item))) - (or (lsp:completion-item-deprecated? completion-item) - (seq-position (lsp:completion-item-tags? completion-item) - lsp/completion-item-tag-deprecated)))) - -(defun lsp-completion--company-match (candidate) - "Return highlight of typed prefix inside CANDIDATE." - (if-let ((md (cddr (plist-get (text-properties-at 0 candidate) 'match-data)))) - (let (matches start end) - (while (progn (setq start (pop md) end (pop md)) - (and start end)) - (setq matches (nconc matches `((,start . ,end))))) - matches) - (let* ((prefix (downcase - (buffer-substring-no-properties - ;; Put a safe guard to prevent staled cache from setting a wrong start point #4192 - (max (line-beginning-position) - (plist-get (text-properties-at 0 candidate) 'lsp-completion-start-point)) - (point)))) - (prefix-len (length prefix)) - (prefix-pos 0) - (label (downcase candidate)) - (label-len (length label)) - (label-pos 0) - matches start) - (while (and (not matches) - (< prefix-pos prefix-len)) - (while (and (< prefix-pos prefix-len) - (< label-pos label-len)) - (if (equal (aref prefix prefix-pos) (aref label label-pos)) - (progn - (unless start (setq start label-pos)) - (cl-incf prefix-pos)) - (when start - (setq matches (nconc matches `((,start . ,label-pos)))) - (setq start nil))) - (cl-incf label-pos)) - (when start (setq matches (nconc matches `((,start . ,label-pos))))) - ;; Search again when the whole prefix is not matched - (when (< prefix-pos prefix-len) - (setq matches nil)) - ;; Start search from next offset of prefix to find a match with label - (unless matches - (cl-incf prefix-pos) - (setq label-pos 0))) - matches))) - -(defun lsp-completion--get-documentation (item) - "Get doc comment for completion ITEM." - (-some->> item - (lsp-completion--resolve) - (get-text-property 0 'lsp-completion-item) - (lsp:completion-item-documentation?) - (lsp--render-element))) - -(defun lsp-completion--get-context (trigger-characters same-session?) - "Get completion context with provided TRIGGER-CHARACTERS and SAME-SESSION?." - (let* ((triggered-by-char non-essential) - (trigger-char (when triggered-by-char - (lsp-completion--looking-back-trigger-characterp - trigger-characters))) - (trigger-kind (cond - (trigger-char - lsp/completion-trigger-kind-trigger-character) - ((and same-session? - (equal (cl-second lsp-completion--cache) :incomplete)) - lsp/completion-trigger-kind-trigger-for-incomplete-completions) - (t lsp/completion-trigger-kind-invoked)))) - (apply #'lsp-make-completion-context - (nconc - `(:trigger-kind ,trigger-kind) - (when trigger-char - `(:trigger-character? ,trigger-char)))))) - -(defun lsp-completion--sort-completions (completions) - "Sort COMPLETIONS." - (sort - completions - (-lambda ((&CompletionItem :sort-text? sort-text-left :label label-left) - (&CompletionItem :sort-text? sort-text-right :label label-right)) - (if (equal sort-text-left sort-text-right) - (string-lessp label-left label-right) - (string-lessp sort-text-left sort-text-right))))) - -;;;###autoload -(defun lsp-completion-at-point () - "Get lsp completions." - (when (or (--some (lsp--client-completion-in-comments? (lsp--workspace-client it)) - (lsp-workspaces)) - (not (nth 4 (syntax-ppss)))) - (let* ((trigger-chars (-> (lsp--capability-for-method "textDocument/completion") - (lsp:completion-options-trigger-characters?))) - (bounds-start (or (cl-first (bounds-of-thing-at-point 'symbol)) - (point))) - result done? - (candidates - (lambda () - (lsp--catch 'input - (let ((lsp--throw-on-input lsp-completion-use-last-result) - (same-session? (and lsp-completion--cache - ;; Special case for empty prefix and empty result - (or (cl-second lsp-completion--cache) - (not (string-empty-p - (plist-get (cddr lsp-completion--cache) :prefix)))) - (equal (cl-first lsp-completion--cache) bounds-start) - (s-prefix? - (plist-get (cddr lsp-completion--cache) :prefix) - (buffer-substring-no-properties bounds-start (point)))))) - (cond - ((or done? result) result) - ((and (not lsp-completion-no-cache) - same-session? - (listp (cl-second lsp-completion--cache))) - (setf result (apply #'lsp-completion--filter-candidates - (cdr lsp-completion--cache)))) - (t - (-let* ((resp (lsp-request-while-no-input - "textDocument/completion" - (plist-put (lsp--text-document-position-params) - :context (lsp-completion--get-context trigger-chars same-session?)))) - (completed (and resp - (not (and (lsp-completion-list? resp) - (lsp:completion-list-is-incomplete resp))))) - (items (lsp--while-no-input - (--> (cond - ((lsp-completion-list? resp) - (lsp:completion-list-items resp)) - (t resp)) - (if (or completed - (seq-some #'lsp:completion-item-sort-text? it)) - (lsp-completion--sort-completions it) - it) - (-map (lambda (item) - (lsp-put item - :_emacsStartPoint - (or (lsp-completion--guess-prefix item) - bounds-start))) - it)))) - (markers (list bounds-start (copy-marker (point) t))) - (prefix (buffer-substring-no-properties bounds-start (point))) - (lsp-completion--no-reordering (not lsp-completion-sort-initial-results))) - (lsp-completion--clear-cache same-session?) - (setf done? completed - lsp-completion--cache (list bounds-start - (cond - ((and done? (not (seq-empty-p items))) - (lsp-completion--to-internal items)) - ((not done?) :incomplete)) - :lsp-items nil - :markers markers - :prefix prefix) - result (lsp-completion--filter-candidates - (cond (done? - (cl-second lsp-completion--cache)) - (lsp-completion-filter-on-incomplete - (lsp-completion--to-internal items))) - :lsp-items items - :markers markers - :prefix prefix)))))) - (:interrupted lsp-completion--last-result) - (`,res (setq lsp-completion--last-result res)))))) - (list - bounds-start - (point) - (lambda (probe pred action) - (cond - ((eq action 'metadata) - '(metadata (category . lsp-capf) - (display-sort-function . identity) - (cycle-sort-function . identity))) - ((eq (car-safe action) 'boundaries) nil) - (t - (complete-with-action action (funcall candidates) probe pred)))) - :annotation-function #'lsp-completion--annotate - :company-kind #'lsp-completion--candidate-kind - :company-deprecated #'lsp-completion--candidate-deprecated - :company-require-match 'never - :company-prefix-length - (save-excursion - (let ( - ;; 2 is a heuristic number to make sure we look futher back than - ;; the bounds-start, which can be different from the actual start - ;; of the symbol - (bounds-left (max (line-beginning-position) (- bounds-start 2))) - triggered-by-char?) - (while (and (> (point) bounds-left) - (not (equal (char-after) ?\s)) - (not triggered-by-char?)) - (setq triggered-by-char? (lsp-completion--looking-back-trigger-characterp trigger-chars)) - (goto-char (1- (point)))) - (and triggered-by-char? t))) - :company-match #'lsp-completion--company-match - :company-doc-buffer (-compose #'lsp-doc-buffer - #'lsp-completion--get-documentation) - :exit-function - (-rpartial #'lsp-completion--exit-fn candidates))))) - -(defun lsp-completion--find-workspace (server-id) - (--first (eq (lsp--client-server-id (lsp--workspace-client it)) server-id) - (lsp-workspaces))) - -(defun lsp-completion--exit-fn (candidate _status &optional candidates) - "Exit function of `completion-at-point'. -CANDIDATE is the selected completion item. -Others: CANDIDATES" - (unwind-protect - (-let* ((candidate (if (plist-member (text-properties-at 0 candidate) - 'lsp-completion-item) - candidate - (cl-find candidate (funcall candidates) :test #'equal))) - (candidate - ;; see #3498 typescript-language-server does not provide the - ;; proper insertText without resolving. - (if (lsp-completion--find-workspace 'ts-ls) - (lsp-completion--resolve candidate) - candidate)) - ((&plist 'lsp-completion-item item - 'lsp-completion-start-point start-point - 'lsp-completion-markers markers - 'lsp-completion-resolved resolved - 'lsp-completion-prefix prefix) - (text-properties-at 0 candidate)) - ((&CompletionItem? :label :insert-text? :text-edit? :insert-text-format? - :additional-text-edits? :insert-text-mode? :command?) - item)) - (cond - (text-edit? - (apply #'delete-region markers) - (insert prefix) - (pcase text-edit? - ((lsp-interface TextEdit) (lsp--apply-text-edit text-edit?)) - ((lsp-interface InsertReplaceEdit :insert :replace :new-text) - (lsp--apply-text-edit - (lsp-make-text-edit - :new-text new-text - :range (if (or (and current-prefix-arg (eq lsp-completion-default-behaviour :replace)) - (and (not current-prefix-arg) (eq lsp-completion-default-behaviour :insert))) - insert - replace)))))) - ((or (unless (lsp-falsy? insert-text?) insert-text?) label) - (apply #'delete-region markers) - (insert prefix) - (delete-region start-point (point)) - (insert (or (unless (lsp-falsy? insert-text?) insert-text?) label)))) - - (lsp--indent-lines start-point (point) insert-text-mode?) - (when (equal insert-text-format? lsp/insert-text-format-snippet) - (lsp--expand-snippet (buffer-substring start-point (point)) - start-point - (point))) - - (when lsp-completion-enable-additional-text-edit - (if (or resolved - (not (seq-empty-p additional-text-edits?))) - (lsp--apply-text-edits additional-text-edits? 'completion) - (-let [(callback cleanup-fn) (lsp--create-apply-text-edits-handlers)] - (lsp-completion--resolve-async - item - (-compose callback #'lsp:completion-item-additional-text-edits?) - cleanup-fn)))) - - (if (or resolved command?) - (when command? (lsp--execute-command command?)) - (lsp-completion--resolve-async - item - (-lambda ((&CompletionItem? :command?)) - (when command? (lsp--execute-command command?))))) - - (when (and (or - (equal lsp-signature-auto-activate t) - (memq :after-completion lsp-signature-auto-activate) - (and (memq :on-trigger-char lsp-signature-auto-activate) - (-when-let ((&SignatureHelpOptions? :trigger-characters?) - (lsp--capability :signatureHelpProvider)) - (lsp-completion--looking-back-trigger-characterp - trigger-characters?)))) - (lsp-feature? "textDocument/signatureHelp")) - (lsp-signature-activate)) - - (setq-local lsp-inhibit-lsp-hooks nil)) - (lsp-completion--clear-cache))) - -(defun lsp-completion--regex-fuz (str) - "Build a regex sequence from STR. Insert .* between each char." - (apply #'concat - (cl-mapcar - #'concat - (cons "" (cdr (seq-map (lambda (c) (format "[^%c]*" c)) str))) - (seq-map (lambda (c) - (format "\\(%s\\)" (regexp-quote (char-to-string c)))) - str)))) - -(defun lsp-completion--fuz-score (query str) - "Calculate fuzzy score for STR with query QUERY. -The return is nil or in range of (0, inf)." - (-when-let* ((md (cddr (or (get-text-property 0 'match-data str) - (let ((re (lsp-completion--regex-fuz query))) - (when (string-match re str) - (match-data)))))) - (start (pop md)) - (len (length str)) - ;; To understand how this works, consider these bad ascii(tm) - ;; diagrams showing how the pattern "foo" flex-matches - ;; "fabrobazo", "fbarbazoo" and "barfoobaz": - - ;; f abr o baz o - ;; + --- + --- + - - ;; f barbaz oo - ;; + ------ ++ - - ;; bar foo baz - ;; --- +++ --- - - ;; "+" indicates parts where the pattern matched. A "hole" in - ;; the middle of the string is indicated by "-". Note that there - ;; are no "holes" near the edges of the string. The completion - ;; score is a number bound by ]0..1]: the higher the better and - ;; only a perfect match (pattern equals string) will have score - ;; 1. The formula takes the form of a quotient. For the - ;; numerator, we use the number of +, i.e. the length of the - ;; pattern. For the denominator, it first computes - ;; - ;; hole_i_contrib = 1 + (Li-1)^1.05 for first hole - ;; hole_i_contrib = 1 + (Li-1)^0.25 for hole i of length Li - ;; - ;; The final value for the denominator is then given by: - ;; - ;; (SUM_across_i(hole_i_contrib) + 1) - ;; - (score-numerator 0) - (score-denominator 0) - (last-b -1) - (q-ind 0) - (update-score - (lambda (a b) - "Update score variables given match range (A B)." - (setq score-numerator (+ score-numerator (- b a))) - (unless (= a len) - ;; case mismatch will be pushed to near next rank - (unless (equal (aref query q-ind) (aref str a)) - (cl-incf a 0.9)) - (setq score-denominator - (+ score-denominator - (if (= a last-b) 0 - (+ 1 (* (if (< 0 (- a last-b 1)) 1 -1) - (expt (abs (- a last-b 1)) - ;; Give a higher score for match near start - (if (eq last-b -1) 0.75 0.25)))))))) - (setq last-b b)))) - (while md - (funcall update-score start (cl-first md)) - ;; Due to the way completion regex is constructed, `(eq end (+ start 1))` - (cl-incf q-ind) - (pop md) - (setq start (pop md))) - (unless (zerop len) - (/ score-numerator (1+ score-denominator) 1.0)))) - - -;;;###autoload -(defun lsp-completion--enable () - "Enable LSP completion support." - (when (and lsp-completion-enable - (lsp-feature? "textDocument/completion")) - (lsp-completion-mode 1))) - -(defun lsp-completion--disable () - "Disable LSP completion support." - (lsp-completion-mode -1)) - -(defun lsp-completion-passthrough-try-completion (string table pred point) - (let* ((completion-ignore-case t) - (try (completion-basic-try-completion string table pred point)) - (newstr (car try)) - (newpoint (cdr try)) - (beforepoint (and try (substring newstr 0 newpoint)))) - (if (and beforepoint - (string-prefix-p - beforepoint - (try-completion "" table pred) - t)) - try - (cons string point)))) - -(defun lsp-completion-passthrough-all-completions (_string table pred _point) - "Passthrough all completions from TABLE with PRED." - (defvar completion-lazy-hilit-fn) - (when (bound-and-true-p completion-lazy-hilit) - (setq completion-lazy-hilit-fn - (lambda (candidate) - (->> candidate - lsp-completion--company-match - (mapc (-lambda ((start . end)) - (put-text-property start end 'face 'completions-common-part candidate)))) - candidate))) - (all-completions "" table pred)) - -;;;###autoload -(define-minor-mode lsp-completion-mode - "Toggle LSP completion support." - :group 'lsp-completion - :global nil - :lighter "" - (let ((completion-started-fn (lambda (&rest _) - (setq-local lsp-inhibit-lsp-hooks t))) - (after-completion-fn (lambda (result) - (when (stringp result) - (lsp-completion--clear-cache)) - (setq-local lsp-inhibit-lsp-hooks nil)))) - (cond - (lsp-completion-mode - (make-local-variable 'completion-at-point-functions) - ;; Ensure that `lsp-completion-at-point' the first CAPF to be tried, - ;; unless user has put it elsewhere in the list by their own - (add-to-list 'completion-at-point-functions #'lsp-completion-at-point) - (make-local-variable 'completion-category-defaults) - (setf (alist-get 'lsp-capf completion-category-defaults) '((styles . (lsp-passthrough)))) - (make-local-variable 'completion-styles-alist) - (setf (alist-get 'lsp-passthrough completion-styles-alist) - '(lsp-completion-passthrough-try-completion - lsp-completion-passthrough-all-completions - "Passthrough completion.")) - - (cond - ((equal lsp-completion-provider :none)) - ((and (not (equal lsp-completion-provider :none)) - (fboundp 'company-mode)) - (setq-local company-abort-on-unique-match nil) - (company-mode 1) - (setq-local company-backends (cl-adjoin 'company-capf company-backends :test #'equal))) - (t - (lsp--warn "Unable to autoconfigure company-mode."))) - - (when (bound-and-true-p company-mode) - (add-hook 'company-completion-started-hook - completion-started-fn - nil - t) - (add-hook 'company-after-completion-hook - after-completion-fn - nil - t)) - (add-hook 'lsp-unconfigure-hook #'lsp-completion--disable nil t)) - (t - (remove-hook 'completion-at-point-functions #'lsp-completion-at-point t) - (setq-local completion-category-defaults - (cl-remove 'lsp-capf completion-category-defaults :key #'cl-first)) - (setq-local completion-styles-alist - (cl-remove 'lsp-passthrough completion-styles-alist :key #'cl-first)) - (remove-hook 'lsp-unconfigure-hook #'lsp-completion--disable t) - (when (featurep 'company) - (remove-hook 'company-completion-started-hook - completion-started-fn - t) - (remove-hook 'company-after-completion-hook - after-completion-fn - t)))))) - -;;;###autoload -(add-hook 'lsp-configure-hook (lambda () - (when (and lsp-auto-configure - lsp-completion-enable) - (lsp-completion--enable)))) - -(lsp-consistency-check lsp-completion) - -(provide 'lsp-completion) -;;; lsp-completion.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-csharp.el b/emacs/elpa/lsp-mode-20241113.743/lsp-csharp.el @@ -1,573 +0,0 @@ -;;; lsp-csharp.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Jostein Kjønigsen, Saulius Menkevicius - -;; Author: Saulius Menkevicius <saulius.menkevicius@fastmail.com> -;; Keywords: - -;; 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: - -;; lsp-csharp client - -;;; Code: - -(require 'lsp-mode) -(require 'gnutls) -(require 'f) - -(defgroup lsp-csharp nil - "LSP support for C#, using the Omnisharp Language Server. -Version 1.34.3 minimum is required." - :group 'lsp-mode - :link '(url-link "https://github.com/OmniSharp/omnisharp-roslyn")) - -(defgroup lsp-csharp-omnisharp nil - "LSP support for C#, using the Omnisharp Language Server. -Version 1.34.3 minimum is required." - :group 'lsp-mode - :link '(url-link "https://github.com/OmniSharp/omnisharp-roslyn") - :package-version '(lsp-mode . "9.0.0")) - -(defconst lsp-csharp--omnisharp-metadata-uri-re - "^file:///%24metadata%24/Project/\\(.+\\)/Assembly/\\(.+\\)/Symbol/\\(.+\\)\.cs$" - "Regular expression matching omnisharp's metadata uri. -Group 1 contains the Project name -Group 2 contains the Assembly name -Group 3 contains the Type name") - -(defcustom lsp-csharp-server-install-dir - (f-join lsp-server-install-dir "omnisharp-roslyn/") - "Installation directory for OmniSharp Roslyn server." - :group 'lsp-csharp-omnisharp - :type 'directory) - -(defcustom lsp-csharp-server-path - nil - "The path to the OmniSharp Roslyn language-server binary. -Set this if you have the binary installed or have it built yourself." - :group 'lsp-csharp-omnisharp - :type '(string :tag "Single string value or nil")) - -(defcustom lsp-csharp-test-run-buffer-name - "*lsp-csharp test run*" - "The name of buffer used for outputting lsp-csharp test run results." - :group 'lsp-csharp-omnisharp - :type 'string) - -(defcustom lsp-csharp-solution-file - nil - "Solution to load when starting the server. -Usually this is to be set in your .dir-locals.el on the project root directory." - :group 'lsp-csharp-omnisharp - :type 'string) - -(defcustom lsp-csharp-omnisharp-roslyn-download-url - (concat "https://github.com/omnisharp/omnisharp-roslyn/releases/latest/download/" - (cond ((eq system-type 'windows-nt) - ; On Windows we're trying to avoid a crash starting 64bit .NET PE binaries in - ; Emacs by using x86 version of omnisharp-roslyn on older (<= 26.4) versions - ; of Emacs. See https://lists.nongnu.org/archive/html/bug-gnu-emacs/2017-06/msg00893.html" - (if (and (string-match "^x86_64-.*" system-configuration) - (version<= "26.4" emacs-version)) - "omnisharp-win-x64.zip" - "omnisharp-win-x86.zip")) - - ((eq system-type 'darwin) - (if (string-match "aarch64-.*" system-configuration) - "omnisharp-osx-arm64-net6.0.zip" - "omnisharp-osx-x64-net6.0.zip")) - - ((and (eq system-type 'gnu/linux) - (or (eq (string-match "^x86_64" system-configuration) 0) - (eq (string-match "^i[3-6]86" system-configuration) 0))) - "omnisharp-linux-x64-net6.0.zip") - - (t "omnisharp-mono.zip"))) - "Automatic download url for omnisharp-roslyn." - :group 'lsp-csharp-omnisharp - :type 'string) - -(defcustom lsp-csharp-omnisharp-roslyn-store-path - (f-join lsp-csharp-server-install-dir "latest" "omnisharp-roslyn.zip") - "The path where omnisharp-roslyn .zip archive will be stored." - :group 'lsp-csharp-omnisharp - :type 'file) - -(defcustom lsp-csharp-omnisharp-roslyn-binary-path - (f-join lsp-csharp-server-install-dir "latest" (if (eq system-type 'windows-nt) - "OmniSharp.exe" - "OmniSharp")) - "The path where omnisharp-roslyn binary after will be stored." - :group 'lsp-csharp-omnisharp - :type 'file) - -(defcustom lsp-csharp-omnisharp-roslyn-server-dir - (f-join lsp-csharp-server-install-dir "latest" "omnisharp-roslyn") - "The path where omnisharp-roslyn .zip archive will be extracted." - :group 'lsp-csharp-omnisharp - :type 'file) - - -(defcustom lsp-csharp-omnisharp-enable-decompilation-support - nil - "Decompile bytecode when browsing method metadata for types in assemblies. -Otherwise only declarations for the methods are visible (the default)." - :group 'lsp-csharp - :type 'boolean) - -(defcustom lsp-csharp-csharpls-use-dotnet-tool t - "Whether to use a dotnet tool version of the expected C# - language server; only available for csharp-ls" - :group 'lsp-csharp - :type 'boolean - :risky t) - -(defcustom lsp-csharp-csharpls-use-local-tool nil - "Whether to use csharp-ls as a global or local dotnet tool. - -Note: this variable has no effect if -lsp-csharp-csharpls-use-dotnet-tool is nil." - :group 'lsp-csharp - :type 'boolean - :risky t) - -(lsp-dependency - 'omnisharp-roslyn - `(:download :url lsp-csharp-omnisharp-roslyn-download-url - :decompress :zip - :store-path lsp-csharp-omnisharp-roslyn-store-path - :binary-path lsp-csharp-omnisharp-roslyn-binary-path - :set-executable? t) - '(:system "OmniSharp")) - -(defun lsp-csharp--omnisharp-download-server (_client callback error-callback _update?) - "Download zip package for omnisharp-roslyn and install it. -Will invoke CALLBACK on success, ERROR-CALLBACK on error." - (lsp-package-ensure 'omnisharp-roslyn callback error-callback)) - -(defun lsp-csharp--language-server-path () - "Resolve path to use to start the server." - (let ((executable-name (if (eq system-type 'windows-nt) - "OmniSharp.exe" - "OmniSharp"))) - (or (and lsp-csharp-server-path - (executable-find lsp-csharp-server-path)) - (executable-find executable-name) - (lsp-package-path 'omnisharp-roslyn)))) - -(defun lsp-csharp-open-project-file () - "Open corresponding project file (.csproj) for the current file." - (interactive) - (-let* ((project-info-req (lsp-make-omnisharp-project-information-request :file-name (buffer-file-name))) - (project-info (lsp-request "o#/project" project-info-req)) - ((&omnisharp:ProjectInformation :ms-build-project) project-info) - ((&omnisharp:MsBuildProject :path) ms-build-project)) - (find-file path))) - -(defun lsp-csharp--get-buffer-code-elements () - "Retrieve code structure by calling into the /v2/codestructure endpoint. -Returns :elements from omnisharp:CodeStructureResponse." - (-let* ((code-structure (lsp-request "o#/v2/codestructure" - (lsp-make-omnisharp-code-structure-request :file-name (buffer-file-name)))) - ((&omnisharp:CodeStructureResponse :elements) code-structure)) - elements)) - -(defun lsp-csharp--inspect-code-elements-recursively (fn elements) - "Invoke FN for every omnisharp:CodeElement found recursively in ELEMENTS." - (seq-each - (lambda (el) - (funcall fn el) - (-let (((&omnisharp:CodeElement :children) el)) - (lsp-csharp--inspect-code-elements-recursively fn children))) - elements)) - -(defun lsp-csharp--collect-code-elements-recursively (predicate elements) - "Flatten the omnisharp:CodeElement tree in ELEMENTS matching PREDICATE." - (let ((results nil)) - (lsp-csharp--inspect-code-elements-recursively (lambda (el) - (when (funcall predicate el) - (setq results (cons el results)))) - elements) - results)) - -(lsp-defun lsp-csharp--l-c-within-range (l c (&omnisharp:Range :start :end)) - "Determine if L (line) and C (column) are within RANGE." - (-let* (((&omnisharp:Point :line start-l :column start-c) start) - ((&omnisharp:Point :line end-l :column end-c) end)) - (or (and (= l start-l) (>= c start-c) (or (> end-l start-l) (<= c end-c))) - (and (> l start-l) (< l end-l)) - (and (= l end-l) (<= c end-c))))) - -(defun lsp-csharp--code-element-stack-on-l-c (l c elements) - "Return omnisharp:CodeElement stack at L (line) and C (column) in ELEMENTS tree." - (when-let ((matching-element (seq-find (lambda (el) - (-when-let* (((&omnisharp:CodeElement :ranges) el) - ((&omnisharp:RangeList :full?) ranges)) - (lsp-csharp--l-c-within-range l c full?))) - elements))) - (-let (((&omnisharp:CodeElement :children) matching-element)) - (cons matching-element (lsp-csharp--code-element-stack-on-l-c l c children))))) - -(defun lsp-csharp--code-element-stack-at-point () - "Return omnisharp:CodeElement stack at point as a list." - (let ((pos-line (plist-get (lsp--cur-position) :line)) - (pos-col (plist-get (lsp--cur-position) :character))) - (lsp-csharp--code-element-stack-on-l-c pos-line - pos-col - (lsp-csharp--get-buffer-code-elements)))) - -(lsp-defun lsp-csharp--code-element-test-method-p (element) - "Return test method name and test framework for a given ELEMENT." - (when element - (-when-let* (((&omnisharp:CodeElement :properties) element) - ((&omnisharp:CodeElementProperties :test-method-name? :test-framework?) properties)) - (list test-method-name? test-framework?)))) - -(defun lsp-csharp--reset-test-buffer (present-buffer) - "Create new or reuse an existing test result output buffer. -PRESENT-BUFFER will make the buffer be presented to the user." - (with-current-buffer (get-buffer-create lsp-csharp-test-run-buffer-name) - (compilation-mode) - (read-only-mode) - (let ((inhibit-read-only t)) - (erase-buffer))) - - (when present-buffer - (display-buffer lsp-csharp-test-run-buffer-name))) - -(defun lsp-csharp--start-tests (test-method-framework test-method-names) - "Run test(s) identified by TEST-METHOD-NAMES using TEST-METHOD-FRAMEWORK." - (if (and test-method-framework test-method-names) - (let ((request-message (lsp-make-omnisharp-run-tests-in-class-request - :file-name (buffer-file-name) - :test-frameworkname test-method-framework - :method-names (vconcat test-method-names)))) - (lsp-csharp--reset-test-buffer t) - (lsp-session-set-metadata "last-test-method-framework" test-method-framework) - (lsp-session-set-metadata "last-test-method-names" test-method-names) - (lsp-request-async "o#/v2/runtestsinclass" - request-message - (-lambda ((&omnisharp:RunTestResponse)) - (message "lsp-csharp: Test run has started")))) - (message "lsp-csharp: No test methods to run"))) - -(defun lsp-csharp--test-message (message) - "Emit a MESSAGE to lsp-csharp test run buffer." - (when-let ((existing-buffer (get-buffer lsp-csharp-test-run-buffer-name)) - (inhibit-read-only t)) - (with-current-buffer existing-buffer - (save-excursion - (goto-char (point-max)) - (insert message "\n"))))) - -(defun lsp-csharp-run-test-at-point () - "Start test run at current point (if any)." - (interactive) - (let* ((stack (lsp-csharp--code-element-stack-at-point)) - (element-on-point (car (last stack))) - (test-method (lsp-csharp--code-element-test-method-p element-on-point)) - (test-method-name (car test-method)) - (test-method-framework (car (cdr test-method)))) - (lsp-csharp--start-tests test-method-framework (list test-method-name)))) - -(defun lsp-csharp-run-all-tests-in-buffer () - "Run all test methods in the current buffer." - (interactive) - (let* ((elements (lsp-csharp--get-buffer-code-elements)) - (test-methods (lsp-csharp--collect-code-elements-recursively 'lsp-csharp--code-element-test-method-p elements)) - (test-method-framework (car (cdr (lsp-csharp--code-element-test-method-p (car test-methods))))) - (test-method-names (mapcar (lambda (method) - (car (lsp-csharp--code-element-test-method-p method))) - test-methods))) - (lsp-csharp--start-tests test-method-framework test-method-names))) - -(defun lsp-csharp-run-test-in-buffer () - "Run selected test in current buffer." - (interactive) - (when-let* ((elements (lsp-csharp--get-buffer-code-elements)) - (test-methods (lsp-csharp--collect-code-elements-recursively 'lsp-csharp--code-element-test-method-p elements)) - (test-method-framework (car (cdr (lsp-csharp--code-element-test-method-p (car test-methods))))) - (test-method-names (mapcar (lambda (method) - (car (lsp-csharp--code-element-test-method-p method))) - test-methods)) - (selected-test-method-name (lsp--completing-read "Select test:" test-method-names 'identity))) - (lsp-csharp--start-tests test-method-framework (list selected-test-method-name)))) - -(defun lsp-csharp-run-last-tests () - "Re-run test(s) that were run last time." - (interactive) - (if-let ((last-test-method-framework (lsp-session-get-metadata "last-test-method-framework")) - (last-test-method-names (lsp-session-get-metadata "last-test-method-names"))) - (lsp-csharp--start-tests last-test-method-framework last-test-method-names) - (message "lsp-csharp: No test method(s) found to be ran previously on this workspace"))) - -(lsp-defun lsp-csharp--handle-os-error (_workspace (&omnisharp:ErrorMessage :file-name :text)) - "Handle the `o#/error' (interop) notification displaying a message." - (lsp-warn "%s: %s" file-name text)) - -(lsp-defun lsp-csharp--handle-os-testmessage (_workspace (&omnisharp:TestMessageEvent :message)) - "Handle the `o#/testmessage and display test message on test output buffer." - (lsp-csharp--test-message message)) - -(lsp-defun lsp-csharp--handle-os-testcompleted (_workspace (&omnisharp:DotNetTestResult - :method-name - :outcome - :error-message - :error-stack-trace - :standard-output - :standard-error)) - "Handle the `o#/testcompleted' message from the server. - -Will display the results of the test on the lsp-csharp test output buffer." - (let ((passed (string-equal "passed" outcome))) - (lsp-csharp--test-message - (format "[%s] %s " - (propertize (upcase outcome) 'font-lock-face (if passed 'success 'error)) - method-name)) - - (unless passed - (lsp-csharp--test-message error-message) - - (when error-stack-trace - (lsp-csharp--test-message error-stack-trace)) - - (unless (seq-empty-p standard-output) - (lsp-csharp--test-message "STANDARD OUTPUT:") - (seq-doseq (stdout-line standard-output) - (lsp-csharp--test-message stdout-line))) - - (unless (seq-empty-p standard-error) - (lsp-csharp--test-message "STANDARD ERROR:") - (seq-doseq (stderr-line standard-error) - (lsp-csharp--test-message stderr-line)))))) - -(lsp-defun lsp-csharp--action-client-find-references ((&Command :arguments?)) - "Read first argument from ACTION as Location and display xrefs for that location -using the `textDocument/references' request." - (-if-let* (((&Location :uri :range) (lsp-seq-first arguments?)) - ((&Range :start range-start) range) - (find-refs-params (append (lsp--text-document-position-params (list :uri uri) range-start) - (list :context (list :includeDeclaration json-false)))) - (locations-found (lsp-request "textDocument/references" find-refs-params))) - (lsp-show-xrefs (lsp--locations-to-xref-items locations-found) nil t) - (message "No references found"))) - -(defun lsp-csharp--omnisharp-path->qualified-name (path) - "Convert PATH to qualified-namespace-like name." - (replace-regexp-in-string - (regexp-quote "/") - "." - path)) - -(defun lsp-csharp--omnisharp-metadata-uri-handler (uri) - "Handle `file:/(metadata)' URI from omnisharp-roslyn server. - -The URI is parsed and then `o#/metadata' request is issued to retrieve -metadata from the server. A cache file is created on project root dir that -stores this metadata and filename is returned so lsp-mode can display this file." - (string-match lsp-csharp--omnisharp-metadata-uri-re uri) - (-when-let* ((project-name (lsp-csharp--omnisharp-path->qualified-name (url-unhex-string (match-string 1 uri)))) - (assembly-name (lsp-csharp--omnisharp-path->qualified-name (url-unhex-string (match-string 2 uri)))) - (type-name (lsp-csharp--omnisharp-path->qualified-name (url-unhex-string (match-string 3 uri)))) - (metadata-req (lsp-make-omnisharp-metadata-request :project-name project-name - :assembly-name assembly-name - :type-name type-name)) - (metadata (lsp-request "o#/metadata" metadata-req)) - ((&omnisharp:MetadataResponse :source-name :source) metadata) - (filename (f-join ".cache" - "lsp-csharp" - "metadata" - "Project" project-name - "Assembly" assembly-name - "Symbol" (concat type-name ".cs"))) - (file-location (expand-file-name filename (lsp--suggest-project-root))) - (metadata-file-location (concat file-location ".metadata-uri")) - (path (f-dirname file-location))) - - (unless (find-buffer-visiting file-location) - (unless (file-directory-p path) - (make-directory path t)) - - (with-temp-file metadata-file-location - (insert uri)) - - (with-temp-file file-location - (insert source))) - - file-location)) - -(defun lsp-csharp--omnisharp-uri->path-fn (uri) - "Custom implementation of lsp--uri-to-path function to glue omnisharp's -metadata uri." - (if (string-match-p lsp-csharp--omnisharp-metadata-uri-re uri) - (lsp-csharp--omnisharp-metadata-uri-handler uri) - (lsp--uri-to-path-1 uri))) - -(defun lsp-csharp--omnisharp-environment-fn () - "Build environment structure for current values of lsp-csharp customizables. -See https://github.com/OmniSharp/omnisharp-roslyn/wiki/Configuration-Options" - `(("OMNISHARP_RoslynExtensionsOptions:enableDecompilationSupport" . ,(if lsp-csharp-omnisharp-enable-decompilation-support "true" "false")))) - -(lsp-register-client - (make-lsp-client :new-connection - (lsp-stdio-connection - #'(lambda () - (append - (list (lsp-csharp--language-server-path) "-lsp") - (when lsp-csharp-solution-file - (list "-s" (expand-file-name lsp-csharp-solution-file))))) - #'(lambda () - (when-let ((binary (lsp-csharp--language-server-path))) - (f-exists? binary)))) - :activation-fn (lsp-activate-on "csharp") - :server-id 'omnisharp - :priority -1 - :uri->path-fn #'lsp-csharp--omnisharp-uri->path-fn - :environment-fn #'lsp-csharp--omnisharp-environment-fn - :action-handlers (ht ("omnisharp/client/findReferences" 'lsp-csharp--action-client-find-references)) - :notification-handlers (ht ("o#/projectadded" 'ignore) - ("o#/projectchanged" 'ignore) - ("o#/projectremoved" 'ignore) - ("o#/packagerestorestarted" 'ignore) - ("o#/msbuildprojectdiagnostics" 'ignore) - ("o#/packagerestorefinished" 'ignore) - ("o#/unresolveddependencies" 'ignore) - ("o#/error" 'lsp-csharp--handle-os-error) - ("o#/testmessage" 'lsp-csharp--handle-os-testmessage) - ("o#/testcompleted" 'lsp-csharp--handle-os-testcompleted) - ("o#/projectconfiguration" 'ignore) - ("o#/projectdiagnosticstatus" 'ignore) - ("o#/backgrounddiagnosticstatus" 'ignore)) - :download-server-fn #'lsp-csharp--omnisharp-download-server)) - -;; -;; Alternative "csharp-ls" language server support -;; see https://github.com/razzmatazz/csharp-language-server -;; -(lsp-defun lsp-csharp--cls-metadata-uri-handler (uri) - "Handle `csharp:/(metadata)' uri from csharp-ls server. - -`csharp/metadata' request is issued to retrieve metadata from the server. -A cache file is created on project root dir that stores this metadata and -filename is returned so lsp-mode can display this file." - - (-when-let* ((metadata-req (lsp-make-csharp-ls-c-sharp-metadata - :text-document (lsp-make-text-document-identifier :uri uri))) - (metadata (lsp-request "csharp/metadata" metadata-req)) - ((&csharp-ls:CSharpMetadataResponse :project-name - :assembly-name - :symbol-name - :source) metadata) - (filename (f-join ".cache" - "lsp-csharp" - "metadata" - "projects" project-name - "assemblies" assembly-name - (concat symbol-name ".cs"))) - (file-location (expand-file-name filename (lsp-workspace-root))) - (metadata-file-location (concat file-location ".metadata-uri")) - (path (f-dirname file-location))) - - (unless (file-exists-p file-location) - (unless (file-directory-p path) - (make-directory path t)) - - (with-temp-file metadata-file-location - (insert uri)) - - (with-temp-file file-location - (insert source))) - - file-location)) - -(defun lsp-csharp--cls-before-file-open (_workspace) - "Set `lsp-buffer-uri' variable after C# file is open from *.metadata-uri file." - - (let ((metadata-file-name (concat buffer-file-name ".metadata-uri"))) - (setq-local lsp-buffer-uri - (when (file-exists-p metadata-file-name) - (with-temp-buffer (insert-file-contents metadata-file-name) - (buffer-string)))))) - -(defun lsp-csharp--cls-find-executable () - (or (when lsp-csharp-csharpls-use-dotnet-tool - (if lsp-csharp-csharpls-use-local-tool - (list "dotnet" "tool" "run" "csharp-ls") - (list "csharp-ls"))) - (executable-find "csharp-ls") - (f-join (or (getenv "USERPROFILE") (getenv "HOME")) - ".dotnet" "tools" "csharp-ls"))) - -(defun lsp-csharp--cls-make-launch-cmd () - "Return command line to invoke csharp-ls." - - ;; emacs-28.1 on macOS has an issue - ;; that it launches processes using posix_spawn but does not reset sigmask properly - ;; thus causing dotnet runtime to lockup awaiting a SIGCHLD signal that never comes - ;; from subprocesses that quit - ;; - ;; as a workaround we will wrap csharp-ls invocation in "/bin/ksh -c" on macos - ;; so it launches with proper sigmask - ;; - ;; see https://lists.gnu.org/archive/html/emacs-devel/2022-02/msg00461.html - - (let ((startup-wrapper (cond ((and (eq 'darwin system-type) - (version= "28.1" emacs-version)) - (list "/bin/ksh" "-c")) - - (t nil))) - - (csharp-ls-exec (lsp-csharp--cls-find-executable)) - - (solution-file-params (when lsp-csharp-solution-file - (list "-s" lsp-csharp-solution-file)))) - (append startup-wrapper - (if (listp csharp-ls-exec) - csharp-ls-exec - (list csharp-ls-exec)) - solution-file-params))) - -(defun lsp-csharp--cls-test-csharp-ls-present () - "Return non-nil if dotnet tool csharp-ls is installed as a dotnet tool." - (string-match-p "csharp-ls" - (shell-command-to-string - (if lsp-csharp-csharpls-use-local-tool - "dotnet tool list" - "dotnet tool list -g")))) - -(defun lsp-csharp--cls-download-server (_client callback error-callback update?) - "Install/update csharp-ls language server using `dotnet tool'. - -Will invoke CALLBACK or ERROR-CALLBACK based on result. -Will update if UPDATE? is t" - (lsp-async-start-process - callback - error-callback - "dotnet" "tool" (if update? "update" "install") (if lsp-csharp-csharpls-use-local-tool "" "-g") "csharp-ls")) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection #'lsp-csharp--cls-make-launch-cmd) - :priority -2 - :server-id 'csharp-ls - :activation-fn (lsp-activate-on "csharp") - :before-file-open-fn #'lsp-csharp--cls-before-file-open - :uri-handlers (ht ("csharp" #'lsp-csharp--cls-metadata-uri-handler)) - :download-server-fn #'lsp-csharp--cls-download-server)) - -(lsp-consistency-check lsp-csharp) - -(provide 'lsp-csharp) -;;; lsp-csharp.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-cucumber.el b/emacs/elpa/lsp-mode-20241113.743/lsp-cucumber.el @@ -1,97 +0,0 @@ -;;; lsp-cucumber.el --- LSP Clients for Cucumber -*- lexical-binding: t; -*- - -;; Copyright (C) 2024 Shen, Jen-Chieh - -;; 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 this program. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; LSP server implementation for Cucumber -;; - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-cucumber nil - "LSP server implementation for Cucumber." - :group 'lsp-mode - :link '(url-link "https://github.com/cucumber/language-server")) - -(defcustom lsp-cucumber-server-path nil - "Path points for Cucumber language server. - -This is only for development use." - :type 'string - :group 'lsp-cucumber) - -(defcustom lsp-cucumber-active-modes - '( feature-mode) - "List of major mode that work with Cucumber language server." - :type 'list - :group 'lsp-cucumber) - -(lsp-defcustom lsp-cucumber-features - ["src/test/**/*.feature" "features/**/*.feature" "tests/**/*.feature" "*specs*/**/*.feature"] - "Configure where the extension should look for .feature files." - :type '(repeat string) - :group 'lsp-cucumber - :package-version '(lsp-mode . "9.0.0") - :lsp-path "cucumber.features") - -(lsp-defcustom lsp-cucumber-glue - ["*specs*/**/*.cs" "features/**/*.js" "features/**/*.jsx" "features/**/*.php" "features/**/*.py" "features/**/*.rs" "features/**/*.rb" "features/**/*.ts" "features/**/*.tsx" "features/**/*_test.go" "**/*_test.go" "src/test/**/*.java" "tests/**/*.py" "tests/**/*.rs"] - "Configure where the extension should look for source code where -step definitions and parameter types are defined." - :type '(repeat string) - :group 'lsp-cucumber - :package-version '(lsp-mode . "9.0.0") - :lsp-path "cucumber.glue") - -(lsp-defcustom lsp-cucumber-parameter-types [] - "Configure parameters types to convert output parameters to your own types. - -Details at https://github.com/cucumber/cucumber-expressions#custom-parameter-types. -Sample: -[(:name \"actor\" - :regexp \"[A-Z][a-z]+\")]" - :type '(lsp-repeatable-vector plist) - :group 'lsp-cucumber - :package-version '(lsp-mode . "9.0.0") - :lsp-path "cucumber.parameterTypes") - -(defun lsp-cucumber--server-command () - "Generate startup command for Cucumber language server." - (or (and lsp-cucumber-server-path - (list lsp-cucumber-server-path "--stdio")) - (list (lsp-package-path 'cucumber-language-server) "--stdio"))) - -(lsp-dependency 'cucumber-language-server - '(:system "cucumber-language-server") - '(:npm :package "@cucumber/language-server" - :path "cucumber-language-server")) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection #'lsp-cucumber--server-command) - :major-modes lsp-cucumber-active-modes - :priority -1 - :server-id 'cucumber-language-server - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'cucumber-language-server callback error-callback)))) - -(provide 'lsp-cucumber) -;;; lsp-cucumber.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-cucumber.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-cucumber.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-diagnostics.el b/emacs/elpa/lsp-mode-20241113.743/lsp-diagnostics.el @@ -1,373 +0,0 @@ -;;; lsp-diagnostics.el --- LSP diagnostics integration -*- lexical-binding: t; -*- -;; -;; Copyright (C) 2020 emacs-lsp maintainers -;; -;; 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: -;; -;; LSP diagnostics integration -;; -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-diagnostics nil - "LSP support for diagnostics" - :prefix "lsp-disagnostics-" - :group 'lsp-mode - :tag "LSP Diagnostics") - -;;;###autoload -(define-obsolete-variable-alias 'lsp-diagnostic-package - 'lsp-diagnostics-provider "lsp-mode 7.0.1") - -(defcustom lsp-diagnostics-provider :auto - "The checker backend provider." - :type - '(choice - (const :tag "Pick flycheck if present and fallback to flymake" :auto) - (const :tag "Pick flycheck" :flycheck) - (const :tag "Pick flymake" :flymake) - (const :tag "Use neither flymake nor lsp" :none) - (const :tag "Prefer flymake" t) - (const :tag "Prefer flycheck" nil)) - :group 'lsp-diagnostics - :package-version '(lsp-mode . "6.3")) - -;;;###autoload -(define-obsolete-variable-alias 'lsp-flycheck-default-level - 'lsp-diagnostics-flycheck-default-level "lsp-mode 7.0.1") - -(defcustom lsp-diagnostics-flycheck-default-level 'error - "Error level to use when the server does not report back a diagnostic level." - :type '(choice - (const error) - (const warning) - (const info)) - :group 'lsp-diagnostics) - -(defcustom lsp-diagnostics-attributes - `((unnecessary :foreground "gray") - (deprecated :strike-through t)) - "The Attributes used on the diagnostics. -List containing (tag attributes) where tag is the LSP diagnostic tag and -attributes is a `plist' containing face attributes which will be applied -on top the flycheck face for that error level." - :type '(repeat (list symbol plist)) - :group 'lsp-diagnostics) - -(defcustom lsp-diagnostics-disabled-modes nil - "A list of major models for which `lsp-diagnostics-mode' should be disabled." - :type '(repeat symbol) - :group 'lsp-diagnostics - :package-version '(lsp-mode . "8.0.0")) - -;; Flycheck integration - -(declare-function flycheck-mode "ext:flycheck") -(declare-function flycheck-define-generic-checker - "ext:flycheck" (symbol docstring &rest properties)) -(declare-function flycheck-error-new "ext:flycheck" t t) -(declare-function flycheck-error-message "ext:flycheck" (err) t) -(declare-function flycheck-define-error-level "ext:flycheck" (level &rest properties)) -(declare-function flycheck-buffer "ext:flycheck") -(declare-function flycheck-valid-checker-p "ext:flycheck") -(declare-function flycheck-stop "ext:flycheck") - -(defvar flycheck-mode) -(defvar flycheck-check-syntax-automatically) -(defvar flycheck-checker) -(defvar flycheck-checkers) - - -(defvar-local lsp-diagnostics--flycheck-enabled nil - "True when lsp diagnostics flycheck integration has been enabled in this buffer.") - -(defvar-local lsp-diagnostics--flycheck-checker nil - "The value of flycheck-checker before lsp diagnostics was activated.") - -(defun lsp-diagnostics--flycheck-level (flycheck-level tags) - "Generate flycheck level from the original FLYCHECK-LEVEL (e. -g. `error', `warning') and list of LSP TAGS." - (let ((name (format "lsp-flycheck-%s-%s" - flycheck-level - (mapconcat #'symbol-name tags "-")))) - (or (intern-soft name) - (let* ((face (--doto (intern (format "%s-face" name)) - (copy-face (-> flycheck-level - (get 'flycheck-overlay-category) - (get 'face)) - it) - (mapc (lambda (tag) - (apply #'set-face-attribute it nil - (cl-rest (assoc tag lsp-diagnostics-attributes)))) - tags))) - (category (--doto (intern (format "%s-category" name)) - (setf (get it 'face) face - (get it 'priority) 100))) - (new-level (intern name)) - (bitmap (or (get flycheck-level 'flycheck-fringe-bitmaps) - (get flycheck-level 'flycheck-fringe-bitmap-double-arrow)))) - (flycheck-define-error-level new-level - :severity (get flycheck-level 'flycheck-error-severity) - :compilation-level (get flycheck-level 'flycheck-compilation-level) - :overlay-category category - :fringe-bitmap bitmap - :fringe-face (get flycheck-level 'flycheck-fringe-face) - :error-list-face face) - new-level)))) - -(defun lsp-diagnostics--flycheck-calculate-level (severity tags) - "Calculate flycheck level by SEVERITY and TAGS." - (let ((level (pcase severity - (1 'error) - (2 'warning) - (3 'info) - (4 'info) - (_ lsp-flycheck-default-level))) - ;; materialize only first tag. - (tags (seq-map (lambda (tag) - (cond - ((= tag lsp/diagnostic-tag-unnecessary) 'unnecessary) - ((= tag lsp/diagnostic-tag-deprecated) 'deprecated))) - tags))) - (if tags - (lsp-diagnostics--flycheck-level level tags) - level))) - -(defun lsp-diagnostics--flycheck-start (checker callback) - "Start an LSP syntax check with CHECKER. - -CALLBACK is the status callback passed by Flycheck." - - (remove-hook 'lsp-on-idle-hook #'lsp-diagnostics--flycheck-buffer t) - - (->> (lsp--get-buffer-diagnostics) - (-map (-lambda ((&Diagnostic :message :severity? :tags? :code? :source? - :range (&Range :start (start &as &Position - :line start-line - :character start-character) - :end (end &as &Position - :line end-line - :character end-character)))) - (flycheck-error-new - :buffer (current-buffer) - :checker checker - :filename buffer-file-name - :message message - :level (lsp-diagnostics--flycheck-calculate-level severity? tags?) - :id code? - :group source? - :line (lsp-translate-line (1+ start-line)) - :column (1+ (lsp-translate-column start-character)) - :end-line (lsp-translate-line (1+ end-line)) - :end-column (unless (lsp--position-equal start end) - (1+ (lsp-translate-column end-character)))))) - (funcall callback 'finished))) - -(defun lsp-diagnostics--flycheck-buffer () - "Trigger flyckeck on buffer." - (remove-hook 'lsp-on-idle-hook #'lsp-diagnostics--flycheck-buffer t) - (when (bound-and-true-p flycheck-mode) - (flycheck-buffer))) - -(defun lsp-diagnostics--flycheck-report () - "Report flycheck. -This callback is invoked when new diagnostics are received -from the language server." - (when (and (or (memq 'idle-change flycheck-check-syntax-automatically) - (and (memq 'save flycheck-check-syntax-automatically) - (not (buffer-modified-p)))) - lsp--cur-workspace) - ;; make sure diagnostics are published even if the diagnostics - ;; have been received after idle-change has been triggered - (->> lsp--cur-workspace - (lsp--workspace-buffers) - (mapc (lambda (buffer) - (when (and (lsp-buffer-live-p buffer) - (or - (not (bufferp buffer)) - (and (get-buffer-window buffer) - (not (-contains? (buffer-local-value 'lsp-on-idle-hook buffer) - 'lsp-diagnostics--flycheck-buffer))))) - (lsp-with-current-buffer buffer - (add-hook 'lsp-on-idle-hook #'lsp-diagnostics--flycheck-buffer nil t) - (lsp--idle-reschedule (current-buffer))))))))) - -(cl-defgeneric lsp-diagnostics-flycheck-error-explainer (e _server-id) - "Explain a `flycheck-error' E in a generic way depending on the SERVER-ID." - (flycheck-error-message e)) - -(defvar lsp-diagnostics-mode) ;; properly defined by define-minor-mode below - -;;;###autoload -(defun lsp-diagnostics-lsp-checker-if-needed () - (unless (flycheck-valid-checker-p 'lsp) - (flycheck-define-generic-checker 'lsp - "A syntax checker using the Language Server Protocol (LSP) -provided by lsp-mode. -See https://github.com/emacs-lsp/lsp-mode." - :start #'lsp-diagnostics--flycheck-start - :modes '(lsp-placeholder-mode) ;; placeholder - :predicate (lambda () lsp-diagnostics-mode) - :error-explainer (lambda (e) - (lsp-diagnostics-flycheck-error-explainer - e (lsp--workspace-server-id (car-safe (lsp-workspaces)))))))) - -(defun lsp-diagnostics-flycheck-enable (&rest _) - "Enable flycheck integration for the current buffer." - (require 'flycheck) - (lsp-diagnostics-lsp-checker-if-needed) - (and (not lsp-diagnostics--flycheck-enabled) - (not (eq flycheck-checker 'lsp)) - (setq lsp-diagnostics--flycheck-checker flycheck-checker)) - (setq-local lsp-diagnostics--flycheck-enabled t) - (flycheck-mode 1) - (flycheck-stop) - (setq-local flycheck-checker 'lsp) - (lsp-flycheck-add-mode major-mode) - (add-to-list 'flycheck-checkers 'lsp) - (add-hook 'lsp-diagnostics-updated-hook #'lsp-diagnostics--flycheck-report nil t) - (add-hook 'lsp-managed-mode-hook #'lsp-diagnostics--flycheck-report nil t)) - -(defun lsp-diagnostics-flycheck-disable () - "Disable flycheck integration for the current buffer is it was enabled." - (when lsp-diagnostics--flycheck-enabled - (flycheck-stop) - (when (eq flycheck-checker 'lsp) - (setq-local flycheck-checker lsp-diagnostics--flycheck-checker)) - (setq lsp-diagnostics--flycheck-checker nil) - (setq-local lsp-diagnostics--flycheck-enabled nil) - (when flycheck-mode - (flycheck-mode 1)))) - -;; Flymake integration - -(declare-function flymake-mode "ext:flymake") -(declare-function flymake-make-diagnostic "ext:flymake") -(declare-function flymake-diag-region "ext:flymake") - -(defvar flymake-diagnostic-functions) -(defvar flymake-mode) -(defvar-local lsp-diagnostics--flymake-report-fn nil) - -(defun lsp-diagnostics--flymake-setup () - "Setup flymake." - (setq lsp-diagnostics--flymake-report-fn nil) - (add-hook 'flymake-diagnostic-functions 'lsp-diagnostics--flymake-backend nil t) - (add-hook 'lsp-diagnostics-updated-hook 'lsp-diagnostics--flymake-after-diagnostics nil t) - (flymake-mode 1)) - -(defun lsp-diagnostics--flymake-after-diagnostics () - "Handler for `lsp-diagnostics-updated-hook'." - (cond - ((and lsp-diagnostics--flymake-report-fn flymake-mode) - (lsp-diagnostics--flymake-update-diagnostics)) - ((not flymake-mode) - (setq lsp-diagnostics--flymake-report-fn nil)))) - -(defun lsp-diagnostics--flymake-backend (report-fn &rest _args) - "Flymake backend using REPORT-FN." - (let ((first-run (null lsp-diagnostics--flymake-report-fn))) - (setq lsp-diagnostics--flymake-report-fn report-fn) - (when first-run - (lsp-diagnostics--flymake-update-diagnostics)))) - -(defun lsp-diagnostics--flymake-update-diagnostics () - "Report new diagnostics to flymake." - (funcall lsp-diagnostics--flymake-report-fn - (-some->> (lsp-diagnostics t) - (gethash (lsp--fix-path-casing buffer-file-name)) - (--map (-let* (((&Diagnostic :message :severity? - :range (range &as &Range - :start (&Position :line start-line :character) - :end (&Position :line end-line))) it) - ((start . end) (lsp--range-to-region range))) - (when (= start end) - (if-let ((region (flymake-diag-region (current-buffer) - (1+ start-line) - character))) - (setq start (car region) - end (cdr region)) - (lsp-save-restriction-and-excursion - (goto-char (point-min)) - (setq start (line-beginning-position (1+ start-line)) - end (line-end-position (1+ end-line)))))) - (flymake-make-diagnostic (current-buffer) - start - end - (cl-case severity? - (1 :error) - (2 :warning) - (t :note)) - message)))) - ;; This :region keyword forces flymake to delete old diagnostics in - ;; case the buffer hasn't changed since the last call to the report - ;; function. See https://github.com/joaotavora/eglot/issues/159 - :region (cons (point-min) (point-max)))) - - - -;;;###autoload -(defun lsp-diagnostics--enable () - "Enable LSP checker support." - (when (and (member lsp-diagnostics-provider '(:auto :none :flycheck :flymake t nil)) - (not (member major-mode lsp-diagnostics-disabled-modes))) - (lsp-diagnostics-mode 1))) - -(defun lsp-diagnostics--disable () - "Disable LSP checker support." - (lsp-diagnostics-mode -1)) - -;;;###autoload -(define-minor-mode lsp-diagnostics-mode - "Toggle LSP diagnostics integration." - :group 'lsp-diagnostics - :global nil - :lighter "" - (cond - (lsp-diagnostics-mode - (cond - ((and (or - (and (eq lsp-diagnostics-provider :auto) - (functionp 'flycheck-mode)) - (and (eq lsp-diagnostics-provider :flycheck) - (or (functionp 'flycheck-mode) - (user-error "The lsp-diagnostics-provider is set to :flycheck but flycheck is not installed?"))) - ;; legacy - (null lsp-diagnostics-provider)) - (require 'flycheck nil t)) - (lsp-diagnostics-flycheck-enable)) - ((or (eq lsp-diagnostics-provider :auto) - (eq lsp-diagnostics-provider :flymake) - (eq lsp-diagnostics-provider t)) - (require 'flymake) - (lsp-diagnostics--flymake-setup)) - ((not (eq lsp-diagnostics-provider :none)) - (lsp--warn "Unable to autoconfigure flycheck/flymake. The diagnostics won't be rendered."))) - - (add-hook 'lsp-unconfigure-hook #'lsp-diagnostics--disable nil t)) - (t (lsp-diagnostics-flycheck-disable) - (remove-hook 'lsp-unconfigure-hook #'lsp-diagnostics--disable t)))) - -;;;###autoload -(add-hook 'lsp-configure-hook (lambda () - (when lsp-auto-configure - (lsp-diagnostics--enable)))) - -(lsp-consistency-check lsp-diagnostics) - -(provide 'lsp-diagnostics) -;;; lsp-diagnostics.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-dired.el b/emacs/elpa/lsp-mode-20241113.743/lsp-dired.el @@ -1,181 +0,0 @@ -;;; lsp-dired.el --- `lsp-mode' diagnostics integrated into `dired' -*- lexical-binding: t -*- - -;; Copyright (C) 2021 - -;; Author: Alexander Miller <alexanderm@web.de> -;; Author: Ivan Yonchovski <yyoncho@gmail.com> - -;; 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: -;;; `lsp-mode' diagnostics integrated into `dired' - -;;; Code: - -(require 'dired) -(require 'pcase) -(require 'lsp-mode) - -(defgroup lsp-dired nil - "LSP support for dired" - :prefix "lsp-dired-" - :group 'lsp-mode - :tag "LSP Dired") - -(defvar lsp-dired--ranger-adjust nil) -(with-eval-after-load 'ranger (setf lsp-dired--ranger-adjust t)) - -(defvar-local lsp-dired-displayed nil - "Flags whether icons have been added.") - -(defvar-local lsp-dired--covered-subdirs nil - "List of subdirs icons were already added for.") - -(defun lsp-dired--display () - "Display the icons of files in a dired buffer." - (when (and (display-graphic-p) - (not lsp-dired-displayed) - dired-subdir-alist) - (setq-local lsp-dired-displayed t) - (pcase-dolist (`(,path . ,pos) dired-subdir-alist) - (lsp-dired--insert-for-subdir path pos)))) - -(defun lsp-dired--insert-for-subdir (path pos) - "Display icons for subdir PATH at given POS." - (let ((buf (current-buffer))) - ;; run the function after current to make sure that we are creating the - ;; overlays after `treemacs-icons-dired' has run. - (run-with-idle-timer - 0.0 nil - (lambda () - (unless (and (member path lsp-dired--covered-subdirs) - (not (buffer-live-p buf))) - (with-current-buffer buf - (add-to-list 'lsp-dired--covered-subdirs path) - (let (buffer-read-only) - (save-excursion - (goto-char pos) - (forward-line (if lsp-dired--ranger-adjust 1 2)) - (cl-block :file - (while (not (eobp)) - (if (dired-move-to-filename nil) - (let* ((file (dired-get-filename nil t)) - (bol (progn - (search-forward-regexp "^[[:space:]]*" (line-end-position) t) - (point))) - (face (lsp-dired--face-for-path file))) - (when face - (-doto (make-overlay bol (line-end-position)) - (overlay-put 'evaporate t) - (overlay-put 'face face)))) - (cl-return-from :file nil)) - (forward-line 1))))))))))) - -(defface lsp-dired-path-face '((t :inherit font-lock-string-face)) - "Face used for breadcrumb paths on headerline." - :group 'lsp-dired) - -(defface lsp-dired-path-error-face - '((t :underline (:style wave :color "Red1"))) - "Face used for breadcrumb paths on headerline when there is an error under -that path" - :group 'lsp-dired) - -(defface lsp-dired-path-warning-face - '((t :underline (:style wave :color "Yellow"))) - "Face used for breadcrumb paths on headerline when there is an warning under -that path" - :group 'lsp-dired) - -(defface lsp-dired-path-info-face - '((t :underline (:style wave :color "Green"))) - "Face used for breadcrumb paths on headerline when there is an info under that -path" - :group 'lsp-dired) - -(defface lsp-dired-path-hint-face - '((t :underline (:style wave :color "Green"))) - "Face used for breadcrumb paths on headerline when there is an hint under that -path" - :group 'lsp-dired) - -(defun lsp-dired--face-for-path (dir) - "Calculate the face for DIR." - (when-let ((diags (lsp-diagnostics-stats-for (directory-file-name dir)))) - (cl-labels ((check-severity - (severity) - (not (zerop (aref diags severity))))) - (cond - ((check-severity lsp/diagnostic-severity-error) - 'lsp-dired-path-error-face) - ((check-severity lsp/diagnostic-severity-warning) - 'lsp-dired-path-warning-face) - ((check-severity lsp/diagnostic-severity-information) - 'lsp-dired-path-info-face) - ((check-severity lsp/diagnostic-severity-hint) - 'lsp-dired-path-hint-face))))) - -(defun lsp-dired--insert-subdir-advice (&rest args) - "Advice to dired & dired+ insert-subdir commands. -Will add icons for the subdir in the `car' of ARGS." - (let* ((path (car args)) - (pos (cdr (assoc path dired-subdir-alist)))) - (when pos - (lsp-dired--insert-for-subdir path pos)))) - -(defun lsp-dired--kill-subdir-advice (&rest _args) - "Advice to dired kill-subdir commands. -Will remove the killed subdir from `lsp-dired--covered-subdirs'." - (setf lsp-dired--covered-subdirs (delete (dired-current-directory) - lsp-dired--covered-subdirs))) - -(defun lsp-dired--reset (&rest _args) - "Reset metadata on revert." - (setq-local lsp-dired--covered-subdirs nil) - (setq-local lsp-dired-displayed nil)) - -;;;###autoload -(define-minor-mode lsp-dired-mode - "Display `lsp-mode' icons for each file in a dired buffer." - :require 'lsp-dired - :init-value nil - :global t - :group 'lsp-dired - (cond - (lsp-dired-mode - (add-hook 'dired-after-readin-hook #'lsp-dired--display) - (advice-add 'dired-kill-subdir :before #'lsp-dired--kill-subdir-advice) - (advice-add 'dired-insert-subdir :after #'lsp-dired--insert-subdir-advice) - (advice-add 'diredp-insert-subdirs :after #'lsp-dired--insert-subdir-advice) - (advice-add 'dired-revert :before #'lsp-dired--reset) - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when (derived-mode-p 'dired-mode) - (lsp-dired--display))))) - (t - (advice-remove 'dired-kill-subdir #'lsp-dired--kill-subdir-advice) - (advice-remove 'dired-insert-subdir #'lsp-dired--insert-subdir-advice) - (advice-remove 'diredp-insert-subdirs #'lsp-dired--insert-subdir-advice) - (advice-remove 'dired-revert #'lsp-dired--reset) - (remove-hook 'dired-after-readin-hook #'lsp-dired--display) - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when (derived-mode-p 'dired-mode) - (dired-revert))))))) - - -(lsp-consistency-check lsp-dired)(provide 'lsp-dired) - - -;;; lsp-dired.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-eslint.el b/emacs/elpa/lsp-mode-20241113.743/lsp-eslint.el @@ -1,454 +0,0 @@ -;;; lsp-eslint.el --- lsp-mode eslint integration -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Ivan Yonchovski - -;; Author: Ivan Yonchovski <yyoncho@gmail.com> -;; Keywords: languages - -;; 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: - -;; - -;;; Code: - -(require 'lsp-protocol) -(require 'lsp-mode) - -(defconst lsp-eslint/status-ok 1) -(defconst lsp-eslint/status-warn 2) -(defconst lsp-eslint/status-error 3) - -(defgroup lsp-eslint nil - "ESLint language server group." - :group 'lsp-mode - :link '(url-link "https://github.com/microsoft/vscode-eslint")) - -(defcustom lsp-eslint-unzipped-path (f-join lsp-server-install-dir "eslint/unzipped") - "The path to the file in which `eslint' will be stored." - :type 'file - :group 'lsp-eslint - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-eslint-download-url "https://github.com/emacs-lsp/lsp-server-binaries/blob/master/dbaeumer.vscode-eslint-3.0.10.vsix?raw=true" - "ESLint language server download url." - :type 'string - :group 'lsp-eslint - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-eslint-server-command `("node" - "~/server/out/eslintServer.js" - "--stdio") - "Command to start ESLint server." - :risky t - :type '(repeat string) - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-eslint-enable t - "Controls whether ESLint is enabled for JavaScript files or not." - :type 'boolean - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-eslint-package-manager "npm" - "The package manager you use to install node modules." - :type '(choice (const :tag "npm" "npm") - (const :tag "yarn" "yarn") - (const :tag "pnpm" "pnpm") - (string :tag "other")) - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-eslint-format t - "Whether to perform format." - :type 'boolean - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-eslint-node-path nil - "A path added to NODE_PATH when resolving the `eslint' module." - :type '(repeat string) - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-eslint-node "node" - "Path to Node.js." - :type 'file - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-eslint-options nil - "The ESLint options object to provide args normally passed to - `eslint' when executed from a command line (see - https://eslint.org/docs/latest/integrate/nodejs-api)." - :type 'alist) - -(defcustom lsp-eslint-experimental nil - "The eslint experimental configuration." - :type 'alist) - -(defcustom lsp-eslint-config-problems nil - "The eslint problems configuration." - :type 'alist) - -(defcustom lsp-eslint-time-budget nil - "The eslint config to inform you of slow validation times and - long ESLint runs when computing code fixes during save." - :type 'alist) - -(defcustom lsp-eslint-trace-server "off" - "Traces the communication between VSCode and the ESLint linter service." - :type 'string) - -(defcustom lsp-eslint-run "onType" - "Run the linter on save (onSave) or on type (onType)" - :type '(choice (const :tag "onSave" "onSave") - (const :tag "onType" "onType")) - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-eslint-auto-fix-on-save nil - "Turns auto fix on save on or off." - :type 'boolean - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-eslint-fix-all-problem-type "all" - "Determines which problems are fixed when running the -source.fixAll code action." - :type '(choice - (const "all") - (const "problems") - string) - :package-version '(lsp-mode . "7.0.1")) - -(defcustom lsp-eslint-quiet nil - "Turns on quiet mode, which ignores warnings." - :type 'boolean - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-eslint-working-directories [] - "A vector of working directory names to use. Can be a pattern, an absolute path -or a path relative to the workspace. Examples: - - \"/home/user/abc/\" - - \"abc/\" - - (directory \"abc\") which is equivalent to \"abc\" above - - (pattern \"abc/*\") -Note that the home directory reference ~/ is not currently supported, use -/home/[user]/ instead." - :type 'lsp-string-vector - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-eslint-validate '("svelte") - "An array of language ids which should always be validated by ESLint." - :type '(repeat string) - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-eslint-provide-lint-task nil - "Controls whether a task for linting the whole workspace will be available." - :type 'boolean - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-eslint-lint-task-enable nil - "Controls whether a task for linting the whole workspace will be available." - :type 'boolean - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-eslint-lint-task-options "." - "Command line options applied when running the task for linting the whole -workspace (see https://eslint.org/docs/user-guide/command-line-interface)." - :type 'string - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-eslint-runtime nil - "The location of the node binary to run ESLint under." - :type '(repeat string) - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-eslint-code-action-disable-rule-comment t - "Controls whether code actions to add a rule-disabling comment should be shown." - :type 'bool - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-eslint-code-action-disable-rule-comment-location "separateLine" - "Controls where the disable rule code action places comments. - -Accepts the following values: -- \"separateLine\": Add the comment above the line to be disabled (default). -- \"sameLine\": Add the comment on the same line that will be disabled." - :type '(choice - (const "separateLine") - (const "sameLine")) - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-eslint-code-action-show-documentation t - "Controls whether code actions to show documentation for an ESLint rule should -be shown." - :type 'bool - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-eslint-warn-on-ignored-files nil - "Controls whether a warning should be emitted when a file is ignored." - :type 'bool - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-eslint-rules-customizations [] - "Controls severity overrides for ESLint rules. - -The value is a vector of alists, with each alist containing the following keys: -- rule - The rule to match. Can match wildcards with *, or be prefixed with ! - to negate the match. -- severity - The severity to report this rule as. Can be one of the following: - - \"off\": Disable the rule. - - \"info\": Report as informational. - - \"warn\": Report as a warning. - - \"error\": Report as an error. - - \"upgrade\": Increase by 1 severity level (eg. warning -> error). - - \"downgrade\": Decrease by 1 severity level (eg. warning -> info). - - \"default\": Report as the same severity specified in the ESLint config." - :type '(lsp-repeatable-vector - (alist :options ((rule string) - (severity (choice - (const "off") - (const "info") - (const "warn") - (const "error") - (const "upgrade") - (const "downgrade") - (const "default")))))) - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-eslint-experimental-incremental-sync t - "Controls whether the new incremental text document synchronization should -be used." - :type 'boolean - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-eslint-save-library-choices t - "Controls whether to remember choices made to permit or deny ESLint libraries -from running." - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-eslint-library-choices-file (expand-file-name (locate-user-emacs-file ".lsp-eslint-choices")) - "The file where choices to permit or deny ESLint libraries from running is -stored." - :type 'string - :package-version '(lsp-mode . "8.0.0")) - -(defun lsp--find-eslint () - (or - (when-let ((workspace-folder (lsp-find-session-folder (lsp-session) default-directory))) - (let ((eslint-local-path (f-join workspace-folder "node_modules" ".bin" - (if (eq system-type 'windows-nt) "eslint.cmd" "eslint")))) - (when (f-exists? eslint-local-path) - eslint-local-path))) - "eslint")) - -(defun lsp-eslint-create-default-configuration () - "Create default ESLint configuration." - (interactive) - (unless (lsp-session-folders (lsp-session)) - (user-error "There are no workspace folders")) - (pcase (->> (lsp-session) - lsp-session-folders - (-filter (lambda (dir) - (-none? - (lambda (file) (f-exists? (f-join dir file))) - '(".eslintrc.js" ".eslintrc.yaml" ".eslintrc.yml" ".eslintrc" ".eslintrc.json"))))) - (`nil (user-error "All workspace folders contain ESLint configuration")) - (folders (let ((default-directory (completing-read "Select project folder: " folders nil t))) - (async-shell-command (format "%s --init" (lsp--find-eslint))))))) - -(lsp-defun lsp-eslint-status-handler (workspace (&eslint:StatusParams :state)) - (setf (lsp--workspace-status-string workspace) - (propertize "ESLint" - 'face (cond - ((eq state lsp-eslint/status-error) 'error) - ((eq state lsp-eslint/status-warn) 'warn) - (t 'success))))) - -(lsp-defun lsp-eslint--configuration (_workspace (&ConfigurationParams :items)) - (->> items - (seq-map (-lambda ((&ConfigurationItem :scope-uri?)) - (-when-let* ((file (lsp--uri-to-path scope-uri?)) - (buffer (find-buffer-visiting file)) - (workspace-folder (lsp-find-session-folder (lsp-session) file))) - (with-current-buffer buffer - (let ((working-directory (lsp-eslint--working-directory workspace-folder file))) - (list :validate (if (member (lsp-buffer-language) lsp-eslint-validate) "on" "probe") - :packageManager lsp-eslint-package-manager - :codeAction (list - :disableRuleComment (list - :enable (lsp-json-bool lsp-eslint-code-action-disable-rule-comment) - :location lsp-eslint-code-action-disable-rule-comment-location) - :showDocumentation (list - :enable (lsp-json-bool lsp-eslint-code-action-show-documentation))) - :codeActionOnSave (list :enable (lsp-json-bool lsp-eslint-auto-fix-on-save) - :mode lsp-eslint-fix-all-problem-type) - :format (lsp-json-bool lsp-eslint-format) - :quiet (lsp-json-bool lsp-eslint-quiet) - :onIgnoredFiles (if lsp-eslint-warn-on-ignored-files "warn" "off") - :options (or lsp-eslint-options (ht)) - :experimental (or lsp-eslint-experimental (ht)) - :problems (or lsp-eslint-config-problems (ht)) - :timeBudget (or lsp-eslint-time-budget (ht)) - :rulesCustomizations lsp-eslint-rules-customizations - :run lsp-eslint-run - :nodePath lsp-eslint-node-path - :workingDirectory (when working-directory - (list - :directory working-directory - :!cwd :json-false)) - :workspaceFolder (list :uri (lsp--path-to-uri workspace-folder) - :name (f-filename workspace-folder)))))))) - (apply #'vector))) - -(defun lsp-eslint--working-directory (workspace current-file) - "Find the first directory in the parameter config.workingDirectories which -contains the current file" - (let ((directories (-map (lambda (dir) - (when (and (listp dir) (plist-member dir 'directory)) - (setq dir (plist-get dir 'directory))) - (if (and (listp dir) (plist-member dir 'pattern)) - (progn - (setq dir (plist-get dir 'pattern)) - (when (not (f-absolute? dir)) - (setq dir (f-join workspace dir))) - (f-glob dir)) - (if (f-absolute? dir) - dir - (f-join workspace dir)))) - (append lsp-eslint-working-directories nil)))) - (-first (lambda (dir) (f-ancestor-of-p dir current-file)) (-flatten directories)))) - -(lsp-defun lsp-eslint--open-doc (_workspace (&eslint:OpenESLintDocParams :url)) - "Open documentation." - (browse-url url)) - -(defun lsp-eslint-apply-all-fixes () - "Apply all autofixes in the current buffer." - (interactive) - (lsp-send-execute-command "eslint.applyAllFixes" (vector (lsp--versioned-text-document-identifier)))) - -;; XXX: replace with `lsp-make-interactive-code-action' macro -;; (lsp-make-interactive-code-action eslint-fix-all "source.fixAll.eslint") - -(defun lsp-eslint-fix-all () - "Perform the source.fixAll.eslint code action, if available." - (interactive) - (condition-case nil - (lsp-execute-code-action-by-kind "source.fixAll.eslint") - (lsp-no-code-actions - (when (called-interactively-p 'any) - (lsp--info "source.fixAll.eslint action not available"))))) - -(defun lsp-eslint-server-command () - (if (lsp-eslint-server-exists? lsp-eslint-server-command) - lsp-eslint-server-command - `(,lsp-eslint-node ,(f-join lsp-eslint-unzipped-path - "extension/server/out/eslintServer.js") - "--stdio"))) - -(defun lsp-eslint-server-exists? (eslint-server-command) - (let* ((command-name (f-base (f-filename (cl-first eslint-server-command)))) - (first-argument (cl-second eslint-server-command)) - (first-argument-exist (and first-argument (file-exists-p first-argument)))) - (if (equal command-name lsp-eslint-node) - first-argument-exist - (executable-find (cl-first eslint-server-command))))) - -(defvar lsp-eslint--stored-libraries (ht) - "Hash table defining if a given path to an ESLint library is allowed to run. -If the value for a key is 4, it will be allowed. If it is 1, it will not. If a -value does not exist for the key, or the value is nil, the user will be prompted -to allow or deny it.") - -(when (and (file-exists-p lsp-eslint-library-choices-file) - lsp-eslint-save-library-choices) - (setq lsp-eslint--stored-libraries (lsp--read-from-file lsp-eslint-library-choices-file))) - -(lsp-defun lsp-eslint--confirm-local (_workspace (&eslint:ConfirmExecutionParams :library-path) callback) - (if-let ((option-alist '(("Always" 4 . t) - ("Yes" 4 . nil) - ("No" 1 . nil) - ("Never" 1 . t))) - (remembered-answer (gethash library-path lsp-eslint--stored-libraries))) - (funcall callback remembered-answer) - (lsp-ask-question - (format - "Allow lsp-mode to execute %s? Note: The latest versions of the ESLint language server no longer create this prompt." - library-path) - (mapcar 'car option-alist) - (lambda (response) - (let ((option (cdr (assoc response option-alist)))) - (when (cdr option) - (puthash library-path (car option) lsp-eslint--stored-libraries) - (when lsp-eslint-save-library-choices - (lsp--persist lsp-eslint-library-choices-file lsp-eslint--stored-libraries))) - (funcall callback (car option))))))) - -(defun lsp-eslint--probe-failed (_workspace _message) - "Called when the server detects a misconfiguration in ESLint." - (lsp--error "ESLint is not configured correctly. Please ensure your eslintrc is set up for the languages you are using.")) - -(lsp-register-client - (make-lsp-client - :new-connection - (lsp-stdio-connection - (lambda () (lsp-eslint-server-command)) - (lambda () (lsp-eslint-server-exists? (lsp-eslint-server-command)))) - :activation-fn (lambda (filename &optional _) - (when lsp-eslint-enable - (or (string-match-p (rx (one-or-more anything) "." - (or "ts" "js" "jsx" "tsx" "html" "vue" "svelte")eos) - filename) - (and (derived-mode-p 'js-mode 'js2-mode 'typescript-mode 'typescript-ts-mode 'html-mode 'svelte-mode) - (not (string-match-p "\\.json\\'" filename)))))) - :priority -1 - :completion-in-comments? t - :add-on? t - :multi-root t - :notification-handlers (ht ("eslint/status" #'lsp-eslint-status-handler)) - :request-handlers (ht ("workspace/configuration" #'lsp-eslint--configuration) - ("eslint/openDoc" #'lsp-eslint--open-doc) - ("eslint/probeFailed" #'lsp-eslint--probe-failed)) - :async-request-handlers (ht ("eslint/confirmESLintExecution" #'lsp-eslint--confirm-local)) - :server-id 'eslint - :initialized-fn (lambda (workspace) - (with-lsp-workspace workspace - (lsp--server-register-capability - (lsp-make-registration - :id "random-id" - :method "workspace/didChangeWatchedFiles" - :register-options? (lsp-make-did-change-watched-files-registration-options - :watchers - `[,(lsp-make-file-system-watcher - :glob-pattern "**/.eslintr{c.js,c.yaml,c.yml,c,c.json}") - ,(lsp-make-file-system-watcher - :glob-pattern "**/.eslintignore") - ,(lsp-make-file-system-watcher - :glob-pattern "**/package.json")]))))) - :download-server-fn (lambda (_client callback error-callback _update?) - (let ((tmp-zip (make-temp-file "ext" nil ".zip"))) - (delete-file tmp-zip) - (lsp-download-install - (lambda (&rest _) - (condition-case err - (progn - (lsp-unzip tmp-zip lsp-eslint-unzipped-path) - (funcall callback)) - (error (funcall error-callback err)))) - error-callback - :url lsp-eslint-download-url - :store-path tmp-zip))))) - -(lsp-consistency-check lsp-eslint) - -(provide 'lsp-eslint) -;;; lsp-eslint.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-glsl.el b/emacs/elpa/lsp-mode-20241113.743/lsp-glsl.el @@ -1,49 +0,0 @@ -;;; lsp-glsl.el --- GLSL client -*- lexical-binding: t; -*- - -;; Copyright (C) 2023 emacs-lsp maintainers - -;; Author: Jen-Chieh Shen <jcs090218@gmail.com> -;; Keywords: languages lsp glsl - -;; 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: -;; -;; LSP client for the GLSL. -;; - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-glsl nil - "LSP support for GLSL." - :group 'lsp-mode - :link '(url-link "https://github.com/svenstaro/glsl-language-server")) - -(defcustom lsp-glsl-executable '("glslls" "--stdin") - "Command to run the GLSL language server." - :group 'lsp-glsl - :risky t - :type 'list) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection lsp-glsl-executable) - :activation-fn (lsp-activate-on "glsl") - :priority -1 - :server-id 'glslls)) - -(provide 'lsp-glsl) -;;; lsp-glsl.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-glsl.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-glsl.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-go.el b/emacs/elpa/lsp-mode-20241113.743/lsp-go.el @@ -1,446 +0,0 @@ -;;; lsp-go.el --- Go Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Muir Manders - -;; Author: Muir Manders <muir@mnd.rs> -;; Keywords: - -;; 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: - -;; lsp-go client - -;;; Code: - -(require 'lsp-mode) -(require 'lsp-completion) - -(defgroup lsp-go nil - "LSP support for the Go Programming Language, using the gopls language server." - :link '(url-link "https://github.com/golang/tools/blob/master/gopls/README.md") - :group 'lsp-mode - :package-version '(lsp-mode . "6.3.2")) - -(define-obsolete-variable-alias - 'lsp-gopls-server-path - 'lsp-go-gopls-server-path - "lsp-mode 7.0.1") - -(defcustom lsp-go-gopls-server-path "gopls" - "Path to gopls server binary." - :type 'string - :group 'lsp-go) - -(define-obsolete-variable-alias - 'lsp-gopls-server-args - 'lsp-go-gopls-server-args - "lsp-mode 7.0.1") - -(defcustom lsp-go-gopls-server-args '("-remote=auto") - "Extra CLI arguments for gopls." - :type '(repeat string) - :group 'lsp-go) - -(define-obsolete-variable-alias - 'lsp-gopls-use-placeholders - 'lsp-go-use-placeholders - "lsp-mode 7.0.1") - -(defcustom lsp-go-use-placeholders t - "Cause gopls to provide placeholder parameter snippets when -completing function calls." - :type 'boolean - :group 'lsp-go) - -(define-obsolete-variable-alias - 'lsp-gopls-build-flags - 'lsp-go-build-flags - "lsp-mode 7.0.1") - -(defcustom lsp-go-build-flags [] - "A vector of flags passed on to the build system when invoked, - applied to queries like `go list'." - :type '(lsp-repeatable-vector string) - :group 'lsp-go - :risky t - :package-version '(lsp-mode "6.2")) - -(define-obsolete-variable-alias - 'lsp-gopls-env - 'lsp-go-env - "lsp-mode 7.0.1") - -(defcustom lsp-go-env nil - "`gopls' has the unusual ability to set environment variables, - intended to affect the behavior of commands invoked by `gopls' - on the user's behalf. This variable takes a hash table of env - var names to desired values." - :type '(alist :key-type (symbol :tag "env var name") :value-type (string :tag "value")) - :group 'lsp-go - :risky t - :package-version '(lsp-mode "6.2")) - -(defcustom lsp-go-directory-filters [] - "A vector of directory filters." - :link '(url-link "https://github.com/golang/tools/blob/67e49ef2d0f326051e22a4a55bdf9344ae1a8ed8/gopls/doc/settings.md#directoryfilters-string") - :group 'lsp-go - :type 'lsp-string-vector - :package-version '(lsp-mode "8.0.0")) - -(define-obsolete-variable-alias - 'lsp-gopls-hover-kind - 'lsp-go-hover-kind - "lsp-mode 7.0.1") - -(defcustom lsp-go-hover-kind "SynopsisDocumentation" - "`gopls' allows the end user to select the desired amount of - documentation returned during e.g. hover and thing-at-point - operations." - :type '(choice (const "SynopsisDocumentation") - (const "NoDocumentation") - (const "FullDocumentation") - (const "SingleLine") - (const "Structured")) - :group 'lsp-go - :risky t - :package-version '(lsp-mode "6.2")) - -(define-obsolete-variable-alias - 'lsp-gopls-available-codelens - 'lsp-go-available-codelenses - "lsp-mode 7.0.1") - -(define-obsolete-variable-alias - 'lsp-go-available-codelens - 'lsp-go-available-codelenses - "lsp-mode 7.0.1") - -(defvar lsp-go-available-codelenses - '( - (gc_details . "Toggle the calculation of gc annotations") - (generate . "Run `go generate` for a directory") - (regenerate_cgo . "Regenerate cgo definitions") - (test . "Run `go test` for a specific set of test or benchmark functions (legacy)") - (tidy . "Run `go mod tidy` for a module") - (upgrade_dependency . "Upgrade a dependency") - (vendor . "Runs `go mod vendor' for a module")) - "Available codelenses that can be further enabled or disabled - through `lsp-go-codelenses'.") - -(defun lsp-go--defcustom-available-as-alist-type (alist) - "Return a list for the `:type' field in `defcustom' used to populate an alist. - -The input ALIST has the form `((\"name\" . \"documentation sentence\") [...])' - -The returned type provides a tri-state that either: - - does not include the element in the alist - - sets element to false (actually, :json-false) - - sets element to true \(actually, t)" - (let ((list '())) - (dolist (v alist) - (push `(cons - :tag ,(cdr v) - (const :format "" ,(car v)) - (choice (const :tag "Enable" t) (const :tag "Disable" :json-false))) - list)) - (push 'set list) - list)) - -(define-obsolete-variable-alias - 'lsp-gopls-codelens - 'lsp-go-codelenses - "lsp-mode 7.0.1") - -(define-obsolete-variable-alias - 'lsp-go-codelens - 'lsp-go-codelenses - "lsp-mode 7.0.1") - -(defcustom lsp-go-codelenses '((gc_details . :json-false) - (generate . t) - (regenerate_cgo . t) - (tidy . t) - (upgrade_dependency . t) - (test . t) - (vendor . t)) - "Select what codelenses should be enabled or not. - -The codelenses can be found at https://github.com/golang/tools/blob/3fa0e8f87c1aae0a9adc2a63af1a1945d16d9359/internal/lsp/source/options.go#L106-L112." - :type (lsp-go--defcustom-available-as-alist-type lsp-go-available-codelenses) - :group 'lsp-go - :risky t - :package-version '(lsp-mode "7.0")) - -(define-obsolete-variable-alias - 'lsp-clients-go-library-directories - 'lsp-go-library-directories - "lsp-mode 7.0.1") - -(defcustom lsp-go-library-directories ["/usr"] - "List of directories which will be considered to be libraries." - :group 'lsp-go - :risky t - :type '(lsp-repeatable-vector string)) - -(define-obsolete-variable-alias - 'lsp-clients-go-library-directories-include-go-modules - 'lsp-go-library-directories-include-go-modules - "lsp-mode 7.0.1") - -(defcustom lsp-go-library-directories-include-go-modules t - "Whether or not $GOPATH/pkg/mod should be included as a library directory." - :type 'boolean - :group 'lsp-go) - -(defun lsp-go--library-default-directories (_workspace) - "Calculate go library directories. - -If `lsp-go-library-directories-include-go-modules' is non-nil -and the environment variable GOPATH is set this function will return -$GOPATH/pkg/mod along with the value of -`lsp-go-library-directories'." - (let ((library-dirs lsp-go-library-directories)) - (when (and lsp-go-library-directories-include-go-modules - (or (and (not (file-remote-p default-directory)) (executable-find "go")) - (and (version<= "27.0" emacs-version) (with-no-warnings (executable-find "go" (file-remote-p default-directory)))))) - (with-temp-buffer - (when (zerop (process-file "go" nil t nil "env" "GOPATH")) - (setq library-dirs - (append - library-dirs - (list - (concat - (string-trim-right (buffer-substring (point-min) (point-max))) - "/pkg/mod"))))))) - (if (file-remote-p default-directory) - (mapcar (lambda (path) (concat (file-remote-p default-directory) path)) library-dirs) - library-dirs))) - -(defcustom lsp-go-link-target "pkg.go.dev" - "Which website to use for displaying Go documentation." - :type '(choice (const "pkg.go.dev") - (const "godoc.org") - (string :tag "A custom website")) - :group 'lsp-go - :package-version '(lsp-mode "7.0.1")) - -(defcustom lsp-go-links-in-hover t - "If non-nil, hover documentation includes links." - :type 'boolean - :group 'lsp-go - :package-version '(lsp-mode "8.0.0")) - -(defcustom lsp-go-use-gofumpt nil - "If non-nil, use gofumpt formatting." - :type 'boolean - :group 'lsp-go - :package-version '(lsp-mode "8.0.0")) - -(defcustom lsp-go-goimports-local "" - "Equivalent of the goimports -local flag, which puts imports beginning with - this string after third-party packages. It should be the prefix of the import - path whose imports should be grouped separately." - :type 'string - :group 'lsp-go - :package-version '(lsp-mode "8.0.0")) - -(defcustom lsp-go-analyses nil - "Specify analyses that the user would like to enable or disable. A map of the - names of analysis passes that should be enabled/disabled. A full list of - analyzers that gopls uses can be found at - https://github.com/golang/tools/blob/master/gopls/doc/analyzers.md" - :type '(alist :key-type (string :tag "analyzer name") :value-type (boolean :tag "value")) - :group 'lsp-go - :risky t - :package-version '(lsp-mode "8.0.0")) - -(defcustom lsp-go-import-shortcut "Both" - "Specifies whether import statements should link to documentation or go to - definitions." - :type '(choice (const "Both") - (const "Link") - (const "Definition")) - :group 'lsp-go - :risky t - :package-version '(lsp-mode "8.0.0")) - -(defcustom lsp-go-symbol-matcher "FastFuzzy" - "Sets the algorithm that is used when finding workspace symbols." - :type '(choice (const "Fuzzy") - (const "FastFuzzy") - (const "CaseInsensitive") - (const "CaseSensitive")) - :group 'lsp-go - :risky t - :package-version '(lsp-mode "8.0.0")) - -(defcustom lsp-go-symbol-style "Dynamic" - "Controls how symbols are qualified in symbol responses. - - `Dynamic' uses whichever qualifier results in the highest scoring match for - the given symbol query. Here a `qualifier' is any `/' or '.' delimited suffix - of the fully qualified symbol. i.e. `to/pkg.Foo.Field' or just `Foo.Field'. - - `Full' is fully qualified symbols, i.e. `path/to/pkg.Foo.Field'. - - `Package' is package qualified symbols i.e. `pkg.Foo.Field'." - :type '(choice (const "Dynamic") - (const "Full") - (const "Package")) - :group 'lsp-go - :risky t - :package-version '(lsp-mode "8.0.0")) - -(defcustom lsp-go-template-extensions [] - "The extensions of file names that are treated as template files. - -The extension is the part of the file name after the final dot." - :type '(lsp-repeatable-vector string) - :group 'lsp-go - :package-version '(lsp-mode "9.1")) - -(defcustom lsp-go-standalone-tags ["ignore"] - "Specifies a set of build constraints that identify individual Go -source files that make up the entire main package of an -executable." - :type '(lsp-repeatable-vector string) - :group 'lsp-go - :package-version '(lsp-mode "9.1")) - -(defcustom lsp-go-completion-budget "100ms" - "Soft latency goal for completion requests" - :type 'string - :group 'lsp-go - :package-version '(lsp-mode "9.1")) - -(defcustom lsp-go-matcher "Fuzzy" - "Sets the algorithm that is used when calculating completion candidates." - :type '(choice (const "CaseInsensitive") - (const "CaseSensitive") - (const "Fuzzy")) - :group 'lsp-go - :package-version '(lsp-mode "9.1")) - -(defcustom lsp-go-complete-function-calls t - "Enables function call completion. - -When completing a statement, or when a function return type -matches the expected of the expression being completed, -completion may suggest call expressions." - :type 'boolean - :group 'lsp-go - :package-version '(lsp-mode "9.1")) - -(defcustom lsp-go-diagnostics-delay "1s" - "Controls the amount of time that gopls waits after the most -recent file modification before computing deep diagnostics." - :type 'string - :group 'lsp-go - :package-version '(lsp-mode "9.1")) - -(defcustom lsp-go-analysis-progress-reporting t - "Controls whether gopls sends progress notifications when -construction of its index of analysis facts is taking a long -time." - :type 'boolean - :group 'lsp-go - :package-version '(lsp-mode "9.1")) - -(defcustom lsp-go-symbol-scope "all" - "Controls which packages are searched for workspace/symbol -requests. - -When the scope is \"workspace\", gopls searches only workspace -packages. - -When the scope is \"all\", gopls searches all loaded packages, -including dependencies and the standard library." - :type '(choice (const "all") - (const "workspace")) - :group 'lsp-go - :package-version '(lsp-mode "9.1")) - -(defcustom lsp-go-verbose-output t - "Enables additional debug logging." - :type 'boolean - :group 'lsp-go - :package-version '(lsp-mode "9.1")) - -(lsp-register-custom-settings - '(("gopls.analyses" lsp-go-analyses) - ("gopls.analysisProgressReporting" lsp-go-analysis-progress-reporting t) - ("gopls.buildFlags" lsp-go-build-flags) - ("gopls.codelenses" lsp-go-codelenses) - ("gopls.completeFunctionCalls" lsp-go-complete-function-calls t) - ("gopls.completionBudget" lsp-go-completion-budget) - ("gopls.diagnosticsDelay" lsp-go-diagnostics-delay) - ("gopls.directoryFilters" lsp-go-directory-filters) - ("gopls.env" lsp-go-env) - ("gopls.gofumpt" lsp-go-use-gofumpt t) - ("gopls.hoverKind" lsp-go-hover-kind) - ("gopls.importShortcut" lsp-go-import-shortcut) - ("gopls.linkTarget" lsp-go-link-target) - ("gopls.linksInHover" lsp-go-links-in-hover t) - ("gopls.local" lsp-go-goimports-local) - ("gopls.matcher" lsp-go-matcher) - ("gopls.standaloneTags" lsp-go-standalone-tags) - ("gopls.symbolMatcher" lsp-go-symbol-matcher) - ("gopls.symbolScope" lsp-go-symbol-scope) - ("gopls.symbolStyle" lsp-go-symbol-style) - ("gopls.templateExtensions" lsp-go-template-extensions) - ("gopls.usePlaceholders" lsp-go-use-placeholders t) - ("gopls.verboseOutput" lsp-go-verbose-output t))) - -(defcustom lsp-go-server-wrapper-function - #'identity - "Function to wrap the language server process started by lsp-go. - -For example, you can pick a go binary provided by a repository's -flake.nix file with: - - (use-package nix-sandbox) - (defun my/nix--lsp-go-wrapper (args) - (if-let ((sandbox (nix-current-sandbox))) - (apply `nix-shell-command sandbox args) - args)) - (setq lsp-go-server-path \"gopls\" - lsp-go-server-wrapper-function `my/nix--lsp-go-wrapper)" - :group 'lsp-go - :type '(choice - (function-item :tag "None" :value identity) - (function :tag "Custom function"))) - -(defun lsp-go--server-command () - "Command and arguments for launching the inferior language server process. -These are assembled from the customizable variables `lsp-go-server-path' -and `lsp-go-server-wrapper-function'." - (funcall lsp-go-server-wrapper-function (append (list lsp-go-gopls-server-path) lsp-go-gopls-server-args))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection 'lsp-go--server-command) - :activation-fn (lsp-activate-on "go" "go.mod") - :language-id "go" - :priority 0 - :server-id 'gopls - :completion-in-comments? t - :library-folders-fn #'lsp-go--library-default-directories - :after-open-fn (lambda () - ;; https://github.com/golang/tools/commit/b2d8b0336 - (setq-local lsp-completion-filter-on-incomplete nil)))) - -(lsp-consistency-check lsp-go) - -(provide 'lsp-go) -;;; lsp-go.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-go.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-go.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-headerline.el b/emacs/elpa/lsp-mode-20241113.743/lsp-headerline.el @@ -1,494 +0,0 @@ -;;; lsp-headerline.el --- LSP headerline features -*- lexical-binding: t; -*- -;; -;; Copyright (C) 2020 emacs-lsp maintainers -;; -;; 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: -;; -;; LSP headerline features -;; -;;; Code: - -(require 'lsp-icons) -(require 'lsp-mode) - -(defgroup lsp-headerline nil - "LSP support for headerline" - :prefix "lsp-headerline-" - :group 'lsp-mode - :tag "LSP Headerline") - -(defcustom lsp-headerline-breadcrumb-segments '(path-up-to-project file symbols) - "Segments used in breadcrumb text on headerline." - :type '(repeat - (choice (const :tag "Include the project name." project) - (const :tag "Include the open file name." file) - (const :tag "Include the directories up to project." path-up-to-project) - (const :tag "Include document symbols if server supports it." symbols))) - :group 'lsp-headerline) - -(defcustom lsp-headerline-breadcrumb-enable-symbol-numbers nil - "Whether to label symbols with numbers on the breadcrumb." - :type 'boolean - :group 'lsp-headerline) - -(defcustom lsp-headerline-breadcrumb-enable-diagnostics t - "If non-nil, apply different face on the breadcrumb based on the errors." - :type 'boolean - :group 'lsp-headerline - :package-version '(lsp-mode . "8.0.0")) - -(defface lsp-headerline-breadcrumb-separator-face '((t :inherit shadow :height 0.8)) - "Face used for breadcrumb separator on headerline." - :group 'lsp-headerline) - -(defface lsp-headerline-breadcrumb-path-face '((t :inherit font-lock-string-face)) - "Face used for breadcrumb paths on headerline." - :group 'lsp-headerline) - -(defface lsp-headerline-breadcrumb-path-error-face - '((t :underline (:style wave :color "Red1") - :inherit lsp-headerline-breadcrumb-path-face)) - "Face used for breadcrumb paths on headerline when there is an error under -that path" - :group 'lsp-headerline) - -(defface lsp-headerline-breadcrumb-path-warning-face - '((t :underline (:style wave :color "Yellow") - :inherit lsp-headerline-breadcrumb-path-face)) - "Face used for breadcrumb paths on headerline when there is an warning under -that path" - :group 'lsp-headerline) - -(defface lsp-headerline-breadcrumb-path-info-face - '((t :underline (:style wave :color "Green") - :inherit lsp-headerline-breadcrumb-path-face)) - "Face used for breadcrumb paths on headerline when there is an info under -that path" - :group 'lsp-headerline) - -(defface lsp-headerline-breadcrumb-path-hint-face - '((t :underline (:style wave :color "Green") - :inherit lsp-headerline-breadcrumb-path-face)) - "Face used for breadcrumb paths on headerline when there is an hint under that -path" - :group 'lsp-headerline) - -(defface lsp-headerline-breadcrumb-project-prefix-face - '((t :inherit font-lock-string-face :weight bold)) - "Face used for breadcrumb prefix on headerline. -Only if `lsp-headerline-breadcrumb-prefix` is `project-name-only`." - :group 'lsp-headerline) - -(defface lsp-headerline-breadcrumb-unknown-project-prefix-face - '((t :inherit shadow :weight bold)) - "Face used for breadcrumb prefix on headerline. -Only if `lsp-headerline-breadcrumb-prefix` is `project-name-only`." - :group 'lsp-headerline) - -(defface lsp-headerline-breadcrumb-symbols-face - '((t :inherit font-lock-doc-face :weight bold)) - "Face used for breadcrumb symbols text on headerline." - :group 'lsp-headerline) - -(defface lsp-headerline-breadcrumb-symbols-error-face - '((t :inherit lsp-headerline-breadcrumb-symbols-face - :underline (:style wave :color "Red1"))) - "Face used for breadcrumb symbols text on headerline when there -is an error in symbols range." - :group 'lsp-headerline) - -(defface lsp-headerline-breadcrumb-symbols-warning-face - '((t :inherit lsp-headerline-breadcrumb-symbols-face - :underline (:style wave :color "Yellow"))) - "Face used for breadcrumb symbols text on headerline when there -is an warning in symbols range." - :group 'lsp-headerline) - -(defface lsp-headerline-breadcrumb-symbols-info-face - '((t :inherit lsp-headerline-breadcrumb-symbols-face - :underline (:style wave :color "Green"))) - "Face used for breadcrumb symbols text on headerline when there -is an info in symbols range." - :group 'lsp-headerline) - -(defface lsp-headerline-breadcrumb-symbols-hint-face - '((t :inherit lsp-headerline-breadcrumb-symbols-face - :underline (:style wave :color "Green"))) - "Face used for breadcrumb symbols text on headerline when there -is an hints in symbols range." - :group 'lsp-headerline) - -(defface lsp-headerline-breadcrumb-deprecated-face - '((t :inherit lsp-headerline-breadcrumb-symbols-face - :strike-through t)) - "Face used on breadcrumb deprecated text on modeline." - :group 'lsp-headerline) - -(defvar lsp-headerline-arrow nil - "Holds the current breadcrumb string on headerline.") - -(defvar-local lsp-headerline--path-up-to-project-segments nil - "Holds the current breadcrumb path-up-to-project segments for -caching purposes.") - -(defvar-local lsp-headerline--cached-workspace-root nil - "Holds the current value of lsp-workspace-root for caching purposes") - -;; Redefine local vars of `all-the-icons' to avoid bytecode compilation errors. -(defvar all-the-icons-default-adjust) -(defvar all-the-icons-scale-factor) - -(defun lsp-headerline--arrow-icon () - "Build the arrow icon for headerline breadcrumb." - (or - lsp-headerline-arrow - (setq lsp-headerline-arrow (let ((all-the-icons-scale-factor 1.0) - (all-the-icons-default-adjust 0)) - (lsp-icons-all-the-icons-icon - 'material - "chevron_right" - 'lsp-headerline-breadcrumb-separator-face - ">" - 'headerline-breadcrumb))))) - -(lsp-defun lsp-headerline--symbol-icon ((&DocumentSymbol :kind)) - "Build the SYMBOL icon for headerline breadcrumb." - (concat (lsp-icons-get-by-symbol-kind kind 'headerline-breadcrumb) - " ")) - -(lsp-defun lsp-headerline--go-to-symbol ((&DocumentSymbol - :selection-range (&RangeToPoint :start selection-start) - :range (&RangeToPoint :start narrowing-start - :end narrowing-end))) - "Go to breadcrumb symbol. -If the buffer is narrowed and the target symbol lies before the -minimum reachable point in the narrowed buffer, then widen and -narrow to the outer symbol." - (when (buffer-narrowed-p) - (narrow-to-region - (min (point-min) narrowing-start) - (max (point-max) narrowing-end))) - (goto-char selection-start)) - -(lsp-defun lsp-headerline--narrow-to-symbol ((&DocumentSymbol :range (&RangeToPoint :start :end))) - "Narrow to breadcrumb symbol range." - (narrow-to-region start end)) - -(defun lsp-headerline--with-action (local-map help-echo-string display-string) - "Assign LOCAL-MAP and HELP-ECHO-STRING to the region around the -DISPLAY-STRING." - (propertize display-string - 'mouse-face 'header-line-highlight - 'help-echo help-echo-string - 'local-map local-map)) - -(defmacro lsp-headerline--make-mouse-handler (&rest body) - "Making mouse event handler. -Switch to current mouse interacting window before doing BODY." - (declare (debug t) (indent 0)) - `(lambda (event) - (interactive "e") - (select-window (posn-window (elt event 1))) - ,@body)) - -(defun lsp-headerline--directory-with-action (full-path directory-display-string) - "Build action for FULL-PATH and DIRECTORY-DISPLAY-STRING." - (lsp-headerline--with-action (let ((map (make-sparse-keymap))) - (define-key map [header-line mouse-1] - (lsp-headerline--make-mouse-handler - (dired full-path))) - (define-key map [header-line mouse-2] - (lsp-headerline--make-mouse-handler - (dired-other-window full-path))) - map) - (format "mouse-1: browse '%s' with Dired\nmouse-2: browse '%s' with Dired in other window" - directory-display-string - directory-display-string) - (propertize directory-display-string - 'lsp-full-path full-path))) - -(declare-function evil-set-jump "ext:evil-jumps") - -(lsp-defun lsp-headerline--symbol-with-action ((symbol &as &DocumentSymbol :name) symbol-display-string) - "Build action for SYMBOL and SYMBOL-STRING." - (lsp-headerline--with-action (let ((map (make-sparse-keymap))) - (define-key map [header-line mouse-1] - (lsp-headerline--make-mouse-handler - (when (bound-and-true-p evil-mode) - (evil-set-jump)) - (lsp-headerline--go-to-symbol symbol))) - (define-key map [header-line mouse-2] - (lsp-headerline--make-mouse-handler - (-let (((&DocumentSymbol :range (&RangeToPoint :start :end)) symbol)) - (if (and (eq (point-min) start) (eq (point-max) end)) - (widen) - (lsp-headerline--narrow-to-symbol symbol))))) - map) - (format "mouse-1: go to '%s' symbol\nmouse-2: %s" - name - (-let (((&DocumentSymbol :range (&RangeToPoint :start :end)) symbol)) - (if (and (eq (point-min) start) (eq (point-max) end)) - "widen" - (format "narrow to '%s' range" name)))) - symbol-display-string)) - -(defun lsp-headerline--path-up-to-project-root (root-path path) - "Find recursively the folders until the project ROOT-PATH. -PATH is the current folder to be checked." - (let ((current-path path) - headerline-path-components) - (while (not (lsp-f-same? root-path current-path)) - (push (lsp-headerline--directory-with-action current-path - (f-filename current-path)) - headerline-path-components) - (setq current-path (lsp-f-parent current-path))) - headerline-path-components)) - -(defun lsp-headerline--build-project-string () - "Build the project-segment string for the breadcrumb." - (-if-let (root (lsp-headerline--workspace-root)) - (propertize (lsp-headerline--directory-with-action - root - (f-filename root)) - 'font-lock-face - 'lsp-headerline-breadcrumb-project-prefix-face) - (propertize "<unknown>" - 'font-lock-face - 'lsp-headerline-breadcrumb-unknown-project-prefix-face))) - -(defun lsp-headerline--build-file-string () - "Build the file-segment string for the breadcrumb." - (let* ((file-path (or (buffer-file-name) "")) - (filename (f-filename file-path))) - (if-let ((file-ext (f-ext file-path))) - (concat (lsp-icons-get-by-file-ext file-ext 'headerline-breadcrumb) - " " - (propertize filename - 'font-lock-face - (lsp-headerline--face-for-path file-path))) - filename))) - - -(defun lsp-headerline--face-for-path (dir) - "Calculate the face for DIR." - (if-let ((diags (lsp-diagnostics-stats-for (directory-file-name dir)))) - (cl-labels ((check-severity - (severity) - (not (zerop (aref diags severity))))) - (cond - ((not lsp-headerline-breadcrumb-enable-diagnostics) - 'lsp-headerline-breadcrumb-path-face) - ((check-severity lsp/diagnostic-severity-error) - 'lsp-headerline-breadcrumb-path-error-face) - ((check-severity lsp/diagnostic-severity-warning) - 'lsp-headerline-breadcrumb-path-warning-face) - ((check-severity lsp/diagnostic-severity-information) - 'lsp-headerline-breadcrumb-path-info-face) - ((check-severity lsp/diagnostic-severity-hint) - 'lsp-headerline-breadcrumb-path-hint-face) - (t 'lsp-headerline-breadcrumb-path-face))) - 'lsp-headerline-breadcrumb-path-face)) - -(defun lsp-headerline--severity-level-for-range (range) - "Get the severity level for RANGE." - (let ((range-severity 10)) - (mapc (-lambda ((&Diagnostic :range (&Range :start) :severity?)) - (when (lsp-point-in-range? start range) - (setq range-severity (min range-severity severity?)))) - (lsp--get-buffer-diagnostics)) - range-severity)) - -(defun lsp-headerline--build-path-up-to-project-string () - "Build the path-up-to-project segment for the breadcrumb." - (if-let ((root (lsp-headerline--workspace-root))) - (let ((segments (or - lsp-headerline--path-up-to-project-segments - (setq lsp-headerline--path-up-to-project-segments - (lsp-headerline--path-up-to-project-root - root - (lsp-f-parent (buffer-file-name))))))) - (mapconcat (lambda (next-dir) - (propertize next-dir - 'font-lock-face - (lsp-headerline--face-for-path - (get-text-property - 0 'lsp-full-path next-dir)))) - segments - (concat " " (lsp-headerline--arrow-icon) " "))) - "")) - -(lsp-defun lsp-headerline--face-for-symbol ((&DocumentSymbol :deprecated? - :range)) - "Get the face for SYMBOL." - (let ((range-severity (lsp-headerline--severity-level-for-range range))) - (cond - (deprecated? 'lsp-headerline-breadcrumb-deprecated-face) - ((not lsp-headerline-breadcrumb-enable-diagnostics) - 'lsp-headerline-breadcrumb-symbols-face) - ((= range-severity lsp/diagnostic-severity-error) - 'lsp-headerline-breadcrumb-symbols-error-face) - ((= range-severity lsp/diagnostic-severity-warning) - 'lsp-headerline-breadcrumb-symbols-warning-face) - ((= range-severity lsp/diagnostic-severity-information) - 'lsp-headerline-breadcrumb-symbols-info-face) - ((= range-severity lsp/diagnostic-severity-hint) - 'lsp-headerline-breadcrumb-symbols-hint-face) - (t 'lsp-headerline-breadcrumb-symbols-face)))) - -(defun lsp-headerline--build-symbol-string () - "Build the symbol segment for the breadcrumb." - (if (lsp-feature? "textDocument/documentSymbol") - (-if-let* ((lsp--document-symbols-request-async t) - (symbols (lsp--get-document-symbols)) - (symbols-hierarchy (lsp--symbols->document-symbols-hierarchy symbols)) - (enumerated-symbols-hierarchy - (-map-indexed (lambda (index elt) - (cons elt (1+ index))) - symbols-hierarchy))) - (mapconcat - (-lambda (((symbol &as &DocumentSymbol :name) - . index)) - (let* ((symbol2-name - (propertize name - 'font-lock-face - (lsp-headerline--face-for-symbol symbol))) - (symbol2-icon (lsp-headerline--symbol-icon symbol)) - (full-symbol-2 - (concat - (if lsp-headerline-breadcrumb-enable-symbol-numbers - (concat - (propertize (number-to-string index) - 'face - 'lsp-headerline-breadcrumb-symbols-face) - " ") - "") - (if symbol2-icon - (concat symbol2-icon symbol2-name) - symbol2-name)))) - (lsp-headerline--symbol-with-action symbol full-symbol-2))) - enumerated-symbols-hierarchy - (concat " " (lsp-headerline--arrow-icon) " ")) - "") - "")) - -(defun lsp-headerline--build-string () - "Build the header-line string." - (string-trim-right - (mapconcat - (lambda (segment) - (let ((segment-string - (pcase segment - ('project (lsp-headerline--build-project-string)) - ('file (lsp-headerline--build-file-string)) - ('path-up-to-project (lsp-headerline--build-path-up-to-project-string)) - ('symbols (lsp-headerline--build-symbol-string)) - (_ (lsp-log "'%s' is not a valid entry for `lsp-headerline-breadcrumb-segments'" - (symbol-name segment)) - "")))) - (if (string-empty-p segment-string) - "" - (concat (lsp-headerline--arrow-icon) - " " - segment-string - " ")))) - lsp-headerline-breadcrumb-segments - ""))) - -(defun lsp-headerline--check-breadcrumb (&rest _) - "Request for document symbols to build the breadcrumb." - (set-window-parameter (selected-window) 'lsp-headerline--string (lsp-headerline--build-string)) - (force-mode-line-update)) - -(defun lsp-headerline--enable-breadcrumb () - "Enable headerline breadcrumb mode." - (when (and lsp-headerline-breadcrumb-enable - (lsp-feature? "textDocument/documentSymbol")) - (lsp-headerline-breadcrumb-mode 1))) - -(defun lsp-headerline--disable-breadcrumb () - "Disable headerline breadcrumb mode." - (lsp-headerline-breadcrumb-mode -1)) - -(defun lsp-headerline--workspace-root () - (or lsp-headerline--cached-workspace-root - (setq lsp-headerline--cached-workspace-root (lsp-workspace-root)))) - -;;;###autoload -(define-minor-mode lsp-headerline-breadcrumb-mode - "Toggle breadcrumb on headerline." - :group 'lsp-headerline - :global nil - (cond - (lsp-headerline-breadcrumb-mode - ;; make sure header-line-format, if non-nil, is a list. as - ;; mode-line-format says: "The value may be nil, a string, a - ;; symbol or a list." - (unless (listp header-line-format) - (setq header-line-format (list header-line-format))) - (add-to-list 'header-line-format '(t (:eval (window-parameter nil 'lsp-headerline--string) ))) - - (add-hook 'xref-after-jump-hook #'lsp-headerline--check-breadcrumb nil t) - - (add-hook 'lsp-on-idle-hook #'lsp-headerline--check-breadcrumb nil t) - (add-hook 'lsp-configure-hook #'lsp-headerline--enable-breadcrumb nil t) - (add-hook 'lsp-unconfigure-hook #'lsp-headerline--disable-breadcrumb nil t)) - (t - (remove-hook 'lsp-on-idle-hook #'lsp-headerline--check-breadcrumb t) - (remove-hook 'lsp-configure-hook #'lsp-headerline--enable-breadcrumb t) - (remove-hook 'lsp-unconfigure-hook #'lsp-headerline--disable-breadcrumb t) - - (remove-hook 'xref-after-jump-hook #'lsp-headerline--check-breadcrumb t) - - (setq lsp-headerline--path-up-to-project-segments nil) - (setq header-line-format (remove '(t (:eval (window-parameter nil 'lsp-headerline--string) )) header-line-format))))) - -;;;###autoload -(defun lsp-breadcrumb-go-to-symbol (symbol-position) - "Go to the symbol on breadcrumb at SYMBOL-POSITION." - (interactive "P") - (if (numberp symbol-position) - (if (lsp-feature? "textDocument/documentSymbol") - (-if-let* ((lsp--document-symbols-request-async t) - (symbols (lsp--get-document-symbols)) - (symbols-hierarchy (lsp--symbols->document-symbols-hierarchy symbols))) - (lsp-headerline--go-to-symbol (nth (1- symbol-position) symbols-hierarchy)) - (lsp--info "Symbol not found for position %s" symbol-position)) - (lsp--info "Server does not support breadcrumb.")) - (lsp--info "Call this function with a number representing the symbol position on breadcrumb"))) - -(declare-function evil-set-command-property "ext:evil-common") - -(with-eval-after-load 'evil - (evil-set-command-property 'lsp-breadcrumb-go-to-symbol :jump t)) - -;;;###autoload -(defun lsp-breadcrumb-narrow-to-symbol (symbol-position) - "Narrow to the symbol range on breadcrumb at SYMBOL-POSITION." - (interactive "P") - (if (numberp symbol-position) - (if (lsp-feature? "textDocument/documentSymbol") - (-if-let* ((lsp--document-symbols-request-async t) - (symbols (lsp--get-document-symbols)) - (symbols-hierarchy (lsp--symbols->document-symbols-hierarchy symbols))) - (lsp-headerline--narrow-to-symbol (nth (1- symbol-position) symbols-hierarchy)) - (lsp--info "Symbol not found for position %s" symbol-position)) - (lsp--info "Server does not support breadcrumb.")) - (lsp--info "Call this function with a number representing the symbol position on breadcrumb"))) - -(lsp-consistency-check lsp-headerline) - -(provide 'lsp-headerline) -;;; lsp-headerline.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-javascript.el b/emacs/elpa/lsp-mode-20241113.743/lsp-javascript.el @@ -1,1054 +0,0 @@ -;;; lsp-javascript.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, - -;; 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: - -;; LSP Clients for the JavaScript and TypeScript Programming Languages. - -;;; Code: - -(require 'lsp-mode) - -(lsp-dependency 'javascript-typescript-langserver - '(:system "javascript-typescript-stdio") - '(:npm :package "javascript-typescript-langserver" - :path "javascript-typescript-stdio")) - -(defgroup lsp-typescript-javascript nil - "Support for TypeScript/JavaScript, using Sourcegraph's JavaScript/TypeScript language server." - :group 'lsp-mode - :link '(url-link "https://github.com/sourcegraph/javascript-typescript-langserver")) - -;; Original name can be confused with initializationOptions. Preferences is just one option of initializationOptions. -(define-obsolete-variable-alias - 'lsp-clients-typescript-init-opts - 'lsp-clients-typescript-preferences - "lsp-mode 9.0.0") - -(defcustom lsp-clients-typescript-javascript-server-args '() - "Extra arguments for the typescript-language-server language server." - :group 'lsp-typescript-javascript - :risky t - :type '(repeat string)) - -(defun lsp-typescript-javascript-tsx-jsx-activate-p (filename &optional _) - "Check if the js-ts lsp server should be enabled based on FILENAME." - (or (string-match-p "\\.[cm]js\\|\\.[jt]sx?\\'" filename) - (and (derived-mode-p 'js-mode 'js-ts-mode 'typescript-mode 'typescript-ts-mode) - (not (derived-mode-p 'json-mode))))) - -;; Unmaintained sourcegraph server -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection (lambda () - (cons (lsp-package-path 'javascript-typescript-langserver) - lsp-clients-typescript-javascript-server-args))) - :activation-fn 'lsp-typescript-javascript-tsx-jsx-activate-p - :priority -3 - :completion-in-comments? t - :server-id 'jsts-ls - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure - 'javascript-typescript-langserver - callback - error-callback)) - :initialized-fn (lambda (_workspace) - (warn (concat "The javascript-typescript-langserver (jsts-ls) is unmaintained; " - "it is recommended to use ts-ls or deno-ls instead."))))) - -(defgroup lsp-typescript nil - "LSP support for TypeScript, using Theia/Typefox's TypeScript Language Server." - :group 'lsp-mode - :link '(url-link "https://github.com/theia-ide/typescript-language-server")) - -(defcustom lsp-clients-typescript-tls-path "typescript-language-server" - "Path to the typescript-language-server binary." - :group 'lsp-typescript - :risky t - :type 'string) - -(defcustom lsp-clients-typescript-server-args '("--stdio") - "Extra arguments for the typescript-language-server language server." - :group 'lsp-typescript - :risky t - :type '(repeat string)) - -(defcustom lsp-clients-typescript-disable-automatic-typing-acquisition nil - "Disable tsserver from automatically fetching missing type definitions. -\(@types packages) for external modules." - :group 'lsp-typescript - :type 'boolean) - -(defcustom lsp-clients-typescript-log-verbosity "info" - "The verbosity level of the information printed in the log by tsserver." - :group 'lsp-typescript - :type '(choice - (const "off") - (const "terse") - (const "normal") - (const "requesttime") - (const "verbose"))) - -(defcustom lsp-clients-typescript-max-ts-server-memory nil - "The maximum size of the V8's old memory section in megabytes. -\(for example 4096 means 4GB). The default value is dynamically configured -by Node so can differ per system. Increase for very big projects that -exceed allowed memory usage." - :group 'lsp-typescript - :type 'integer) - -(defcustom lsp-clients-typescript-npm-location nil - "Specifies the path to the NPM exec used for Automatic Type Acquisition." - :group 'lsp-typescript - :type 'string) - -(defcustom lsp-clients-typescript-prefer-use-project-ts-server nil - "When set, prefers using the tsserver.js from your project. This -can allow loading plugins configured in your tsconfig.json." - :group 'lsp-typescript - :type 'boolean) - -(defcustom lsp-clients-typescript-plugins (vector) - "The list of plugins to load. -It should be a vector of plist with keys `:location' and `:name' -where `:name' is the name of the package and `:location' is the -directory containing the package. Example: -\(vector - \(list :name \"@vsintellicode/typescript-intellicode-plugin\" - :location \"<path>.vscode/extensions/visualstudioexptteam. - vscodeintellicode-1.1.9/\"))" - :group 'lsp-typescript - :type '(restricted-sexp :tag "Vector" - :match-alternatives - (lambda (xs) - (and (vectorp xs) (seq-every-p - (-lambda ((&plist :name :location)) - (and name location)) - xs))))) - -(defcustom lsp-clients-typescript-preferences nil - "Preferences passed to the Typescript (tsserver) process. -See https://github.com/typescript-language-server/typescript-language-server#initializationoptions for the list of preferences available in the latest version of TypeScript." - :group 'lsp-typescript - :type 'plist) - -(defcustom lsp-clients-typescript-tsserver nil - "Options related to the tsserver process. See below for more info. -See https://github.com/typescript-language-server/typescript-language-server#initializationoptions for the list of tsserver available in the latest version of TypeScript." - :group 'lsp-typescript - :type 'plist) - -(defcustom lsp-typescript-tsdk nil - "Specifies the folder path containing tsserver and lib*.d.ts files to use." - :type '(repeat string) - :group 'lsp-vetur - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-disable-automatic-type-acquisition nil - "Disables automatic type acquisition. -Automatic type acquisition fetches `@types` packages from npm to improve -IntelliSense for external libraries." - :type 'boolean - :group 'lsp-vetur - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-npm nil - "Specifies the path to the NPM exec used for Automatic Type Acquisition. -Requires using TypeScript 2.3.4 or newer in the -workspace." - :type '(repeat string) - :group 'lsp-vetur - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-check-npm-is-installed t - "Check if NPM is installed for Automatic Type Acquisition." - :type 'boolean - :group 'lsp-vetur - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-references-code-lens-enabled nil - "Enable/disable references CodeLens in JavaScript files." - :type 'boolean - :group 'lsp-vetur - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-references-code-lens-enabled nil - "Enable/disable references CodeLens in TypeScript files." - :type 'boolean - :group 'lsp-vetur - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-implementations-code-lens-enabled nil - "Enable/disable implementations CodeLens. -This CodeLens shows the implementers of an interface." - :type 'boolean - :group 'lsp-vetur - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-tsserver-log "off" - "Enables logging of the TS server to a file. -This log can be used to diagnose TS Server issues. The log may contain file -paths, source code, and other potentially sensitive information -from your project." - :type '(choice - (const "off") - (const "terse") - (const "normal") - (const "verbose")) - :group 'lsp-vetur - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-tsserver-plugin-paths nil - "Additional paths to discover Typescript Language Service plugins. -Requires using TypeScript 2.3.0 or newer in the -workspace." - :type '(repeat string) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-tsserver-trace "off" - "Enables tracing of messages sent to the TS server. -This trace can be used to diagnose TS Server issues. The trace may contain -file paths, source code, and other potentially sensitive -information from your project." - :type '(choice - (const "off") - (const "messages") - (const "verbose")) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-suggest-complete-function-calls nil - "Complete functions with their parameter signature." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-suggest-complete-function-calls nil - "Complete functions with their parameter signature." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-report-style-checks-as-warnings t - "Report style checks as warnings." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-validate-enable t - "Enable/disable TypeScript validation." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-format-enable t - "Enable/disable default TypeScript formatter." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-format-insert-space-after-comma-delimiter t - "Defines space handling after a comma delimiter." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-format-insert-space-after-constructor nil - "Defines space handling after the constructor keyword. -Requires using TypeScript 2.3.0 or newer in the workspace." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-format-insert-space-after-semicolon-in-for-statements t - "Defines space handling after a semicolon in a for statement." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-format-insert-space-before-and-after-binary-operators t - "Defines space handling after a binary operator." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-format-insert-space-after-keywords-in-control-flow-statements t - "Defines space handling after keywords in a control flow statement." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-format-insert-space-after-function-keyword-for-anonymous-functions t - "Defines space handling after function keyword for anonymous functions." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-format-insert-space-before-function-parenthesis nil - "Defines space handling before function argument parentheses." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-format-insert-space-after-opening-and-before-closing-empty-braces nil - "Defines space handling after opening/before closing empty braces." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-format-insert-space-after-opening-and-before-closing-nonempty-parenthesis nil - "Defines space handling after opening/before closing non-empty parenthesis." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-format-insert-space-after-opening-and-before-closing-nonempty-brackets nil - "Defines space handling after opening and before closing non-empty brackets." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-format-insert-space-after-opening-and-before-closing-nonempty-braces t - "Defines space handling after opening and before closing non-empty braces. -Requires using TypeScript 2.3.0 or newer in the workspace." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-format-insert-space-after-opening-and-before-closing-template-string-braces nil - "Defines space handling after opening/before closing template string braces." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-format-insert-space-after-opening-and-before-closing-jsx-expression-braces nil - "Defines space handling after opening/before closing JSX expression braces." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-format-insert-space-after-type-assertion nil - "Defines space handling after type assertions in TypeScript. -Requires using TypeScript 2.4 or newer in the workspace." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-format-place-open-brace-on-new-line-for-functions nil - "Defines whether an open brace is put onto a new line for functions or not." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-format-place-open-brace-on-new-line-for-control-blocks nil - "Defines whether an open brace is put onto a newline for control blocks." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-validate-enable t - "Enable/disable JavaScript validation." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-format-enable t - "Enable/disable default JavaScript formatter." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-format-insert-space-after-comma-delimiter t - "Defines space handling after a comma delimiter." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-format-insert-space-after-constructor nil - "Defines space handling after the constructor keyword. -Requires using TypeScript 2.3.0 or newer in the workspace." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-format-insert-space-after-semicolon-in-for-statements t - "Defines space handling after a semicolon in a for statement." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-format-insert-space-before-and-after-binary-operators t - "Defines space handling after a binary operator." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-format-insert-space-after-keywords-in-control-flow-statements t - "Defines space handling after keywords in a control flow statement." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-format-insert-space-after-function-keyword-for-anonymous-functions t - "Defines space handling after function keyword for anonymous functions." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-format-insert-space-before-function-parenthesis nil - "Defines space handling before function argument parentheses." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-format-insert-space-after-opening-and-before-closing-empty-braces nil - "Defines space handling after opening/before closing empty braces." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-format-insert-space-after-opening-and-before-closing-nonempty-parenthesis nil - "Defines space handling after opening and before closing non-empty parenthesis." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-format-insert-space-after-opening-and-before-closing-nonempty-brackets nil - "Defines space handling after opening and before closing non-empty brackets." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-format-insert-space-after-opening-and-before-closing-nonempty-braces t - "Defines space handling after opening and before closing non-empty braces. -Requires using TypeScript 2.3.0 or newer in the workspace." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-format-insert-space-after-opening-and-before-closing-template-string-braces nil - "Defines space handling after opening/before closing template string braces." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-format-insert-space-after-opening-and-before-closing-jsx-expression-braces nil - "Defines space handling after opening/before closing JSX expression braces." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-format-place-open-brace-on-new-line-for-functions nil - "Defines whether an open brace is put onto a new line for functions or not." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-format-place-open-brace-on-new-line-for-control-blocks nil - "Defines whether an open brace is put onto a new line for control blocks or not." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-implicit-project-config-check-js nil - "Enable/disable semantic checking of JavaScript files. -Existing jsconfig.json or tsconfig.json files override this setting. -Requires using TypeScript 2.3.1 or newer in the workspace." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-implicit-project-config-experimental-decorators nil - nil - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-suggest-names t - "Enable/disable including unique names from the file in JavaScript suggestions." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-tsc-auto-detect "on" - "Controls auto detection of tsc tasks." - :type '(choice - (const "on") - (const "off") - (const "build") - (const "watch")) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-suggest-paths t - "Enable/disable suggestions for paths in import statements and require calls." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-suggest-paths t - "Enable/disable suggestions for paths in import statements and require calls." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-suggest-auto-imports t - "Enable/disable auto import suggestions. -Requires using TypeScript 2.6.1 or newer in the workspace." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-suggest-auto-imports t - "Enable/disable auto import suggestions. Requires using -TypeScript 2.6.1 or newer in the workspace." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-suggest-complete-js-docs t - "Enable/disable suggestion to complete JSDoc comments." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-suggest-complete-js-docs t - "Enable/disable suggestion to complete JSDoc comments." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-locale nil - nil - :type '(choice - (const "de") - (const "es") - (const "en") - (const "fr") - (const "it") - (const "ja") - (const "ko") - (const "ru") - (const "zh-CN") - (const "zh-TW") - (const :tag "default" nil)) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-suggestion-actions-enabled t - "Enable/disable suggestion diagnostics for JavaScript files in -the editor. Requires using TypeScript 2.8 or newer in the -workspace." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-suggestion-actions-enabled t - "Enable/disable suggestion diagnostics for TypeScript files in -the editor. Requires using TypeScript 2.8 or newer in the -workspace." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-preferences-quote-style "auto" nil - :type '(choice - (const "auto") - (const "single") - (const "double")) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-preferences-quote-style "auto" nil - :type '(choice - (const "auto") - (const "single") - (const "double")) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-preferences-import-module-specifier "auto" - "Preferred path style for auto imports." - :type '(choice - (const "auto") - (const "relative") - (const "non-relative")) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-preferences-import-module-specifier "auto" - "Infer the shortest path type." - :type '(choice - (const "auto") - (const "relative") - (const "non-relative")) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-preferences-rename-shorthand-properties t - "Enable/disable introducing aliases for object shorthand -properties during renames. Requires using TypeScript 3.4 or newer -in the workspace." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-preferences-rename-shorthand-properties t - "Enable/disable introducing aliases for object shorthand -properties during renames. Requires using TypeScript 3.4 or newer -in the workspace." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-update-imports-on-file-move-enabled "prompt" - "Enable/disable automatic updating of import paths when you -rename or move a file in VS Code. Requires using TypeScript 2.9 -or newer in the workspace." - :type '(choice - (const "prompt") - (const "always") - (const "never")) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-update-imports-on-file-move-enabled "prompt" - "Prompt on each rename." - :type '(choice - (const "prompt") - (const "always") - (const "never")) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-auto-closing-tags t - "Enable/disable automatic closing of JSX tags. Requires using -TypeScript 3.0 or newer in the workspace." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-auto-closing-tags t - "Enable/disable automatic closing of JSX tags. Requires using -TypeScript 3.0 or newer in the workspace." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-suggest-enabled t - "Enabled/disable autocomplete suggestions." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-suggest-enabled t - "Enabled/disable autocomplete suggestions." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-typescript-surveys-enabled t - "Enabled/disable occasional surveys that help us improve VS -Code's JavaScript and TypeScript support." - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-javascript-display-enum-member-value-hints nil - "Show inlay hints for enum member values." - :type 'boolean - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-javascript-display-return-type-hints nil - "Show inlay hints for function return types." - :type 'boolean - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-javascript-display-parameter-type-hints nil - "Show inlay hints for function parameters." - :type 'boolean - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-javascript-display-parameter-name-hints "none" - "Level of hinting for parameter types." - :type '(choice (const :tag "none" "none") - (const :tag "literals" "literals") - (const :tag "all" "all")) - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-javascript-display-parameter-name-hints-when-argument-matches-name nil - "Show inlay hints for function parameters even when argument matches -name (e.g. `data' variable passed as `data' parameter)." - :type 'boolean - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-javascript-display-property-declaration-type-hints nil - "Show inlay hints for property declaration types." - :type 'boolean - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-javascript-display-variable-type-hints nil - "Show inlay hints for variable types." - :type 'boolean - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-javascript-completions-complete-function-calls t - "Complete function calls." - :type 'boolean - :package-version '(lsp-mode . "9.0.0")) - -(lsp-register-custom-settings - '(("javascript.autoClosingTags" lsp-javascript-auto-closing-tags t) - ("javascript.implicitProjectConfig.checkJs" lsp-javascript-implicit-project-config-check-js t) - ("javascript.implicitProjectConfig.experimentalDecorators" lsp-javascript-implicit-project-config-experimental-decorators t) - ("javascript.preferences.importModuleSpecifier" lsp-javascript-preferences-import-module-specifier) - ("javascript.preferences.quoteStyle" lsp-javascript-preferences-quote-style) - ("javascript.preferences.renameShorthandProperties" lsp-javascript-preferences-rename-shorthand-properties t) - ("javascript.referencesCodeLens.enabled" lsp-javascript-references-code-lens-enabled t) - ("javascript.suggest.autoImports" lsp-javascript-suggest-auto-imports t) - ("javascript.suggest.completeFunctionCalls" lsp-javascript-suggest-complete-function-calls t) - ("javascript.suggest.completeJSDocs" lsp-javascript-suggest-complete-js-docs t) - ("javascript.suggest.enabled" lsp-javascript-suggest-enabled t) - ("javascript.suggest.names" lsp-javascript-suggest-names t) - ("javascript.suggest.paths" lsp-javascript-suggest-paths t) - ("javascript.suggestionActions.enabled" lsp-javascript-suggestion-actions-enabled t) - ("javascript.updateImportsOnFileMove.enabled" lsp-javascript-update-imports-on-file-move-enabled) - ("javascript.validate.enable" lsp-javascript-validate-enable t) - ("javascript.format.enable" lsp-javascript-format-enable t) - ("javascript.format.insertSpaceAfterCommaDelimiter" lsp-javascript-format-insert-space-after-comma-delimiter t) - ("javascript.format.insertSpaceAfterConstructor" lsp-javascript-format-insert-space-after-constructor t) - ("javascript.format.insertSpaceAfterFunctionKeywordForAnonymousFunctions" lsp-javascript-format-insert-space-after-function-keyword-for-anonymous-functions t) - ("javascript.format.insertSpaceAfterKeywordsInControlFlowStatements" lsp-javascript-format-insert-space-after-keywords-in-control-flow-statements t) - ("javascript.format.insertSpaceAfterOpeningAndBeforeClosingJsxExpressionBraces" lsp-javascript-format-insert-space-after-opening-and-before-closing-jsx-expression-braces t) - ("javascript.format.insertSpaceAfterOpeningAndBeforeClosingEmptyBraces" lsp-javascript-format-insert-space-after-opening-and-before-closing-empty-braces t) - ("javascript.format.insertSpaceAfterOpeningAndBeforeClosingNonemptyBraces" lsp-javascript-format-insert-space-after-opening-and-before-closing-nonempty-braces t) - ("javascript.format.insertSpaceAfterOpeningAndBeforeClosingNonemptyBrackets" lsp-javascript-format-insert-space-after-opening-and-before-closing-nonempty-brackets t) - ("javascript.format.insertSpaceAfterOpeningAndBeforeClosingNonemptyParenthesis" lsp-javascript-format-insert-space-after-opening-and-before-closing-nonempty-parenthesis t) - ("javascript.format.insertSpaceAfterOpeningAndBeforeClosingTemplateStringBraces" lsp-javascript-format-insert-space-after-opening-and-before-closing-template-string-braces t) - ("javascript.format.insertSpaceAfterSemicolonInForStatements" lsp-javascript-format-insert-space-after-semicolon-in-for-statements t) - ("javascript.format.insertSpaceBeforeAndAfterBinaryOperators" lsp-javascript-format-insert-space-before-and-after-binary-operators t) - ("javascript.format.insertSpaceBeforeFunctionParenthesis" lsp-javascript-format-insert-space-before-function-parenthesis t) - ("javascript.format.placeOpenBraceOnNewLineForControlBlocks" lsp-javascript-format-place-open-brace-on-new-line-for-control-blocks t) - ("javascript.format.placeOpenBraceOnNewLineForFunctions" lsp-javascript-format-place-open-brace-on-new-line-for-functions t) - ("typescript.autoClosingTags" lsp-typescript-auto-closing-tags t) - ("typescript.check.npmIsInstalled" lsp-typescript-check-npm-is-installed t) - ("typescript.disableAutomaticTypeAcquisition" lsp-typescript-disable-automatic-type-acquisition t) - ("typescript.implementationsCodeLens.enabled" lsp-typescript-implementations-code-lens-enabled t) - ("typescript.locale" lsp-typescript-locale) - ("typescript.npm" lsp-typescript-npm) - ("typescript.preferences.importModuleSpecifier" lsp-typescript-preferences-import-module-specifier) - ("typescript.preferences.quoteStyle" lsp-typescript-preferences-quote-style) - ("typescript.preferences.renameShorthandProperties" lsp-typescript-preferences-rename-shorthand-properties t) - ("typescript.referencesCodeLens.enabled" lsp-typescript-references-code-lens-enabled t) - ("typescript.reportStyleChecksAsWarnings" lsp-typescript-report-style-checks-as-warnings t) - ("typescript.suggest.autoImports" lsp-typescript-suggest-auto-imports t) - ("typescript.suggest.completeFunctionCalls" lsp-typescript-suggest-complete-function-calls t) - ("typescript.suggest.completeJSDocs" lsp-typescript-suggest-complete-js-docs t) - ("typescript.suggest.enabled" lsp-typescript-suggest-enabled t) - ("typescript.suggest.paths" lsp-typescript-suggest-paths t) - ("typescript.suggestionActions.enabled" lsp-typescript-suggestion-actions-enabled t) - ("typescript.surveys.enabled" lsp-typescript-surveys-enabled t) - ("typescript.tsc.autoDetect" lsp-typescript-tsc-auto-detect) - ("typescript.tsdk" lsp-typescript-tsdk) - ("typescript.tsserver.log" lsp-typescript-tsserver-log) - ("typescript.tsserver.pluginPaths" lsp-typescript-tsserver-plugin-paths) - ("typescript.tsserver.trace" lsp-typescript-tsserver-trace) - ("typescript.updateImportsOnFileMove.enabled" lsp-typescript-update-imports-on-file-move-enabled) - ("typescript.validate.enable" lsp-typescript-validate-enable t) - ("typescript.format.enable" lsp-typescript-format-enable t) - ("typescript.format.insertSpaceAfterCommaDelimiter" lsp-typescript-format-insert-space-after-comma-delimiter t) - ("typescript.format.insertSpaceAfterConstructor" lsp-typescript-format-insert-space-after-constructor t) - ("typescript.format.insertSpaceAfterFunctionKeywordForAnonymousFunctions" lsp-typescript-format-insert-space-after-function-keyword-for-anonymous-functions t) - ("typescript.format.insertSpaceAfterKeywordsInControlFlowStatements" lsp-typescript-format-insert-space-after-keywords-in-control-flow-statements t) - ("typescript.format.insertSpaceAfterOpeningAndBeforeClosingJsxExpressionBraces" lsp-typescript-format-insert-space-after-opening-and-before-closing-jsx-expression-braces t) - ("typescript.format.insertSpaceAfterOpeningAndBeforeClosingEmptyBraces" lsp-typescript-format-insert-space-after-opening-and-before-closing-empty-braces t) - ("typescript.format.insertSpaceAfterOpeningAndBeforeClosingNonemptyBraces" lsp-typescript-format-insert-space-after-opening-and-before-closing-nonempty-braces t) - ("typescript.format.insertSpaceAfterOpeningAndBeforeClosingNonemptyBrackets" lsp-typescript-format-insert-space-after-opening-and-before-closing-nonempty-brackets t) - ("typescript.format.insertSpaceAfterOpeningAndBeforeClosingNonemptyParenthesis" lsp-typescript-format-insert-space-after-opening-and-before-closing-nonempty-parenthesis t) - ("typescript.format.insertSpaceAfterOpeningAndBeforeClosingTemplateStringBraces" lsp-typescript-format-insert-space-after-opening-and-before-closing-template-string-braces t) - ("typescript.format.insertSpaceAfterSemicolonInForStatements" lsp-typescript-format-insert-space-after-semicolon-in-for-statements t) - ("typescript.format.insertSpaceAfterTypeAssertion" lsp-typescript-format-insert-space-after-type-assertion t) - ("typescript.format.insertSpaceBeforeAndAfterBinaryOperators" lsp-typescript-format-insert-space-before-and-after-binary-operators t) - ("typescript.format.insertSpaceBeforeFunctionParenthesis" lsp-typescript-format-insert-space-before-function-parenthesis t) - ("typescript.format.placeOpenBraceOnNewLineForControlBlocks" lsp-typescript-format-place-open-brace-on-new-line-for-control-blocks t) - ("typescript.format.placeOpenBraceOnNewLineForFunctions" lsp-typescript-format-place-open-brace-on-new-line-for-functions t) - ("typescript.inlayHints.includeInlayEnumMemberValueHints" lsp-javascript-display-enum-member-value-hints t) - ("typescript.inlayHints.includeInlayFunctionLikeReturnTypeHints" lsp-javascript-display-return-type-hints t) - ("typescript.inlayHints.includeInlayFunctionParameterTypeHints" lsp-javascript-display-parameter-type-hints t) - ("typescript.inlayHints.includeInlayParameterNameHints" lsp-javascript-display-parameter-name-hints nil) - ("typescript.inlayHints.includeInlayParameterNameHintsWhenArgumentMatchesName" lsp-javascript-display-parameter-name-hints-when-argument-matches-name t) - ("typescript.inlayHints.includeInlayPropertyDeclarationTypeHints" lsp-javascript-display-property-declaration-type-hints t) - ("typescript.inlayHints.includeInlayVariableTypeHints" lsp-javascript-display-variable-type-hints t) - ("javascript.inlayHints.includeInlayEnumMemberValueHints" lsp-javascript-display-enum-member-value-hints t) - ("javascript.inlayHints.includeInlayFunctionLikeReturnTypeHints" lsp-javascript-display-return-type-hints t) - ("javascript.inlayHints.includeInlayFunctionParameterTypeHints" lsp-javascript-display-parameter-type-hints t) - ("javascript.inlayHints.includeInlayParameterNameHints" lsp-javascript-display-parameter-name-hints nil) - ("javascript.inlayHints.includeInlayParameterNameHintsWhenArgumentMatchesName" lsp-javascript-display-parameter-name-hints-when-argument-matches-name t) - ("javascript.inlayHints.includeInlayPropertyDeclarationTypeHints" lsp-javascript-display-property-declaration-type-hints t) - ("javascript.inlayHints.includeInlayVariableTypeHints" lsp-javascript-display-variable-type-hints t) - ("completions.completeFunctionCalls" lsp-javascript-completions-complete-function-calls t))) - -(lsp-dependency 'typescript-language-server - '(:system lsp-clients-typescript-tls-path) - '(:npm :package "typescript-language-server" - :path "typescript-language-server")) - -(lsp-dependency 'typescript - '(:system "tsserver") - '(:npm :package "typescript" - :path "tsserver")) - -(defun lsp-javascript--rename (_workspace args) - (let ((path (lsp--uri-to-path (lsp-get (lsp-get args :textDocument) :uri)))) - (if (f-exists? path) - (with-current-buffer (find-file path) - (goto-char (lsp--position-to-point - (lsp-get args :position)))) - (error "There is no file %s" path))) - (call-interactively #'lsp-rename) - nil) - -(defun lsp-javascript-rename-file () - "Rename current file and all it's references in other files." - (interactive) - (let* ((name (buffer-name)) - (old (buffer-file-name)) - (basename (file-name-nondirectory old))) - (unless (and old (file-exists-p old)) - (error "Buffer '%s' is not visiting a file." name)) - (let ((new (read-file-name "New name: " (file-name-directory old) basename nil basename))) - (when (get-file-buffer new) - (error "A buffer named '%s' already exists." new)) - (when (file-exists-p new) - (error "A file named '%s' already exists." new)) - (lsp--send-execute-command - "_typescript.applyRenameFile" - (vector (list :sourceUri (lsp--buffer-uri) - :targetUri (lsp--path-to-uri new)))) - (mkdir (file-name-directory new) t) - (rename-file old new) - (rename-buffer new) - (set-visited-file-name new) - (set-buffer-modified-p nil) - (lsp-disconnect) - (setq-local lsp-buffer-uri nil) - (lsp) - (lsp--info "Renamed '%s' to '%s'." name (file-name-nondirectory new))))) - -(defun lsp-javascript-initialized? () - (when-let ((workspace (lsp-find-workspace 'ts-ls (buffer-file-name)))) - (eq 'initialized (lsp--workspace-status workspace)))) - -(defun lsp-clients-typescript-require-resolve (&optional dir) - "Get the location of the typescript. -Use Node.js require. -The node_modules directory structure is suspect -and should be trusted as little as possible. -If you call require in Node.js, -it should take into account the various hooks. -For example, yarn PnP. - -Optional argument DIR specifies the working directory -to run the command in." - (when-let* - ((default-directory (or dir default-directory)) - (output - (string-trim-right - (shell-command-to-string - "node -e \"console.log(require.resolve('typescript'))\""))) - (not-empty (not (string-empty-p output)))) - (f-parent output))) - -(defun lsp-clients-typescript-server-path () - "Return the TS server path based on settings." - (if-let* ((use-project-ts lsp-clients-typescript-prefer-use-project-ts-server) - (server-path (lsp-clients-typescript-require-resolve)) - (server-path-exist (f-exists? server-path))) - server-path - (if (memq system-type '(cygwin windows-nt ms-dos)) - ;; The Windows environment does not recognize the top-level PATH returned by `lsp-package-path', - ;; so the real PATH is returned through Node.js. - (lsp-clients-typescript-require-resolve (f-parent (lsp-package-path 'typescript))) - (lsp-package-path 'typescript)))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection (lambda () - `(,(lsp-package-path 'typescript-language-server) - ,@lsp-clients-typescript-server-args))) - :activation-fn 'lsp-typescript-javascript-tsx-jsx-activate-p - :priority -2 - :completion-in-comments? t - :initialization-options (lambda () - (append - (when lsp-clients-typescript-disable-automatic-typing-acquisition - (list :disableAutomaticTypingAcquisition lsp-clients-typescript-disable-automatic-typing-acquisition)) - (when lsp-clients-typescript-log-verbosity - (list :logVerbosity lsp-clients-typescript-log-verbosity)) - (when lsp-clients-typescript-max-ts-server-memory - (list :maxTsServerMemory lsp-clients-typescript-max-ts-server-memory)) - (when lsp-clients-typescript-npm-location - (list :npmLocation lsp-clients-typescript-npm-location)) - (when lsp-clients-typescript-plugins - (list :plugins lsp-clients-typescript-plugins)) - (when lsp-clients-typescript-preferences - (list :preferences lsp-clients-typescript-preferences)) - `(:tsserver ( :path ,(lsp-clients-typescript-server-path) - ,@lsp-clients-typescript-tsserver)))) - :initialized-fn (lambda (workspace) - (with-lsp-workspace workspace - (lsp--set-configuration - (ht-merge (lsp-configuration-section "javascript") - (lsp-configuration-section "typescript") - (lsp-configuration-section "completions") - (lsp-configuration-section "diagnostics")))) - (let ((caps (lsp--workspace-server-capabilities workspace)) - (format-enable (or lsp-javascript-format-enable lsp-typescript-format-enable))) - (lsp:set-server-capabilities-document-formatting-provider? caps format-enable) - (lsp:set-server-capabilities-document-range-formatting-provider? caps format-enable))) - :ignore-messages '("readFile .*? requested by TypeScript but content not available") - :server-id 'ts-ls - :request-handlers (ht ("_typescript.rename" #'lsp-javascript--rename)) - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure - 'typescript - (-partial #'lsp-package-ensure - 'typescript-language-server - callback - error-callback) - error-callback)))) - - -(defgroup lsp-flow nil - "LSP support for the Flow Javascript type checker." - :group 'lsp-mode - :link '(url-link "https://flow.org")) - -(defcustom lsp-clients-flow-server "flow" - "The Flow executable to use. -Leave as just the executable name to use the default behavior of -finding the executable with variable `exec-path'." - :group 'lsp-flow - :risky t - :type 'file) - -(defcustom lsp-clients-flow-server-args '("lsp") - "Extra arguments for starting the Flow language server." - :group 'lsp-flow - :risky t - :type '(repeat string)) - -(defun lsp-clients-flow-tag-file-present-p (file-name) - "Check if the '// @flow' or `/* @flow */' tag is present in -the contents of FILE-NAME." - (if-let ((buffer (find-buffer-visiting file-name))) - (with-current-buffer buffer - (lsp-clients-flow-tag-string-present-p)) - (with-temp-buffer - (insert-file-contents file-name) - (lsp-clients-flow-tag-string-present-p)))) - -(defun lsp-clients-flow-tag-string-present-p () - "Helper for `lsp-clients-flow-tag-file-present-p' that works -with the file contents." - (save-excursion - (goto-char (point-min)) - (let (stop found) - (while (not stop) - (unless (re-search-forward "[^\n[:space:]]" nil t) - (setq stop t)) - (if (= (point) (point-min)) (setq stop t) (backward-char)) - (cond ((or (looking-at-p "//+[ ]*@flow") - (looking-at-p "/\\**[ ]*@flow") - (looking-at-p "[ ]*\\*[ ]*@flow")) - (setq found t) (setq stop t)) - ((or (looking-at-p "//") (looking-at-p "*")) - (forward-line)) - ((looking-at-p "/\\*") - (save-excursion - (unless (re-search-forward "*/" nil t) (setq stop t))) - (forward-line)) - (t (setq stop t)))) - found))) - -(defun lsp-clients-flow-project-p (file-name) - "Check if FILE-NAME is part of a Flow project, that is, if -there is a .flowconfig file in the folder hierarchy." - (locate-dominating-file file-name ".flowconfig")) - -(defun lsp-clients-flow-activate-p (file-name _mode) - "Check if the Flow language server should be enabled for a -particular FILE-NAME and MODE." - (and (derived-mode-p 'js-mode 'web-mode 'js2-mode 'flow-js2-mode 'rjsx-mode) - (not (derived-mode-p 'json-mode)) - (or (lsp-clients-flow-project-p file-name) - (lsp-clients-flow-tag-file-present-p file-name)))) - -(lsp-register-client - (make-lsp-client :new-connection - (lsp-stdio-connection (lambda () - (cons lsp-clients-flow-server - lsp-clients-flow-server-args))) - :priority -1 - :activation-fn 'lsp-clients-flow-activate-p - :server-id 'flow-ls)) - -(defgroup lsp-deno nil - "LSP support for the Deno language server." - :group 'lsp-mode - :link '(url-link "https://deno.land/")) - -(defcustom lsp-clients-deno-server "deno" - "The Deno executable to use. -Leave as just the executable name to use the default behavior of -finding the executable with variable `exec-path'." - :group 'lsp-deno - :risky t - :type 'file - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-clients-deno-server-args '("lsp") - "Extra arguments for starting the Deno language server." - :group 'lsp-deno - :risky t - :type '(repeat string) - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-clients-deno-enable-lint t - "Controls if linting information will be provided by the Deno Language Server." - :group 'lsp-deno - :risky t - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-clients-deno-enable-code-lens-references t - "Enables or disables the display of code lens information." - :group 'lsp-deno - :risky t - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-clients-deno-enable-code-lens-references-all-functions t - "Enables or disables the display of code lens information for all functions. -Setting this variable to `non-nil' implicitly enables -`lsp-clients-deno-enable-code-lens-references'." - :group 'lsp-deno - :risky t - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-clients-deno-enable-code-lens-implementations t - "Enables or disables the display of code lens information for implementations." - :group 'lsp-deno - :risky t - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-clients-deno-config nil - "The file path to a tsconfig.json file. -The path can be either be relative to the workspace, or an -absolute path. - -Examples: `./tsconfig.json', -`/path/to/tsconfig.json', `C:\\path\\to\\tsconfig.json'" - :group 'lsp-deno - :risky t - :type 'file - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-clients-deno-import-map nil - "The file path to an import map. -Import maps provide a way to relocate modules based on their -specifiers. The path can either be relative to the workspace, or -an absolute path. - -Examples: `./import-map.json', -`/path/to/import-map.json', `C:\\path\\to\\import-map.json'." - :group 'lsp-deno - :risky t - :type 'file - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-clients-deno-enable-unstable nil - "Controls if code will be type checked with Deno's unstable APIs." - :group 'lsp-deno - :risky t - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defun lsp-clients-deno--make-init-options () - "Initialization options for the Deno language server." - `( :enable t - :config ,lsp-clients-deno-config - :importMap ,lsp-clients-deno-import-map - :lint ,(lsp-json-bool lsp-clients-deno-enable-lint) - :unstable ,(lsp-json-bool lsp-clients-deno-enable-unstable) - :codeLens ( :implementations ,(lsp-json-bool lsp-clients-deno-enable-code-lens-implementations) - :references ,(lsp-json-bool (or lsp-clients-deno-enable-code-lens-references - lsp-clients-deno-enable-code-lens-references-all-functions)) - :referencesAllFunctions ,(lsp-json-bool lsp-clients-deno-enable-code-lens-references-all-functions)))) - -(lsp-register-client - (make-lsp-client :new-connection - (lsp-stdio-connection (lambda () - (cons lsp-clients-deno-server - lsp-clients-deno-server-args))) - :initialization-options #'lsp-clients-deno--make-init-options - :priority -5 - :activation-fn #'lsp-typescript-javascript-tsx-jsx-activate-p - :server-id 'deno-ls)) - -(lsp-consistency-check lsp-javascript) - -(provide 'lsp-javascript) -;;; lsp-javascript.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-lisp.el b/emacs/elpa/lsp-mode-20241113.743/lsp-lisp.el @@ -1,92 +0,0 @@ -;;; lsp-lisp.el --- LSP client for Lisp -*- lexical-binding: t; -*- - -;; Copyright (C) 2024 Shen, Jen-Chieh - -;; 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 this program. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; LSP client for Lisp. -;; - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-lisp nil - "LSP support for Lisp." - :group 'lsp-mode - :package-version `(lsp-mode . "9.0.0")) - -(defcustom lsp-lisp-active-modes - '( lisp-mode) - "List of major mode that work with lisp." - :type 'list - :group 'lsp-lisp) - -(defcustom lsp-lisp-alive-port 8006 - "Port to connect server to." - :type 'integer - :group 'lsp-lisp) - -;; -;;; Server - -;;;###autoload -(defun lsp-lisp-alive-start-ls () - "Start the alive-lsp." - (interactive) - (when-let ((exe (executable-find "sbcl")) - ((lsp--port-available "localhost" lsp-lisp-alive-port))) - (lsp-async-start-process #'ignore #'ignore - exe - "--noinform" - "--eval" - "(ql:quickload \"alive-lsp\")" - "--eval" - (format "(alive/server::start :port %s)" - lsp-lisp-alive-port)))) - -;; -;;; Core - -(defun lsp-lisp-alive--tcp-connect-to-port () - "Define a TCP connection to language server." - (list - :connect - (lambda (filter sentinel name _environment-fn _workspace) - (let* ((host "localhost") - (port lsp-lisp-alive-port) - (tcp-proc (lsp--open-network-stream host port (concat name "::tcp")))) - - ;; TODO: Same :noquery issue (see above) - (set-process-query-on-exit-flag tcp-proc nil) - (set-process-filter tcp-proc filter) - (set-process-sentinel tcp-proc sentinel) - (cons tcp-proc tcp-proc))) - :test? (lambda () t))) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-lisp-alive--tcp-connect-to-port) - :major-modes lsp-lisp-active-modes - :priority -1 - :server-id 'alive-lsp)) - -(lsp-consistency-check lsp-lisp) - -(provide 'lsp-lisp) -;;; lsp-lisp.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-lisp.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-lisp.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-markdown.el b/emacs/elpa/lsp-mode-20241113.743/lsp-markdown.el @@ -1,103 +0,0 @@ -;;; lsp-markdown.el --- lsp-mode markdown integration -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 lsp-mode maintainers - -;; Author: lsp-mode maintainers -;; Keywords: languages - -;; 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: - -;; LSP client for unified-language-server - -;;; Code: - -(require 'lsp-mode) - -;;; Markdown -(defgroup lsp-markdown nil - "Settings for the markdown language server client." - :group 'lsp-mode - :link '(url-link "https://github.com/unifiedjs/unified-language-server") - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-markdown-server-command "unified-language-server" - "The binary (or full path to binary) which executes the server." - :type 'string - :group 'lsp-markdown - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-markdown-server-command-args '("--parser=remark-parse" "--stdio") - "Command-line arguments for the markdown lsp server." - :type '(repeat 'string) - :group 'lsp-markdown - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-markdown-remark-plugins [["#remark-preset-lint-markdown-style-guide"]] - "The JSON configuration object for plugins. - -For a complete list of plugins, check: - https://github.com/unifiedjs/unified-language-server/blob/main/CONFIGURATION.md#re-using-settings" - :type 'lsp-string-vector - :group 'lsp-markdown - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-markdown-remark-check-text-with-setting "retext-english" - "Configure `checkTextWith' subproperty. - -For a complete list of plugins, check: - https://github.com/unifiedjs/unified-language-server/blob/main/CONFIGURATION.md#re-using-settings" - :type '(choice ( - (const "retext-english") - (const "remark-parse"))) - :group 'lsp-markdown - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-markdown-remark-check-text-with-mutator ["#remark-retext" "#parse-latin"] - "Vector of additional mutators. - -For a complete list of plugins, check: - https://github.com/unifiedjs/unified-language-server/blob/main/CONFIGURATION.md#re-using-settings" - :type 'lsp-string-vector - :group 'lsp-markdown - :package-version '(lsp-mode . "8.0.0")) - -(lsp-dependency 'unified-language-server - '(:system "unified-language-server") - '(:npm :package "unified-language-server" - :path "unified-language-server")) - -(lsp-register-custom-settings - `(("unified-language-server.remark-parse.plugins" lsp-markdown-remark-plugins) - ("unified-language-server.remark-parse.checkTextWith.setting" lsp-markdown-remark-check-text-with-setting) - ("unified-language-server.remark-parse.checkTextWith.mutator" lsp-markdown-remark-check-text-with-mutator))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection - (lambda () - (cons (or (executable-find lsp-markdown-server-command) - (lsp-package-path 'unified-language-server)) - lsp-markdown-server-command-args))) - :activation-fn (lsp-activate-on "markdown") - :initialized-fn (lambda (workspace) - (with-lsp-workspace workspace - (lsp--set-configuration (lsp-configuration-section "unified-language-server")))) - :priority -1 - :server-id 'unified)) - -(lsp-consistency-check lsp-markdown) - -(provide 'lsp-markdown) -;;; lsp-markdown.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-markdown.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-markdown.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-mode-pkg.el b/emacs/elpa/lsp-mode-20241113.743/lsp-mode-pkg.el @@ -1,15 +0,0 @@ -;; -*- no-byte-compile: t; lexical-binding: nil -*- -(define-package "lsp-mode" "20241113.743" - "LSP mode." - '((emacs "27.1") - (dash "2.18.0") - (f "0.20.0") - (ht "2.3") - (spinner "1.7.3") - (markdown-mode "2.3") - (lv "0") - (eldoc "1.11")) - :url "https://github.com/emacs-lsp/lsp-mode" - :commit "c41769e32c8db9bb7357bf078def7255477798ac" - :revdesc "c41769e32c8d" - :keywords '("languages")) diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-mode.el b/emacs/elpa/lsp-mode-20241113.743/lsp-mode.el @@ -1,9953 +0,0 @@ -;;; lsp-mode.el --- LSP mode -*- lexical-binding: t; -*- - -;; Copyright (C) 2020-2024 emacs-lsp maintainers - -;; Author: Vibhav Pant, Fangrui Song, Ivan Yonchovski -;; Keywords: languages -;; Package-Requires: ((emacs "27.1") (dash "2.18.0") (f "0.20.0") (ht "2.3") (spinner "1.7.3") (markdown-mode "2.3") (lv "0") (eldoc "1.11")) -;; Package-Version: 20241113.743 -;; Package-Revision: c41769e32c8d - -;; URL: https://github.com/emacs-lsp/lsp-mode -;; 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: - -;; Emacs client/library for the Language Server Protocol - -;;; Code: - -(require 'cl-generic) -(require 'cl-lib) -(require 'compile) -(require 'dash) -(require 'epg) -(require 'ewoc) -(require 'f) -(require 'filenotify) -(require 'files) -(require 'ht) -(require 'imenu) -(require 'inline) -(require 'json) -(require 'lv) -(require 'markdown-mode) -(require 'network-stream) -(require 'pcase) -(require 'rx) -(require 's) -(require 'seq) -(require 'spinner) -(require 'subr-x) -(require 'tree-widget) -(require 'url-parse) -(require 'url-util) -(require 'widget) -(require 'xref) -(require 'minibuffer) -(require 'help-mode) -(require 'lsp-protocol) - -(defgroup lsp-mode nil - "Language Server Protocol client." - :group 'tools - :tag "Language Server (lsp-mode)") - -(declare-function evil-set-command-property "ext:evil-common") -(declare-function projectile-project-root "ext:projectile") -(declare-function yas-expand-snippet "ext:yasnippet") -(declare-function dap-mode "ext:dap-mode") -(declare-function dap-auto-configure-mode "ext:dap-mode") - -(defvar yas-inhibit-overlay-modification-protection) -(defvar yas-indent-line) -(defvar yas-wrap-around-region) -(defvar yas-also-auto-indent-first-line) -(defvar dap-auto-configure-mode) -(defvar dap-ui-menu-items) -(defvar company-minimum-prefix-length) - -(defconst lsp--message-type-face - `((1 . ,compilation-error-face) - (2 . ,compilation-warning-face) - (3 . ,compilation-message-face) - (4 . ,compilation-info-face))) - -(defconst lsp--errors - '((-32700 "Parse Error") - (-32600 "Invalid Request") - (-32601 "Method not Found") - (-32602 "Invalid Parameters") - (-32603 "Internal Error") - (-32099 "Server Start Error") - (-32000 "Server End Error") - (-32002 "Server Not Initialized") - (-32001 "Unknown Error Code") - (-32800 "Request Cancelled")) - "Alist of error codes to user friendly strings.") - -(defconst lsp--empty-ht (make-hash-table)) - -(eval-and-compile - (defun dash-expand:&lsp-wks (key source) - `(,(intern-soft (format "lsp--workspace-%s" (eval key))) ,source)) - - (defun dash-expand:&lsp-cln (key source) - `(,(intern-soft (format "lsp--client-%s" (eval key))) ,source))) - -(define-obsolete-variable-alias 'lsp-print-io 'lsp-log-io "lsp-mode 6.1") - -(defcustom lsp-log-io nil - "If non-nil, log all messages from the language server to a *lsp-log* buffer." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-log-io-allowlist-methods '() - "The methods to filter before print to lsp-log-io." - :group 'lsp-mode - :type '(repeat string) - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-log-max message-log-max - "Maximum number of lines to keep in the log buffer. -If nil, disable message logging. If t, log messages but don’t truncate -the buffer when it becomes large." - :group 'lsp-mode - :type '(choice (const :tag "Disable" nil) - (integer :tag "lines") - (const :tag "Unlimited" t)) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-io-messages-max t - "Maximum number of messages that can be locked in a `lsp-io' buffer." - :group 'lsp-mode - :type '(choice (const :tag "Unlimited" t) - (integer :tag "Messages")) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-keep-workspace-alive t - "If non nil keep workspace alive when the last workspace buffer is closed." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-enable-snippet t - "Enable/disable snippet completion support." - :group 'lsp-completion - :type 'boolean) - -(defcustom lsp-enable-folding t - "Enable/disable code folding support." - :group 'lsp-mode - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(define-obsolete-variable-alias 'lsp-enable-semantic-highlighting 'lsp-semantic-tokens-enable "lsp-mode 8.0.0") - -(defcustom lsp-semantic-tokens-enable nil - "Enable/disable support for semantic tokens. -As defined by the Language Server Protocol 3.16." - :group 'lsp-semantic-tokens - :type 'boolean) - -(defcustom lsp-folding-range-limit nil - "The maximum number of folding ranges to receive from the language server." - :group 'lsp-mode - :type '(choice (const :tag "No limit." nil) - (integer :tag "Number of lines.")) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-folding-line-folding-only nil - "If non-nil, only fold complete lines." - :group 'lsp-mode - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-client-packages - '( ccls lsp-actionscript lsp-ada lsp-angular lsp-ansible lsp-asm lsp-astro - lsp-autotools lsp-awk lsp-bash lsp-beancount lsp-bufls lsp-clangd - lsp-clojure lsp-cmake lsp-cobol lsp-credo lsp-crystal lsp-csharp lsp-css - lsp-cucumber lsp-cypher lsp-d lsp-dart lsp-dhall lsp-docker lsp-dockerfile - lsp-earthly lsp-elixir lsp-elm lsp-emmet lsp-erlang lsp-eslint lsp-fortran lsp-futhark - lsp-fsharp lsp-gdscript lsp-gleam lsp-glsl lsp-go lsp-golangci-lint lsp-grammarly - lsp-graphql lsp-groovy lsp-hack lsp-haskell lsp-haxe lsp-idris lsp-java - lsp-javascript lsp-jq lsp-json lsp-kotlin lsp-latex lsp-lisp lsp-ltex - lsp-lua lsp-fennel lsp-magik lsp-markdown lsp-marksman lsp-mdx lsp-meson lsp-metals lsp-mint - lsp-mojo lsp-move lsp-mssql lsp-nextflow lsp-nginx lsp-nim lsp-nix lsp-nushell lsp-ocaml - lsp-openscad lsp-pascal lsp-perl lsp-perlnavigator lsp-php lsp-pls - lsp-purescript lsp-pwsh lsp-pyls lsp-pylsp lsp-pyright lsp-python-ms - lsp-qml lsp-r lsp-racket lsp-remark lsp-rf lsp-roslyn lsp-rubocop lsp-ruby-lsp - lsp-ruby-syntax-tree lsp-ruff lsp-rust lsp-semgrep lsp-shader - lsp-solargraph lsp-solidity lsp-sonarlint lsp-sorbet lsp-sourcekit - lsp-sql lsp-sqls lsp-steep lsp-svelte lsp-tailwindcss lsp-terraform - lsp-tex lsp-tilt lsp-toml lsp-trunk lsp-ttcn3 lsp-typeprof lsp-typespec lsp-v - lsp-vala lsp-verilog lsp-vetur lsp-vhdl lsp-vimscript lsp-volar lsp-wgsl - lsp-xml lsp-yaml lsp-yang lsp-zig) - "List of the clients to be automatically required." - :group 'lsp-mode - :type '(repeat symbol)) - -(defcustom lsp-progress-via-spinner t - "If non-nil, display LSP $/progress reports via a spinner in the modeline." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-progress-spinner-type 'progress-bar - "Holds the type of spinner to be used in the mode-line. -Takes a value accepted by `spinner-start'." - :group 'lsp-mode - :type `(choice :tag "Choose a spinner by name" - ,@(mapcar (lambda (c) (list 'const (car c))) - spinner-types))) - -(defvar-local lsp-use-workspace-root-for-server-default-directory nil - "Use `lsp-workspace-root' for `default-directory' when starting LSP process.") - -(defvar-local lsp--cur-workspace nil) - -(defvar-local lsp--cur-version 0) -(defvar-local lsp--virtual-buffer-connections nil) -(defvar-local lsp--virtual-buffer nil) -(defvar lsp--virtual-buffer-mappings (ht)) - -(defvar lsp--uri-file-prefix (pcase system-type - (`windows-nt "file:///") - (_ "file://")) - "Prefix for a file-uri.") - -(defvar-local lsp-buffer-uri nil - "If set, return it instead of calculating it using `buffer-file-name'.") - -(define-error 'lsp-error "Unknown lsp-mode error") -(define-error 'lsp-empty-response-error - "Empty response from the language server" 'lsp-error) -(define-error 'lsp-timed-out-error - "Timed out while waiting for a response from the language server" 'lsp-error) -(define-error 'lsp-capability-not-supported - "Capability not supported by the language server" 'lsp-error) -(define-error 'lsp-file-scheme-not-supported - "Unsupported file scheme" 'lsp-error) -(define-error 'lsp-client-already-exists-error - "A client with this server-id already exists" 'lsp-error) -(define-error 'lsp-no-code-actions - "No code actions" 'lsp-error) - -(defcustom lsp-auto-guess-root nil - "Automatically guess the project root using projectile/project. -Do *not* use this setting unless you are familiar with `lsp-mode' -internals and you are sure that all of your projects are -following `projectile'/`project.el' conventions." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-guess-root-without-session nil - "Ignore the session file when calculating the project root. -You almost always want to set lsp-auto-guess-root too. -Do *not* use this setting unless you are familiar with `lsp-mode' -internals and you are sure that all of your projects are -following `projectile'/`project.el' conventions." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-restart 'interactive - "Defines how server-exited events must be handled." - :group 'lsp-mode - :type '(choice (const interactive) - (const auto-restart) - (const ignore))) - -(defcustom lsp-session-file (expand-file-name (locate-user-emacs-file ".lsp-session-v1")) - "File where session information is stored." - :group 'lsp-mode - :type 'file) - -(defcustom lsp-auto-configure t - "Auto configure `lsp-mode' main features. -When set to t `lsp-mode' will auto-configure completion, -code-actions, breadcrumb, `flycheck', `flymake', `imenu', symbol highlighting, -lenses, links, and so on. - -For finer granularity you may use `lsp-enable-*' properties." - :group 'lsp-mode - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-disabled-clients nil - "A list of disabled/blocklisted clients. -Each entry in the list can be either: -a symbol, the server-id for the LSP client, or -a cons pair (MAJOR-MODE . CLIENTS), where MAJOR-MODE is the major-mode, -and CLIENTS is either a client or a list of clients. - -This option can also be used as a file- or directory-local variable to -disable a language server for individual files or directories/projects -respectively." - :group 'lsp-mode - :type '(repeat (symbol)) - :safe 'listp - :package-version '(lsp-mode . "6.1")) - -(defvar lsp-clients (make-hash-table :test 'eql) - "Hash table server-id -> client. -It contains all of the clients that are currently registered.") - -(defvar lsp-enabled-clients nil - "List of clients allowed to be used for projects. -When nil, all registered clients are considered candidates.") - -(defvar lsp-last-id 0 - "Last request id.") - -(defcustom lsp-before-initialize-hook nil - "List of functions to be called before a Language Server has been initialized -for a new workspace." - :type 'hook - :group 'lsp-mode) - -(defcustom lsp-after-initialize-hook nil - "List of functions to be called after a Language Server has been initialized -for a new workspace." - :type 'hook - :group 'lsp-mode) - -(defcustom lsp-before-open-hook nil - "List of functions to be called before a new file with LSP support is opened." - :type 'hook - :group 'lsp-mode) - -(defcustom lsp-after-open-hook nil - "List of functions to be called after a new file with LSP support is opened." - :type 'hook - :group 'lsp-mode) - -(defcustom lsp-enable-file-watchers t - "If non-nil lsp-mode will watch the files in the workspace if -the server has requested that." - :type 'boolean - :group 'lsp-mode - :package-version '(lsp-mode . "6.1")) -;;;###autoload(put 'lsp-enable-file-watchers 'safe-local-variable #'booleanp) - -(define-obsolete-variable-alias 'lsp-file-watch-ignored 'lsp-file-watch-ignored-directories "8.0.0") - -(defcustom lsp-file-watch-ignored-directories - '(; SCM tools - "[/\\\\]\\.git\\'" - "[/\\\\]\\.github\\'" - "[/\\\\]\\.gitlab\\'" - "[/\\\\]\\.circleci\\'" - "[/\\\\]\\.hg\\'" - "[/\\\\]\\.bzr\\'" - "[/\\\\]_darcs\\'" - "[/\\\\]\\.svn\\'" - "[/\\\\]_FOSSIL_\\'" - ;; IDE or build tools - "[/\\\\]\\.idea\\'" - "[/\\\\]\\.ensime_cache\\'" - "[/\\\\]\\.eunit\\'" - "[/\\\\]node_modules" - "[/\\\\]\\.yarn\\'" - "[/\\\\]\\.fslckout\\'" - "[/\\\\]\\.tox\\'" - "[/\\\\]\\.nox\\'" - "[/\\\\]dist\\'" - "[/\\\\]dist-newstyle\\'" - "[/\\\\]\\.stack-work\\'" - "[/\\\\]\\.bloop\\'" - "[/\\\\]\\.metals\\'" - "[/\\\\]target\\'" - "[/\\\\]\\.ccls-cache\\'" - "[/\\\\]\\.vs\\'" - "[/\\\\]\\.vscode\\'" - "[/\\\\]\\.venv\\'" - "[/\\\\]\\.mypy_cache\\'" - "[/\\\\]\\.pytest_cache\\'" - ;; Swift Package Manager - "[/\\\\]\\.build\\'" - ;; Python - "[/\\\\]__pycache__\\'" - "[/\\\\]site-packages\\'" - "[/\\\\].pyenv\\'" - ;; Autotools output - "[/\\\\]\\.deps\\'" - "[/\\\\]build-aux\\'" - "[/\\\\]autom4te.cache\\'" - "[/\\\\]\\.reference\\'" - ;; Bazel - "[/\\\\]bazel-[^/\\\\]+\\'" - ;; CSharp - "[/\\\\]\\.cache[/\\\\]lsp-csharp\\'" - "[/\\\\]\\.meta\\'" - "[/\\\\]\\.nuget\\'" - ;; Unity - "[/\\\\]Library\\'" - ;; Clojure - "[/\\\\]\\.lsp\\'" - "[/\\\\]\\.clj-kondo\\'" - "[/\\\\]\\.shadow-cljs\\'" - "[/\\\\]\\.babel_cache\\'" - "[/\\\\]\\.cpcache\\'" - "[/\\\\]\\checkouts\\'" - ;; Gradle - "[/\\\\]\\.gradle\\'" - ;; Maven - "[/\\\\]\\.m2\\'" - ;; .Net Core build-output - "[/\\\\]bin/Debug\\'" - "[/\\\\]obj\\'" - ;; OCaml and Dune - "[/\\\\]_opam\\'" - "[/\\\\]_build\\'" - ;; Elixir - "[/\\\\]\\.elixir_ls\\'" - ;; Elixir Credo - "[/\\\\]\\.elixir-tools\\'" - ;; terraform and terragrunt - "[/\\\\]\\.terraform\\'" - "[/\\\\]\\.terragrunt-cache\\'" - ;; nix-direnv - "[/\\\\]\\result" - "[/\\\\]\\result-bin" - "[/\\\\]\\.direnv\\'") - "List of regexps matching directory paths which won't be monitored when -creating file watches. Customization of this variable is only honored at -the global level or at a root of an lsp workspace." - :group 'lsp-mode - :type '(repeat string) - :package-version '(lsp-mode . "8.0.0")) - -(define-obsolete-function-alias 'lsp-file-watch-ignored 'lsp-file-watch-ignored-directories "7.0.1") - -(defun lsp-file-watch-ignored-directories () - lsp-file-watch-ignored-directories) - -;; Allow lsp-file-watch-ignored-directories as a file or directory-local variable -;;;###autoload(put 'lsp-file-watch-ignored-directories 'safe-local-variable 'lsp--string-listp) - -(defcustom lsp-file-watch-ignored-files - '( - ;; Flycheck tempfiles - "[/\\\\]flycheck_[^/\\\\]+\\'" - ;; lockfiles - "[/\\\\]\\.#[^/\\\\]+\\'" - ;; backup files - "[/\\\\][^/\\\\]+~\\'" ) - "List of regexps matching files for which change events will -not be sent to the server. - -This setting has no impact on whether a file-watch is created for -a directory; it merely prevents notifications pertaining to -matched files from being sent to the server. To prevent a -file-watch from being created for a directory, customize -`lsp-file-watch-ignored-directories' - -Customization of this variable is only honored at the global -level or at a root of an lsp workspace." - :group 'lsp-mode - :type '(repeat string) - :package-version '(lsp-mode . "8.0.0")) - -;; Allow lsp-file-watch-ignored-files as a file or directory-local variable -;;;###autoload(put 'lsp-file-watch-ignored-files 'safe-local-variable 'lsp--string-listp) - -(defcustom lsp-after-uninitialized-functions nil - "List of functions to be called after a Language Server has been uninitialized." - :type 'hook - :group 'lsp-mode - :package-version '(lsp-mode . "6.3")) - -(defconst lsp--sync-full 1) -(defconst lsp--sync-incremental 2) - -(defcustom lsp-debounce-full-sync-notifications t - "If non-nil debounce full sync events. -This flag affects only servers which do not support incremental updates." - :type 'boolean - :group 'lsp-mode - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-debounce-full-sync-notifications-interval 1.0 - "Time to wait before sending full sync synchronization after buffer modification." - :type 'float - :group 'lsp-mode - :package-version '(lsp-mode . "6.1")) - -(defvar lsp--stderr-index 0) - -(defvar lsp--delayed-requests nil) -(defvar lsp--delay-timer nil) - -(defcustom lsp-document-sync-method nil - "How to sync the document with the language server." - :type '(choice (const :tag "Documents are synced by always sending the full content of the document." lsp--sync-full) - (const :tag "Documents are synced by always sending incremental changes to the document." lsp--sync-incremental) - (const :tag "Use the method recommended by the language server." nil)) - :group 'lsp-mode) - -(defcustom lsp-auto-execute-action t - "Auto-execute single action." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-enable-links t - "If non-nil, all references to links in a file will be made clickable, if -supported by the language server." - :type 'boolean - :group 'lsp-mode - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-enable-imenu t - "If non-nil, automatically enable `imenu' integration when server provides -`textDocument/documentSymbol'." - :type 'boolean - :group 'lsp-mode - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-enable-dap-auto-configure t - "If non-nil, enable `dap-auto-configure-mode`." - :type 'boolean - :group 'lsp-mode - :package-version '(lsp-mode . "7.0")) - -(defcustom lsp-eldoc-enable-hover t - "If non-nil, `eldoc' will display hover info when it is present." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-eldoc-render-all nil - "Display all of the info returned by document/onHover. -If this is set to nil, `eldoc' will show only the symbol information." - :type 'boolean - :group 'lsp-mode) - -(define-obsolete-variable-alias 'lsp-enable-completion-at-point - 'lsp-completion-enable "lsp-mode 7.0.1") - -(defcustom lsp-completion-enable t - "Enable `completion-at-point' integration." - :type 'boolean - :group 'lsp-completion) - -(defcustom lsp-enable-symbol-highlighting t - "Highlight references of the symbol at point." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-enable-xref t - "Enable xref integration." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-references-exclude-definition nil - "If non-nil, exclude declarations when finding references." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-enable-indentation t - "Indent regions using the file formatting functionality provided by the -language server." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-enable-on-type-formatting t - "Enable `textDocument/onTypeFormatting' integration." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-enable-text-document-color t - "Enable `textDocument/documentColor' integration." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-before-save-edits t - "If non-nil, `lsp-mode' will apply edits suggested by the language server -before saving a document." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-after-apply-edits-hook nil - "Hooks to run when text edit is applied. -It contains the operation source." - :type 'hook - :group 'lsp-mode - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-apply-edits-after-file-operations t - "Whether to apply edits returned by server after file operations if any. -Applicable only if server supports workspace.fileOperations for operations: -`workspace/willRenameFiles', `workspace/willCreateFiles' and -`workspace/willDeleteFiles'." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-modeline-code-actions-enable t - "Whether to show code actions on modeline." - :type 'boolean - :group 'lsp-modeline) - -(defcustom lsp-modeline-diagnostics-enable t - "Whether to show diagnostics on modeline." - :type 'boolean - :group 'lsp-modeline) - -(defcustom lsp-modeline-workspace-status-enable t - "Whether to show workspace status on modeline." - :type 'boolean - :group 'lsp-modeline - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-headerline-breadcrumb-enable t - "Whether to enable breadcrumb on headerline." - :type 'boolean - :group 'lsp-headerline) - -(defcustom lsp-configure-hook nil - "Hooks to run when `lsp-configure-buffer' is called." - :type 'hook - :group 'lsp-mode) - -(defcustom lsp-unconfigure-hook nil - "Hooks to run when `lsp-unconfig-buffer' is called." - :type 'hook - :group 'lsp-mode) - -(defcustom lsp-after-diagnostics-hook nil - "Hooks to run after diagnostics are received. -Note: it runs only if the receiving buffer is open. Use -`lsp-diagnostics-updated-hook'if you want to be notified when -diagnostics have changed." - :type 'hook - :group 'lsp-mode) - -(define-obsolete-variable-alias 'lsp-after-diagnostics-hook - 'lsp-diagnostics-updated-hook "lsp-mode 6.4") - -(defcustom lsp-diagnostics-updated-hook nil - "Hooks to run after diagnostics are received." - :type 'hook - :group 'lsp-mode) - -(define-obsolete-variable-alias 'lsp-workspace-folders-changed-hook - 'lsp-workspace-folders-changed-functions "lsp-mode 6.3") - -(defcustom lsp-workspace-folders-changed-functions nil - "Hooks to run after the folders has changed. -The hook will receive two parameters list of added and removed folders." - :type 'hook - :group 'lsp-mode) - -(define-obsolete-variable-alias 'lsp-eldoc-hook 'eldoc-documentation-functions "lsp-mode 9.0.0") - -(defcustom lsp-before-apply-edits-hook nil - "Hooks to run before applying edits." - :type 'hook - :group 'lsp-mode) - -(defgroup lsp-imenu nil - "LSP Imenu." - :group 'lsp-mode - :tag "LSP Imenu") - -(defcustom lsp-imenu-show-container-name t - "Display the symbol's container name in an imenu entry." - :type 'boolean - :group 'lsp-imenu) - -(defcustom lsp-imenu-container-name-separator "/" - "Separator string to use to separate the container name from the symbol while -displaying imenu entries." - :type 'string - :group 'lsp-imenu) - -(defcustom lsp-imenu-sort-methods '(kind name) - "How to sort the imenu items. - -The value is a list of `kind' `name' or `position'. Priorities -are determined by the index of the element." - :type '(repeat (choice (const name) - (const position) - (const kind))) - :group 'lsp-imenu) - -(defcustom lsp-imenu-index-symbol-kinds nil - "Which symbol kinds to show in imenu." - :type '(repeat (choice (const :tag "Miscellaneous" nil) - (const :tag "File" File) - (const :tag "Module" Module) - (const :tag "Namespace" Namespace) - (const :tag "Package" Package) - (const :tag "Class" Class) - (const :tag "Method" Method) - (const :tag "Property" Property) - (const :tag "Field" Field) - (const :tag "Constructor" Constructor) - (const :tag "Enum" Enum) - (const :tag "Interface" Interface) - (const :tag "Function" Function) - (const :tag "Variable" Variable) - (const :tag "Constant" Constant) - (const :tag "String" String) - (const :tag "Number" Number) - (const :tag "Boolean" Boolean) - (const :tag "Array" Array) - (const :tag "Object" Object) - (const :tag "Key" Key) - (const :tag "Null" Null) - (const :tag "Enum Member" EnumMember) - (const :tag "Struct" Struct) - (const :tag "Event" Event) - (const :tag "Operator" Operator) - (const :tag "Type Parameter" TypeParameter))) - :group 'lsp-imenu) - -;; vibhavp: Should we use a lower value (5)? -(defcustom lsp-response-timeout 10 - "Number of seconds to wait for a response from the language server before -timing out. Nil if no timeout." - :type '(choice - (number :tag "Seconds") - (const :tag "No timeout" nil)) - :group 'lsp-mode) - -(defcustom lsp-tcp-connection-timeout 2 - "The timeout for tcp connection in seconds." - :type 'number - :group 'lsp-mode - :package-version '(lsp-mode . "6.2")) - -(defconst lsp--imenu-compare-function-alist - (list (cons 'name #'lsp--imenu-compare-name) - (cons 'kind #'lsp--imenu-compare-kind) - (cons 'position #'lsp--imenu-compare-line-col)) - "An alist of (METHOD . FUNCTION). -METHOD is one of the symbols accepted by -`lsp-imenu-sort-methods'. - -FUNCTION takes two hash tables representing DocumentSymbol. It -returns a negative number, 0, or a positive number indicating -whether the first parameter is less than, equal to, or greater -than the second parameter.") - -(defcustom lsp-diagnostic-clean-after-change nil - "When non-nil, clean the diagnostics on change. - -Note that when that setting is nil, `lsp-mode' will show stale -diagnostics until server publishes the new set of diagnostics" - :type 'boolean - :group 'lsp-diagnostics - :package-version '(lsp-mode . "7.0.1")) - -(defcustom lsp-server-trace nil - "Request tracing on the server side. -The actual trace output at each level depends on the language server in use. -Changes take effect only when a new session is started." - :type '(choice (const :tag "Disabled" "off") - (const :tag "Messages only" "messages") - (const :tag "Verbose" "verbose") - (const :tag "Default (disabled)" nil)) - :group 'lsp-mode - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-auto-touch-files t - "If non-nil ensure the files exist before sending -`textDocument/didOpen' notification." - :type 'boolean - :group 'lsp-mode - :package-version '(lsp-mode . "9.0.0")) - -(defvar lsp-language-id-configuration - '(("\\(^CMakeLists\\.txt\\|\\.cmake\\)\\'" . "cmake") - ("\\(^Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'" . "dockerfile") - ("\\.astro$" . "astro") - ("\\.cs\\'" . "csharp") - ("\\.css$" . "css") - ("\\.cypher$" . "cypher") - ("Earthfile" . "earthfile") - ("\\.ebuild$" . "shellscript") - ("\\.go\\'" . "go") - ("\\.html$" . "html") - ("\\.hx$" . "haxe") - ("\\.hy$" . "hy") - ("\\.java\\'" . "java") - ("\\.jq$" . "jq") - ("\\.js$" . "javascript") - ("\\.json$" . "json") - ("\\.jsonc$" . "jsonc") - ("\\.jsonnet$" . "jsonnet") - ("\\.jsx$" . "javascriptreact") - ("\\.lua$" . "lua") - ("\\.fnl$" . "fennel") - ("\\.mdx\\'" . "mdx") - ("\\.nu$" . "nushell") - ("\\.php$" . "php") - ("\\.ps[dm]?1\\'" . "powershell") - ("\\.rs\\'" . "rust") - ("\\.spec\\'" . "rpm-spec") - ("\\.sql$" . "sql") - ("\\.svelte$" . "svelte") - ("\\.toml\\'" . "toml") - ("\\.ts$" . "typescript") - ("\\.tsp$" . "typespec") - ("\\.tsx$" . "typescriptreact") - ("\\.ttcn3$" . "ttcn3") - ("\\.vue$" . "vue") - ("\\.xml$" . "xml") - ("\\ya?ml$" . "yaml") - ("^PKGBUILD$" . "shellscript") - ("^go\\.mod\\'" . "go.mod") - ("^settings\\.json$" . "jsonc") - ("^yang\\.settings$" . "jsonc") - ("^meson\\(_options\\.txt\\|\\.\\(build\\|format\\)\\)\\'" . "meson") - (ada-mode . "ada") - (ada-ts-mode . "ada") - (gpr-mode . "gpr") - (gpr-ts-mode . "gpr") - (awk-mode . "awk") - (awk-ts-mode . "awk") - (nxml-mode . "xml") - (sql-mode . "sql") - (vimrc-mode . "vim") - (vimscript-ts-mode . "vim") - (sh-mode . "shellscript") - (bash-ts-mode . "shellscript") - (ebuild-mode . "shellscript") - (pkgbuild-mode . "shellscript") - (envrc-file-mode . "shellscript") - (scala-mode . "scala") - (scala-ts-mode . "scala") - (julia-mode . "julia") - (julia-ts-mode . "julia") - (clojure-mode . "clojure") - (clojurec-mode . "clojure") - (clojurescript-mode . "clojurescript") - (clojure-ts-mode . "clojure") - (clojure-ts-clojurec-mode . "clojure") - (clojure-ts-clojurescript-mode . "clojurescript") - (java-mode . "java") - (java-ts-mode . "java") - (jdee-mode . "java") - (groovy-mode . "groovy") - (nextflow-mode . "nextflow") - (python-mode . "python") - (python-ts-mode . "python") - (cython-mode . "python") - ("\\(\\.mojo\\|\\.🔥\\)\\'" . "mojo") - (lsp--render-markdown . "markdown") - (move-mode . "move") - (rust-mode . "rust") - (rust-ts-mode . "rust") - (rustic-mode . "rust") - (kotlin-mode . "kotlin") - (kotlin-ts-mode . "kotlin") - (css-mode . "css") - (css-ts-mode . "css") - (less-mode . "less") - (less-css-mode . "less") - (lua-mode . "lua") - (lua-ts-mode . "lua") - (sass-mode . "sass") - (ssass-mode . "sass") - (scss-mode . "scss") - (scad-mode . "openscad") - (xml-mode . "xml") - (c-mode . "c") - (c-ts-mode . "c") - (c++-mode . "cpp") - (c++-ts-mode . "cpp") - (cuda-mode . "cuda") - (objc-mode . "objective-c") - (html-mode . "html") - (html-ts-mode . "html") - (sgml-mode . "html") - (mhtml-mode . "html") - (mint-mode . "mint") - (go-dot-mod-mode . "go.mod") - (go-mod-ts-mode . "go.mod") - (go-mode . "go") - (go-ts-mode . "go") - (graphql-mode . "graphql") - (haskell-mode . "haskell") - (haskell-ts-mode . "haskell") - (hack-mode . "hack") - (php-mode . "php") - (php-ts-mode . "php") - (powershell-mode . "powershell") - (powershell-mode . "PowerShell") - (powershell-ts-mode . "powershell") - (json-mode . "json") - (json-ts-mode . "json") - (jsonc-mode . "jsonc") - (rjsx-mode . "javascript") - (js2-mode . "javascript") - (js-mode . "javascript") - (js-ts-mode . "javascript") - (typescript-mode . "typescript") - (typescript-ts-mode . "typescript") - (typespec-mode . "typespec") - (tsx-ts-mode . "typescriptreact") - (svelte-mode . "svelte") - (fsharp-mode . "fsharp") - (reason-mode . "reason") - (caml-mode . "ocaml") - (tuareg-mode . "ocaml") - (futhark-mode . "futhark") - (swift-mode . "swift") - (elixir-mode . "elixir") - (elixir-ts-mode . "elixir") - (heex-ts-mode . "elixir") - (conf-javaprop-mode . "spring-boot-properties") - (yaml-mode . "yaml") - (yaml-ts-mode . "yaml") - (ruby-mode . "ruby") - (enh-ruby-mode . "ruby") - (ruby-ts-mode . "ruby") - (feature-mode . "cucumber") - (fortran-mode . "fortran") - (f90-mode . "fortran") - (elm-mode . "elm") - (dart-mode . "dart") - (erlang-mode . "erlang") - (dockerfile-mode . "dockerfile") - (dockerfile-ts-mode . "dockerfile") - (csharp-mode . "csharp") - (csharp-tree-sitter-mode . "csharp") - (csharp-ts-mode . "csharp") - (plain-tex-mode . "plaintex") - (context-mode . "context") - (cypher-mode . "cypher") - (latex-mode . "latex") - (LaTeX-mode . "latex") - (v-mode . "v") - (vhdl-mode . "vhdl") - (vhdl-ts-mode . "vhdl") - (verilog-mode . "verilog") - (terraform-mode . "terraform") - (ess-julia-mode . "julia") - (ess-r-mode . "r") - (crystal-mode . "crystal") - (nim-mode . "nim") - (dhall-mode . "dhall") - (cmake-mode . "cmake") - (cmake-ts-mode . "cmake") - (purescript-mode . "purescript") - (gdscript-mode . "gdscript") - (gdscript-ts-mode . "gdscript") - (perl-mode . "perl") - (cperl-mode . "perl") - (robot-mode . "robot") - (racket-mode . "racket") - (nix-mode . "nix") - (nix-ts-mode . "nix") - (prolog-mode . "prolog") - (vala-mode . "vala") - (actionscript-mode . "actionscript") - (d-mode . "d") - (zig-mode . "zig") - (zig-ts-mode . "zig") - (text-mode . "plaintext") - (markdown-mode . "markdown") - (gfm-mode . "markdown") - (beancount-mode . "beancount") - (conf-toml-mode . "toml") - (toml-ts-mode . "toml") - (org-mode . "org") - (org-journal-mode . "org") - (nginx-mode . "nginx") - (magik-mode . "magik") - (magik-ts-mode . "magik") - (idris-mode . "idris") - (idris2-mode . "idris2") - (gleam-mode . "gleam") - (gleam-ts-mode . "gleam") - (graphviz-dot-mode . "dot") - (tiltfile-mode . "tiltfile") - (solidity-mode . "solidity") - (bibtex-mode . "bibtex") - (rst-mode . "restructuredtext") - (glsl-mode . "glsl") - (shader-mode . "shaderlab") - (wgsl-mode . "wgsl") - (jq-mode . "jq") - (jq-ts-mode . "jq") - (protobuf-mode . "protobuf") - (nushell-mode . "nushell") - (nushell-ts-mode . "nushell") - (meson-mode . "meson") - (yang-mode . "yang")) - "Language id configuration.") - -(defvar lsp--last-active-workspaces nil - "Keep track of last active workspace. -We want to try the last workspace first when jumping into a library -directory") - -(defvar lsp-method-requirements - '(("textDocument/callHierarchy" :capability :callHierarchyProvider) - ("textDocument/codeAction" :capability :codeActionProvider) - ("codeAction/resolve" - :check-command (lambda (workspace) - (with-lsp-workspace workspace - (lsp:code-action-options-resolve-provider? - (lsp--capability-for-method "textDocument/codeAction"))))) - ("textDocument/codeLens" :capability :codeLensProvider) - ("textDocument/completion" :capability :completionProvider) - ("completionItem/resolve" - :check-command (lambda (wk) - (with-lsp-workspace wk - (lsp:completion-options-resolve-provider? - (lsp--capability-for-method "textDocument/completion"))))) - ("textDocument/declaration" :capability :declarationProvider) - ("textDocument/definition" :capability :definitionProvider) - ("textDocument/documentColor" :capability :colorProvider) - ("textDocument/documentLink" :capability :documentLinkProvider) - ("textDocument/inlayHint" :capability :inlayHintProvider) - ("textDocument/documentHighlight" :capability :documentHighlightProvider) - ("textDocument/documentSymbol" :capability :documentSymbolProvider) - ("textDocument/foldingRange" :capability :foldingRangeProvider) - ("textDocument/formatting" :capability :documentFormattingProvider) - ("textDocument/hover" :capability :hoverProvider) - ("textDocument/implementation" :capability :implementationProvider) - ("textDocument/linkedEditingRange" :capability :linkedEditingRangeProvider) - ("textDocument/onTypeFormatting" :capability :documentOnTypeFormattingProvider) - ("textDocument/prepareRename" - :check-command (lambda (workspace) - (with-lsp-workspace workspace - (lsp:rename-options-prepare-provider? - (lsp--capability-for-method "textDocument/rename"))))) - ("textDocument/rangeFormatting" :capability :documentRangeFormattingProvider) - ("textDocument/references" :capability :referencesProvider) - ("textDocument/rename" :capability :renameProvider) - ("textDocument/selectionRange" :capability :selectionRangeProvider) - ("textDocument/semanticTokens" :capability :semanticTokensProvider) - ("textDocument/semanticTokensFull" - :check-command (lambda (workspace) - (with-lsp-workspace workspace - (lsp-get (lsp--capability :semanticTokensProvider) :full)))) - ("textDocument/semanticTokensFull/Delta" - :check-command (lambda (workspace) - (with-lsp-workspace workspace - (let ((capFull (lsp-get (lsp--capability :semanticTokensProvider) :full))) - (and (not (booleanp capFull)) (lsp-get capFull :delta)))))) - ("textDocument/semanticTokensRangeProvider" - :check-command (lambda (workspace) - (with-lsp-workspace workspace - (lsp-get (lsp--capability :semanticTokensProvider) :range)))) - ("textDocument/signatureHelp" :capability :signatureHelpProvider) - ("textDocument/typeDefinition" :capability :typeDefinitionProvider) - ("textDocument/typeHierarchy" :capability :typeHierarchyProvider) - ("textDocument/diagnostic" :capability :diagnosticProvider) - ("workspace/executeCommand" :capability :executeCommandProvider) - ("workspace/symbol" :capability :workspaceSymbolProvider)) - - "Map methods to requirements. -It is used by request-sending functions to determine which server -must be used for handling a particular message.") - -(defconst lsp--file-change-type - `((created . 1) - (changed . 2) - (deleted . 3))) - -(defconst lsp--watch-kind - `((create . 1) - (change . 2) - (delete . 4))) - -(defvar lsp-window-body-width 40 - "Window body width when rendering doc.") - -(defface lsp-face-highlight-textual - '((t :inherit highlight)) - "Face used for textual occurrences of symbols." - :group 'lsp-mode) - -(defface lsp-face-highlight-read - '((t :inherit highlight :underline t)) - "Face used for highlighting symbols being read." - :group 'lsp-mode) - -(defface lsp-face-highlight-write - '((t :inherit highlight :weight bold)) - "Face used for highlighting symbols being written to." - :group 'lsp-mode) - -(define-obsolete-variable-alias 'lsp-lens-auto-enable - 'lsp-lens-enable "lsp-mode 7.0.1") - -(defcustom lsp-lens-enable t - "Auto enable lenses if server supports." - :group 'lsp-lens - :type 'boolean - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-symbol-highlighting-skip-current nil - "If non-nil skip current symbol when setting symbol highlights." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-file-watch-threshold 1000 - "Show warning if the files to watch are more than. -Set to nil to disable the warning." - :type 'number - :group 'lsp-mode) -;;;###autoload(put 'lsp-file-watch-threshold 'safe-local-variable (lambda (i) (or (numberp i) (not i)))) - -(defvar lsp-custom-markup-modes - '((rust-mode "no_run" "rust,no_run" "rust,ignore" "rust,should_panic")) - "Mode to uses with markdown code blocks. -They are added to `markdown-code-lang-modes'") - -(defcustom lsp-signature-render-documentation t - "Display signature documentation in `eldoc'." - :type 'boolean - :group 'lsp-mode - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-signature-auto-activate '(:on-trigger-char :on-server-request) - "Auto activate signature conditions." - :type '(repeat (choice (const :tag "On trigger chars pressed." :on-trigger-char) - (const :tag "After selected completion." :after-completion) - (const :tag "When the server has sent show signature help." :on-server-request))) - :group 'lsp-mode - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-signature-doc-lines 20 - "If number, limit the number of lines to show in the docs." - :type 'number - :group 'lsp-mode - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-signature-function 'lsp-lv-message - "The function used for displaying signature info. -It will be called with one param - the signature info. When -called with nil the signature info must be cleared." - :type 'function - :group 'lsp-mode - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-keymap-prefix "s-l" - "LSP-mode keymap prefix." - :group 'lsp-mode - :type 'string - :package-version '(lsp-mode . "6.3")) - -(defvar-local lsp--buffer-workspaces () - "List of the buffer workspaces.") - -(defvar-local lsp--buffer-deferred nil - "Whether buffer was loaded via `lsp-deferred'.") - -(defvar lsp--session nil - "Contain the `lsp-session' for the current Emacs instance.") - -(defvar lsp--tcp-port 10000) - -(defvar lsp--client-packages-required nil - "If nil, `lsp-client-packages' are yet to be required.") - -(defvar lsp--tcp-server-port 0 - "The server socket which is opened when using `lsp-tcp-server' (a server -socket is opened in Emacs and the language server connects to it). The -default value of 0 ensures that a random high port is used. Set it to a positive -integer to use a specific port.") - -(defvar lsp--tcp-server-wait-seconds 10 - "Wait this amount of time for the client to connect to our server socket -when using `lsp-tcp-server'.") - -(defvar-local lsp--document-symbols nil - "The latest document symbols.") - -(defvar-local lsp--document-selection-range-cache nil - "The document selection cache.") - -(defvar-local lsp--document-symbols-request-async nil - "If non-nil, request document symbols asynchronously.") - -(defvar-local lsp--document-symbols-tick -1 - "The value of `buffer-chars-modified-tick' when document - symbols were last retrieved.") - -(defvar-local lsp--have-document-highlights nil - "Set to `t' on symbol highlighting, cleared on -`lsp--cleanup-highlights-if-needed'. Checking a separately -defined flag is substantially faster than unconditionally -calling `remove-overlays'.") - -;; Buffer local variable for storing number of lines. -(defvar lsp--log-lines) - -(defvar-local lsp--eldoc-saved-message nil) - -(defvar lsp--on-change-timer nil) -(defvar lsp--on-idle-timer nil) - -(defvar-local lsp--signature-last nil) -(defvar-local lsp--signature-last-index nil) -(defvar lsp--signature-last-buffer nil) - -(defvar-local lsp--virtual-buffer-point-max nil) - -(cl-defmethod lsp-execute-command (_server _command _arguments) - "Ask SERVER to execute COMMAND with ARGUMENTS.") - -(defun lsp-elt (sequence n) - "Return Nth element of SEQUENCE or nil if N is out of range." - (cond - ((listp sequence) (elt sequence n)) - ((arrayp sequence) - (and (> (length sequence) n) (aref sequence n))) - (t (and (> (length sequence) n) (elt sequence n))))) - -;; define seq-first and seq-rest for older emacs -(defun lsp-seq-first (sequence) - "Return the first element of SEQUENCE." - (lsp-elt sequence 0)) - -(defun lsp-seq-rest (sequence) - "Return a sequence of the elements of SEQUENCE except the first one." - (seq-drop sequence 1)) - -;;;###autoload -(defun lsp--string-listp (sequence) - "Return t if all elements of SEQUENCE are strings, else nil." - (not (seq-find (lambda (x) (not (stringp x))) sequence))) - -(defun lsp--string-vector-p (candidate) - "Returns true if CANDIDATE is a vector data structure and -every element of it is of type string, else nil." - (and - (vectorp candidate) - (seq-every-p #'stringp candidate))) - -(make-obsolete 'lsp--string-vector-p nil "lsp-mode 8.0.0") - -(defun lsp--editable-vector-match (widget value) - "Function for `lsp-editable-vector' :match." - ;; Value must be a list or a vector and all the members must match the type. - (and (or (listp value) (vectorp value)) - (length (cdr (lsp--editable-vector-match-inline widget value))))) - -(defun lsp--editable-vector-match-inline (widget value) - "Value for `lsp-editable-vector' :match-inline." - (let ((type (nth 0 (widget-get widget :args))) - (ok t) - found) - (while (and value ok) - (let ((answer (widget-match-inline type value))) - (if answer - (let ((head (if (vectorp answer) (aref answer 0) (car answer))) - (tail (if (vectorp answer) (seq-drop 1 answer) (cdr answer)))) - (setq found (append found head) - value tail)) - (setq ok nil)))) - (cons found value))) - -(defun lsp--editable-vector-value-to-external (_widget internal-value) - "Convert the internal list value to a vector." - (if (listp internal-value) - (apply 'vector internal-value) - internal-value)) - -(defun lsp--editable-vector-value-to-internal (_widget external-value) - "Convert the external vector value to a list." - (if (vectorp external-value) - (append external-value nil) - external-value)) - -(define-widget 'lsp--editable-vector 'editable-list - "A subclass of `editable-list' that accepts and returns a -vector instead of a list." - :value-to-external 'lsp--editable-vector-value-to-external - :value-to-internal 'lsp--editable-vector-value-to-internal - :match 'lsp--editable-vector-match - :match-inline 'lsp--editable-vector-match-inline) - -(define-widget 'lsp-repeatable-vector 'lsp--editable-vector - "A variable length homogeneous vector." - :tag "Repeat" - :format "%{%t%}:\n%v%i\n") - -(define-widget 'lsp-string-vector 'lazy - "A vector of zero or more elements, every element of which is a string. -Appropriate for any language-specific `defcustom' that needs to -serialize as a JSON array of strings. - -Deprecated. Use `lsp-repeatable-vector' instead. " - :offset 4 - :tag "Vector" - :type '(lsp-repeatable-vector string)) - -(make-obsolete 'lsp-string-vector nil "lsp-mode 8.0.0") - -(defvar lsp--show-message t - "If non-nil, show debug message from `lsp-mode'.") - -(defun lsp--message (format &rest args) - "Wrapper for `message' - -We `inhibit-message' the message when the cursor is in the -minibuffer and when emacs version is before emacs 27 due to the -fact that we often use `lsp--info', `lsp--warn' and `lsp--error' -in async context and the call to these function is removing the -minibuffer prompt. The issue with async messages is already fixed -in emacs 27. - -See #2049" - (when lsp--show-message - (let ((inhibit-message (or inhibit-message - (and (minibufferp) - (version< emacs-version "27.0"))))) - (apply #'message format args)))) - -(defun lsp--info (format &rest args) - "Display lsp info message with FORMAT with ARGS." - (lsp--message "%s :: %s" (propertize "LSP" 'face 'success) (apply #'format format args))) - -(defun lsp--warn (format &rest args) - "Display lsp warn message with FORMAT with ARGS." - (lsp--message "%s :: %s" (propertize "LSP" 'face 'warning) (apply #'format format args))) - -(defun lsp--error (format &rest args) - "Display lsp error message with FORMAT with ARGS." - (lsp--message "%s :: %s" (propertize "LSP" 'face 'error) (apply #'format format args))) - -(defun lsp-log (format &rest args) - "Log message to the ’*lsp-log*’ buffer. - -FORMAT and ARGS i the same as for `message'." - (when lsp-log-max - (let ((log-buffer (get-buffer "*lsp-log*")) - (inhibit-read-only t)) - (unless log-buffer - (setq log-buffer (get-buffer-create "*lsp-log*")) - (with-current-buffer log-buffer - (buffer-disable-undo) - (view-mode 1) - (set (make-local-variable 'lsp--log-lines) 0))) - (with-current-buffer log-buffer - (save-excursion - (let* ((message (apply 'format format args)) - ;; Count newlines in message. - (newlines (1+ (cl-loop with start = 0 - for count from 0 - while (string-match "\n" message start) - do (setq start (match-end 0)) - finally return count)))) - (goto-char (point-max)) - - ;; in case the buffer is not empty insert before last \n to preserve - ;; the point position(in case it is in the end) - (if (eq (point) (point-min)) - (progn - (insert "\n") - (backward-char)) - (backward-char) - (insert "\n")) - (insert message) - - (setq lsp--log-lines (+ lsp--log-lines newlines)) - - (when (and (integerp lsp-log-max) (> lsp--log-lines lsp-log-max)) - (let ((to-delete (- lsp--log-lines lsp-log-max))) - (goto-char (point-min)) - (forward-line to-delete) - (delete-region (point-min) (point)) - (setq lsp--log-lines lsp-log-max))))))))) - -(defalias 'lsp-message 'lsp-log) - -(defalias 'lsp-ht 'ht) - -(defalias 'lsp-file-local-name 'file-local-name) - -(defun lsp-f-canonical (file-name) - "Return the canonical FILE-NAME, without a trailing slash." - (directory-file-name (expand-file-name file-name))) - -(defalias 'lsp-canonical-file-name 'lsp-f-canonical) - -(defun lsp-f-same? (path-a path-b) - "Return t if PATH-A and PATH-B are references to the same file. -Symlinks are not followed." - (when (and (f-exists? path-a) - (f-exists? path-b)) - (equal - (lsp-f-canonical (directory-file-name (f-expand path-a))) - (lsp-f-canonical (directory-file-name (f-expand path-b)))))) - -(defun lsp-f-parent (path) - "Return the parent directory to PATH. -Symlinks are not followed." - (let ((parent (file-name-directory - (directory-file-name (f-expand path default-directory))))) - (unless (lsp-f-same? path parent) - (if (f-relative? path) - (f-relative parent) - (directory-file-name parent))))) - -(defun lsp-f-ancestor-of? (path-a path-b) - "Return t if PATH-A is an ancestor of PATH-B. -Symlinks are not followed." - (unless (lsp-f-same? path-a path-b) - (s-prefix? (concat (lsp-f-canonical path-a) (f-path-separator)) - (lsp-f-canonical path-b)))) - -(defun lsp--merge-results (results method) - "Merge RESULTS by filtering the empty hash-tables and merging -the lists according to METHOD." - (pcase (--map (if (vectorp it) - (append it nil) it) - (-filter #'identity results)) - (`() ()) - ;; only one result - simply return it - (`(,fst) fst) - ;; multiple results merge it based on strategy - (results - (pcase method - ("textDocument/hover" (pcase (seq-filter - (-compose #'not #'lsp-empty?) - results) - (`(,hover) hover) - (hovers (lsp-make-hover - :contents - (-mapcat - (-lambda ((&Hover :contents)) - (if (and (sequencep contents) - (not (stringp contents))) - (append contents ()) - (list contents))) - hovers))))) - ("textDocument/completion" - (lsp-make-completion-list - :is-incomplete (seq-some - #'lsp:completion-list-is-incomplete - results) - :items (cl-mapcan (lambda (it) (append (if (lsp-completion-list? it) - (lsp:completion-list-items it) - it) - nil)) - results))) - ("completionItem/resolve" - (let ((item (cl-first results))) - (when-let ((details (seq-filter #'identity - (seq-map #'lsp:completion-item-detail? results)))) - (lsp:set-completion-item-detail? - item - (string-join details " "))) - (when-let ((docs (seq-filter #'identity - (seq-map #'lsp:completion-item-documentation? results)))) - (lsp:set-completion-item-documentation? - item - (lsp-make-markup-content - :kind (or (seq-some (lambda (it) - (when (equal (lsp:markup-content-kind it) - lsp/markup-kind-markdown) - lsp/markup-kind-markdown)) - docs) - lsp/markup-kind-plain-text) - :value (string-join (seq-map (lambda (doc) - (or (lsp:markup-content-value doc) - (and (stringp doc) doc))) - docs) - "\n")))) - (when-let ((edits (seq-filter #'identity - (seq-map #'lsp:completion-item-additional-text-edits? results)))) - (lsp:set-completion-item-additional-text-edits? - item - (cl-mapcan (lambda (it) (if (seqp it) it (list it))) edits))) - item)) - (_ (cl-mapcan (lambda (it) (if (seqp it) it (list it))) results)))))) - -(defun lsp--spinner-start () - "Start spinner indication." - (condition-case _err (spinner-start (lsp-progress-spinner-type)) (error))) - -(defun lsp--propertize (str type) - "Propertize STR as per TYPE." - (propertize str 'face (alist-get type lsp--message-type-face))) - -(defun lsp-workspaces () - "Return the lsp workspaces associated with the current project." - (if lsp--cur-workspace (list lsp--cur-workspace) lsp--buffer-workspaces)) - -(defun lsp--completing-read (prompt collection transform-fn &optional predicate - require-match initial-input - hist def inherit-input-method) - "Wrap `completing-read' to provide transformation function and disable sort. - -TRANSFORM-FN will be used to transform each of the items before displaying. - -PROMPT COLLECTION PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF -INHERIT-INPUT-METHOD will be proxied to `completing-read' without changes." - (let* ((col (--map (cons (funcall transform-fn it) it) collection)) - (completion (completing-read prompt - (lambda (string pred action) - (if (eq action 'metadata) - `(metadata (display-sort-function . identity)) - (complete-with-action action col string pred))) - predicate require-match initial-input hist - def inherit-input-method))) - (cdr (assoc completion col)))) - -(defconst lsp--system-arch (lambda () - (setq lsp--system-arch - (pcase system-type - ('windows-nt - (pcase system-configuration - ((rx bol "x86_64-") 'x64) - (_ 'x86))) - ('darwin - (pcase system-configuration - ((rx "aarch64-") 'arm64) - (_ 'x64))) - ('gnu/linux - (pcase system-configuration - ((rx bol "aarch64-") 'arm64) - ((rx bol "x86_64") 'x64) - ((rx bol (| "i386" "i886")) 'x32))) - (_ - (pcase system-configuration - ((rx bol "x86_64") 'x64) - ((rx bol (| "i386" "i886")) 'x32)))))) - "Return the system architecture of `Emacs'. -Special values: - `x64' 64bit - `x32' 32bit - `arm64' ARM 64bit") - -(defmacro lsp-with-current-buffer (buffer-id &rest body) - (declare (indent 1) (debug t)) - `(if-let ((wcb (plist-get ,buffer-id :with-current-buffer))) - (with-lsp-workspaces (plist-get ,buffer-id :workspaces) - (funcall wcb (lambda () ,@body))) - (with-current-buffer ,buffer-id - ,@body))) - -(defvar lsp--throw-on-input nil - "Make `lsp-*-while-no-input' throws `input' on interrupted.") - -(defmacro lsp--catch (tag bodyform &rest handlers) - "Catch TAG thrown in BODYFORM. -The return value from TAG will be handled in HANDLERS by `pcase'." - (declare (debug (form form &rest (pcase-PAT body))) (indent 2)) - (let ((re-sym (make-symbol "re"))) - `(let ((,re-sym (catch ,tag ,bodyform))) - (pcase ,re-sym - ,@handlers)))) - -(defmacro lsp--while-no-input (&rest body) - "Wrap BODY in `while-no-input' and respecting `non-essential'. -If `lsp--throw-on-input' is set, will throw if input is pending, else -return value of `body' or nil if interrupted." - (declare (debug t) (indent 0)) - `(if non-essential - (let ((res (while-no-input ,@body))) - (cond - ((and lsp--throw-on-input (equal res t)) - (throw 'input :interrupted)) - ((booleanp res) nil) - (t res))) - ,@body)) - -;; A ‘lsp--client’ object describes the client-side behavior of a language -;; server. It is used to start individual server processes, each of which is -;; represented by a ‘lsp--workspace’ object. Client objects are normally -;; created using ‘lsp-define-stdio-client’ or ‘lsp-define-tcp-client’. Each -;; workspace refers to exactly one client, but there can be multiple workspaces -;; for a single client. -(cl-defstruct lsp--client - ;; ‘language-id’ is a function that receives a buffer as a single argument - ;; and should return the language identifier for that buffer. See - ;; https://microsoft.github.io/language-server-protocol/specification#textdocumentitem - ;; for a list of language identifiers. Also consult the documentation for - ;; the language server represented by this client to find out what language - ;; identifiers it supports or expects. - (language-id nil) - - ;; ‘add-on?’ when set to t the server will be started no matter whether there - ;; is another server handling the same mode. - (add-on? nil) - ;; ‘new-connection’ is a function that should start a language server process - ;; and return a cons (COMMAND-PROCESS . COMMUNICATION-PROCESS). - ;; COMMAND-PROCESS must be a process object representing the server process - ;; just started. COMMUNICATION-PROCESS must be a process (including pipe and - ;; network processes) that ‘lsp-mode’ uses to communicate with the language - ;; server using the language server protocol. COMMAND-PROCESS and - ;; COMMUNICATION-PROCESS may be the same process; in that case - ;; ‘new-connection’ may also return that process as a single - ;; object. ‘new-connection’ is called with two arguments, FILTER and - ;; SENTINEL. FILTER should be used as process filter for - ;; COMMUNICATION-PROCESS, and SENTINEL should be used as process sentinel for - ;; COMMAND-PROCESS. - (new-connection nil) - - ;; ‘ignore-regexps’ is a list of regexps. When a data packet from the - ;; language server matches any of these regexps, it will be ignored. This is - ;; intended for dealing with language servers that output non-protocol data. - (ignore-regexps nil) - - ;; ‘ignore-messages’ is a list of regexps. When a message from the language - ;; server matches any of these regexps, it will be ignored. This is useful - ;; for filtering out unwanted messages; such as servers that send nonstandard - ;; message types, or extraneous log messages. - (ignore-messages nil) - - ;; ‘notification-handlers’ is a hash table mapping notification method names - ;; (strings) to functions handling the respective notifications. Upon - ;; receiving a notification, ‘lsp-mode’ will call the associated handler - ;; function passing two arguments, the ‘lsp--workspace’ object and the - ;; deserialized notification parameters. - (notification-handlers (make-hash-table :test 'equal)) - - ;; ‘request-handlers’ is a hash table mapping request method names - ;; (strings) to functions handling the respective notifications. Upon - ;; receiving a request, ‘lsp-mode’ will call the associated handler function - ;; passing two arguments, the ‘lsp--workspace’ object and the deserialized - ;; request parameters. - (request-handlers (make-hash-table :test 'equal)) - - ;; ‘response-handlers’ is a hash table mapping integral JSON-RPC request - ;; identifiers for pending asynchronous requests to functions handling the - ;; respective responses. Upon receiving a response from the language server, - ;; ‘lsp-mode’ will call the associated response handler function with a - ;; single argument, the deserialized response parameters. - (response-handlers (make-hash-table :test 'eql)) - - ;; ‘prefix-function’ is called for getting the prefix for completion. - ;; The function takes no parameter and returns a cons (start . end) representing - ;; the start and end bounds of the prefix. If it's not set, the client uses a - ;; default prefix function." - (prefix-function nil) - - ;; Contains mapping of scheme to the function that is going to be used to load - ;; the file. - (uri-handlers (make-hash-table :test #'equal)) - - ;; ‘action-handlers’ is a hash table mapping action to a handler function. It - ;; can be used in `lsp-execute-code-action' to determine whether the action - ;; current client is interested in executing the action instead of sending it - ;; to the server. - (action-handlers (make-hash-table :test 'equal)) - - ;; `action-filter' can be set to a function that modifies any incoming - ;; `CodeAction' in place before it is executed. The return value is ignored. - ;; This can be used to patch up broken code action requests before they are - ;; sent back to the LSP server. See `lsp-fix-code-action-booleans' for an - ;; example of a function that can be useful here. - (action-filter nil) - - ;; major modes supported by the client. - major-modes - ;; Function that will be called to decide if this language client - ;; should manage a particular buffer. The function will be passed - ;; the file name and major mode to inform the decision. Setting - ;; `activation-fn' will override `major-modes', if - ;; present. - activation-fn - ;; Break the tie when major-mode is supported by multiple clients. - (priority 0) - ;; Unique identifier for representing the client object. - server-id - ;; defines whether the client supports multi root workspaces. - multi-root - ;; Initialization options or a function that returns initialization options. - initialization-options - ;; `semantic-tokens-faces-overrides’ is a plist that can be used to extend, or - ;; completely replace, the faces used for semantic highlighting on a - ;; client-by-client basis. - ;; - ;; It recognizes four members, all of which are optional: `:types’ and - ;; `:modifiers’, respectively, should be face definition lists akin to - ;; `:lsp-semantic-token-faces’. If specified, each of these face lists will be - ;; merged with the default face definition list. - ;; - ;; Alternatively, if the plist members `:discard-default-types’ or - ;; `:discard-default-modifiers' are non-nil, the default `:type' or `:modifiers' - ;; face definitions will be replaced entirely by their respective overrides. - ;; - ;; For example, setting `:semantic-tokens-faces-overrides' to - ;; `(:types (("macro" . font-lock-keyword-face)))' will remap "macro" tokens from - ;; their default face `lsp-face-semhl-macro' to `font-lock-keyword-face'. - ;; - ;; `(:types (("macro" . font-lock-keyword-face) ("not-quite-a-macro" . some-face)))' - ;; will also remap "macro", but on top of that associate the fictional token type - ;; "not-quite-a-macro" with the face named `some-face'. - ;; - ;; `(:types (("macro" . font-lock-keyword-face)) - ;; :modifiers (("declaration" . lsp-face-semhl-interface)) - ;; :discard-default-types t - ;; :discard-default-modifiers t)' - ;; will discard all default face definitions, hence leaving the client with - ;; only one token type "macro", mapped to `font-lock-keyword-face', and one - ;; modifier type "declaration", mapped to `lsp-face-semhl-interface'. - semantic-tokens-faces-overrides - ;; Provides support for registering LSP Server specific capabilities. - custom-capabilities - ;; Function which returns the folders that are considered to be not projects but library files. - ;; The function accepts one parameter currently active workspace. - ;; See: https://github.com/emacs-lsp/lsp-mode/issues/225. - library-folders-fn - ;; function which will be called when opening file in the workspace to perform - ;; client specific initialization. The function accepts one parameter - ;; currently active workspace. - before-file-open-fn - ;; Function which will be called right after a workspace has been initialized. - initialized-fn - ;; ‘remote?’ indicate whether the client can be used for LSP server over TRAMP. - (remote? nil) - - ;; ‘completion-in-comments?’ t if the client supports completion in comments. - (completion-in-comments? nil) - - ;; ‘path->uri-fn’ the function to use for path->uri conversion for the client. - (path->uri-fn nil) - - ;; ‘uri->path-fn’ the function to use for uri->path conversion for the client. - (uri->path-fn nil) - ;; Function that returns an environment structure that will be used - ;; to set some environment variables when starting the language - ;; server process. These environment variables enable some - ;; additional features in the language server. The environment - ;; structure is an alist of the form (KEY . VALUE), where KEY is a - ;; string (regularly in all caps), and VALUE may be a string, a - ;; boolean, or a sequence of strings. - environment-fn - - ;; ‘after-open-fn’ workspace after open specific hooks. - (after-open-fn nil) - - ;; ‘async-request-handlers’ is a hash table mapping request method names - ;; (strings) to functions handling the respective requests that may take - ;; time to finish. Upon receiving a request, ‘lsp-mode’ will call the - ;; associated handler function passing three arguments, the ‘lsp--workspace’ - ;; object, the deserialized request parameters and the callback which accept - ;; result as its parameter. - (async-request-handlers (make-hash-table :test 'equal)) - download-server-fn - download-in-progress? - buffers - synchronize-sections) - -(defun lsp-clients-executable-find (find-command &rest args) - "Finds an executable by invoking a search command. - -FIND-COMMAND is the executable finder that searches for the -actual language server executable. ARGS is a list of arguments to -give to FIND-COMMAND to find the language server. Returns the -output of FIND-COMMAND if it exits successfully, nil otherwise. - -Typical uses include finding an executable by invoking `find' in -a project, finding LLVM commands on macOS with `xcrun', or -looking up project-specific language servers for projects written -in the various dynamic languages, e.g. `nvm', `pyenv' and `rbenv' -etc." - (when-let* ((find-command-path (executable-find find-command)) - (executable-path - (with-temp-buffer - (when (zerop (apply 'call-process find-command-path nil t nil args)) - (buffer-substring-no-properties (point-min) (point-max)))))) - (string-trim executable-path))) - -(defvar lsp--already-widened nil) - -(defmacro lsp-save-restriction-and-excursion (&rest form) - (declare (indent 0) (debug t)) - `(if lsp--already-widened - (save-excursion ,@form) - (-let [lsp--already-widened t] - (save-restriction - (widen) - (save-excursion ,@form))))) - -;; from http://emacs.stackexchange.com/questions/8082/how-to-get-buffer-position-given-line-number-and-column-number -(defun lsp--line-character-to-point (line character) - "Return the point for character CHARACTER on line LINE." - (or (lsp-virtual-buffer-call :line/character->point line character) - (let ((inhibit-field-text-motion t)) - (lsp-save-restriction-and-excursion - (goto-char (point-min)) - (forward-line line) - ;; server may send character position beyond the current line and we - ;; should fallback to line end. - (-let [line-end (line-end-position)] - (if (> character (- line-end (point))) - line-end - (forward-char character) - (point))))))) - -(lsp-defun lsp--position-to-point ((&Position :line :character)) - "Convert `Position' object in PARAMS to a point." - (lsp--line-character-to-point line character)) - -(lsp-defun lsp--range-to-region ((&RangeToPoint :start :end)) - (cons start end)) - -(lsp-defun lsp--range-text ((&RangeToPoint :start :end)) - (buffer-substring start end)) - -(lsp-defun lsp--find-wrapping-range ((&SelectionRange :parent? :range (&RangeToPoint :start :end))) - (cond - ((and - (region-active-p) - (<= start (region-beginning) end) - (<= start (region-end) end) - (or (not (= start (region-beginning))) - (not (= end (region-end))))) - (cons start end)) - ((and (<= start (point) end) - (not (region-active-p))) - (cons start end)) - (parent? (lsp--find-wrapping-range parent?)))) - -(defun lsp--get-selection-range () - (or - (-when-let ((cache . cache-tick) lsp--document-selection-range-cache) - (when (= cache-tick (buffer-modified-tick)) cache)) - (let ((response (cl-first - (lsp-request - "textDocument/selectionRange" - (list :textDocument (lsp--text-document-identifier) - :positions (vector (lsp--cur-position))))))) - (setq lsp--document-selection-range-cache - (cons response (buffer-modified-tick))) - response))) - -(defun lsp-extend-selection () - "Extend selection." - (interactive) - (unless (lsp-feature? "textDocument/selectionRange") - (signal 'lsp-capability-not-supported (list "selectionRangeProvider"))) - (-when-let ((start . end) (lsp--find-wrapping-range (lsp--get-selection-range))) - (goto-char start) - (set-mark (point)) - (goto-char end) - (exchange-point-and-mark))) - -(defun lsp-warn (message &rest args) - "Display a warning message made from (`format-message' MESSAGE ARGS...). -This is equivalent to `display-warning', using `lsp-mode' as the type and -`:warning' as the level." - (display-warning 'lsp-mode (apply #'format-message message args))) - -(defun lsp--get-uri-handler (scheme) - "Get uri handler for SCHEME in the current workspace." - (--some (gethash scheme (lsp--client-uri-handlers (lsp--workspace-client it))) - (or (lsp-workspaces) (lsp--session-workspaces (lsp-session))))) - -(defun lsp--fix-path-casing (path) - "On windows, downcases path because the windows file system is -case-insensitive. - -On other systems, returns path without change." - (if (eq system-type 'windows-nt) (downcase path) path)) - -(defun lsp--uri-to-path (uri) - "Convert URI to a file path." - (if-let ((fn (->> (lsp-workspaces) - (-keep (-compose #'lsp--client-uri->path-fn #'lsp--workspace-client)) - (cl-first)))) - (funcall fn uri) - (lsp--uri-to-path-1 uri))) - -(defun lsp-remap-path-if-needed (file-name) - (-if-let ((virtual-buffer &as &plist :buffer) (gethash file-name lsp--virtual-buffer-mappings)) - (propertize (buffer-local-value 'buffer-file-name buffer) - 'lsp-virtual-buffer virtual-buffer) - file-name)) - -(defun lsp--uri-to-path-1 (uri) - "Convert URI to a file path." - (let* ((url (url-generic-parse-url (url-unhex-string uri))) - (type (url-type url)) - (target (url-target url)) - (file - (concat (decode-coding-string (url-filename url) - (or locale-coding-system 'utf-8)) - (when (and target - (not (s-match - (rx "#" (group (1+ num)) (or "," "#") - (group (1+ num)) - string-end) - uri))) - (concat "#" target)))) - (file-name (if (and type (not (string= type "file"))) - (if-let ((handler (lsp--get-uri-handler type))) - (funcall handler uri) - uri) - ;; `url-generic-parse-url' is buggy on windows: - ;; https://github.com/emacs-lsp/lsp-mode/pull/265 - (or (and (eq system-type 'windows-nt) - (eq (elt file 0) ?\/) - (substring file 1)) - file)))) - (->> file-name - (concat (-some #'lsp--workspace-host-root (lsp-workspaces))) - (lsp-remap-path-if-needed)))) - -(defun lsp--buffer-uri () - "Return URI of the current buffer." - (or lsp-buffer-uri - (plist-get lsp--virtual-buffer :buffer-uri) - (lsp--path-to-uri - (or (buffer-file-name) (buffer-file-name (buffer-base-buffer)))))) - -(defun lsp-register-client-capabilities (&rest _args) - "Implemented only to make `company-lsp' happy. -DELETE when `lsp-mode.el' is deleted.") - -(defconst lsp--url-path-allowed-chars - (url--allowed-chars (append '(?/) url-unreserved-chars)) - "`url-unreserved-chars' with additional delim ?/. -This set of allowed chars is enough for hexifying local file paths.") - -(defun lsp--path-to-uri-1 (path) - (concat lsp--uri-file-prefix - (--> path - (expand-file-name it) - (or (file-remote-p it 'localname t) it) - (url-hexify-string it lsp--url-path-allowed-chars)))) - -(defun lsp--path-to-uri (path) - "Convert PATH to a uri." - (if-let ((uri-fn (->> (lsp-workspaces) - (-keep (-compose #'lsp--client-path->uri-fn #'lsp--workspace-client)) - (cl-first)))) - (funcall uri-fn path) - (lsp--path-to-uri-1 path))) - -(defun lsp--string-match-any (regex-list str) - "Return the first regex, if any, within REGEX-LIST matching STR." - (--first (string-match it str) regex-list)) - -(cl-defstruct lsp-watch - (descriptors (make-hash-table :test 'equal)) - root-directory) - -(defun lsp--folder-watch-callback (event callback watch ignored-files ignored-directories) - (let ((file-name (cl-third event)) - (event-type (cl-second event))) - (cond - ((and (file-directory-p file-name) - (equal 'created event-type) - (not (lsp--string-match-any ignored-directories file-name))) - - (lsp-watch-root-folder (file-truename file-name) callback ignored-files ignored-directories watch) - - ;; process the files that are already present in - ;; the directory. - (->> (directory-files-recursively file-name ".*" t) - (seq-do (lambda (f) - (unless (file-directory-p f) - (funcall callback (list nil 'created f))))))) - ((and (memq event-type '(created deleted changed)) - (not (file-directory-p file-name)) - (not (lsp--string-match-any ignored-files file-name))) - (funcall callback event)) - ((and (memq event-type '(renamed)) - (not (file-directory-p file-name)) - (not (lsp--string-match-any ignored-files file-name))) - (funcall callback `(,(cl-first event) deleted ,(cl-third event))) - (funcall callback `(,(cl-first event) created ,(cl-fourth event))))))) - -(defun lsp--ask-about-watching-big-repo (number-of-directories dir) - "Ask the user if they want to watch NUMBER-OF-DIRECTORIES from a repository DIR. -This is useful when there is a lot of files in a repository, as -that may slow Emacs down. Returns t if the user wants to watch -the entire repository, nil otherwise." - (prog1 - (yes-or-no-p - (format - "Watching all the files in %s would require adding watches to %s directories, so watching the repo may slow Emacs down. -Do you want to watch all files in %s? " - dir - number-of-directories - dir)) - (lsp--info - (concat "You can configure this warning with the `lsp-enable-file-watchers' " - "and `lsp-file-watch-threshold' variables")))) - - -(defun lsp--path-is-watchable-directory (path dir ignored-directories) - "Figure out whether PATH (inside of DIR) is meant to have a file watcher set. -IGNORED-DIRECTORIES is a list of regexes to filter out directories we don't -want to watch." - (let - ((full-path (f-join dir path))) - (and (file-accessible-directory-p full-path) - (not (equal path ".")) - (not (equal path "..")) - (not (lsp--string-match-any ignored-directories full-path))))) - - -(defun lsp--all-watchable-directories (dir ignored-directories &optional visited) - "Traverse DIR recursively returning a list of paths that should have watchers. -IGNORED-DIRECTORIES will be used for exclusions. -VISITED is used to track already-visited directories to avoid infinite loops." - (let* ((dir (if (f-symlink? dir) - (file-truename dir) - dir)) - ;; Initialize visited directories if not provided - (visited (or visited (make-hash-table :test 'equal)))) - (if (gethash dir visited) - ;; If the directory has already been visited, skip it - nil - ;; Mark the current directory as visited - (puthash dir t visited) - (apply #'nconc - ;; the directory itself is assumed to be part of the set - (list dir) - ;; collect all subdirectories that are watchable - (-map - (lambda (path) (lsp--all-watchable-directories (f-join dir path) ignored-directories visited)) - ;; but only look at subdirectories that are watchable - (-filter (lambda (path) (lsp--path-is-watchable-directory path dir ignored-directories)) - (directory-files dir))))))) - -(defun lsp-watch-root-folder (dir callback ignored-files ignored-directories &optional watch warn-big-repo?) - "Create recursive file notification watch in DIR. -CALLBACK will be called when there are changes in any of -the monitored files. WATCHES is a hash table directory->file -notification handle which contains all of the watch that -already have been created. Watches will not be created for -any directory that matches any regex in IGNORED-DIRECTORIES. -Watches will not be created for any file that matches any -regex in IGNORED-FILES." - (let* ((dir (if (f-symlink? dir) - (file-truename dir) - dir)) - (watch (or watch (make-lsp-watch :root-directory dir))) - (dirs-to-watch (lsp--all-watchable-directories dir ignored-directories))) - (lsp-log "Creating watchers for following %s folders:\n %s" - (length dirs-to-watch) - (s-join "\n " dirs-to-watch)) - (when (or - (not warn-big-repo?) - (not lsp-file-watch-threshold) - (let ((number-of-directories (length dirs-to-watch))) - (or - (< number-of-directories lsp-file-watch-threshold) - (condition-case nil - (lsp--ask-about-watching-big-repo number-of-directories dir) - (quit))))) - (dolist (current-dir dirs-to-watch) - (condition-case err - (progn - (puthash - current-dir - (file-notify-add-watch current-dir - '(change) - (lambda (event) - (lsp--folder-watch-callback event callback watch ignored-files ignored-directories))) - (lsp-watch-descriptors watch))) - (error (lsp-log "Failed to create a watch for %s: message" (error-message-string err))) - (file-missing (lsp-log "Failed to create a watch for %s: message" (error-message-string err)))))) - watch)) - -(defun lsp-kill-watch (watch) - "Delete WATCH." - (-> watch lsp-watch-descriptors hash-table-values (-each #'file-notify-rm-watch)) - (ht-clear! (lsp-watch-descriptors watch))) - -(defun lsp-json-bool (val) - "Convert VAL to JSON boolean." - (if val t :json-false)) - -(defmacro with-lsp-workspace (workspace &rest body) - "Helper macro for invoking BODY in WORKSPACE context." - (declare (debug (form body)) - (indent 1)) - `(let ((lsp--cur-workspace ,workspace)) ,@body)) - -(defmacro with-lsp-workspaces (workspaces &rest body) - "Helper macro for invoking BODY against multiple WORKSPACES." - (declare (debug (form body)) - (indent 1)) - `(let ((lsp--buffer-workspaces ,workspaces)) ,@body)) - - - -(defmacro lsp-consistency-check (package) - `(defconst ,(intern (concat (symbol-name package) - "-plist-value-when-compiled")) - (eval-when-compile lsp-use-plists))) - - -;; loading code-workspace files - -;;;###autoload -(defun lsp-load-vscode-workspace (file) - "Load vscode workspace from FILE" - (interactive "fSelect file to import: ") - (mapc #'lsp-workspace-folders-remove (lsp-session-folders (lsp-session))) - - (let ((dir (f-dirname file))) - (->> file - (json-read-file) - (alist-get 'folders) - (-map (-lambda ((&alist 'path)) - (lsp-workspace-folders-add (expand-file-name path dir))))))) - -;;;###autoload -(defun lsp-save-vscode-workspace (file) - "Save vscode workspace to FILE" - (interactive "FSelect file to save to: ") - - (let ((json-encoding-pretty-print t)) - (f-write-text (json-encode - `((folders . ,(->> (lsp-session) - (lsp-session-folders) - (--map `((path . ,it))))))) - 'utf-8 - file))) - - -(defmacro lsp-foreach-workspace (&rest body) - "Execute BODY for each of the current workspaces." - (declare (debug (form body))) - `(--map (with-lsp-workspace it ,@body) (lsp-workspaces))) - -(defmacro when-lsp-workspace (workspace &rest body) - "Helper macro for invoking BODY in WORKSPACE context if present." - (declare (debug (form body)) - (indent 1)) - `(when-let ((lsp--cur-workspace ,workspace)) ,@body)) - -(lsp-defun lsp--window-show-quick-pick (_workspace (&ShowQuickPickParams :place-holder :can-pick-many :items)) - (if-let* ((selectfunc (if can-pick-many #'completing-read-multiple #'completing-read)) - (itemLabels (seq-map (-lambda ((item &as &QuickPickItem :label)) (format "%s" label)) - items)) - (result (funcall-interactively - selectfunc - (format "%s%s " place-holder (if can-pick-many " (* for all)" "")) itemLabels)) - (choices (if (listp result) - (if (equal result '("*")) - itemLabels - result) - (list result)))) - (vconcat (seq-filter #'identity (seq-map (-lambda ((item &as &QuickPickItem :label :user-data)) - (if (member label choices) - (lsp-make-quick-pick-item :label label :picked t :user-data user-data) - nil)) - items))))) - -(lsp-defun lsp--window-show-input-box (_workspace (&ShowInputBoxParams :prompt :value?)) - (read-string (format "%s: " prompt) (or value? ""))) - -(lsp-defun lsp--window-show-message (_workspace (&ShowMessageRequestParams :message :type)) - "Send the server's messages to log. -PARAMS - the data sent from _WORKSPACE." - (funcall (cl-case type - (1 'lsp--error) - (2 'lsp--warn) - (t 'lsp--info)) - "%s" - message)) - -(lsp-defun lsp--window-log-message (workspace (&ShowMessageRequestParams :message :type)) - "Send the server's messages to log. -PARAMS - the data sent from WORKSPACE." - (ignore - (let ((client (lsp--workspace-client workspace))) - (when (or (not client) - (cl-notany (-rpartial #'string-match-p message) - (lsp--client-ignore-messages client))) - (lsp-log "%s" (lsp--propertize message type)))))) - -(lsp-defun lsp--window-log-message-request ((&ShowMessageRequestParams :message :type :actions?)) - "Display a message request to user sending the user selection back to server." - (let* ((message (lsp--propertize message type)) - (choices (seq-map #'lsp:message-action-item-title actions?))) - (if choices - (completing-read (concat message " ") (seq-into choices 'list) nil t) - (lsp-log message)))) - -(lsp-defun lsp--window-show-document ((&ShowDocumentParams :uri :selection?)) - "Show document URI in a buffer and go to SELECTION if any." - (let ((path (lsp--uri-to-path uri))) - (when (f-exists? path) - (with-current-buffer (find-file path) - (when selection? - (goto-char (lsp--position-to-point (lsp:range-start selection?)))) - t)))) - -(defcustom lsp-progress-prefix "⌛ " - "Progress prefix." - :group 'lsp-mode - :type 'string - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-progress-function #'lsp-on-progress-modeline - "Function for handling the progress notifications." - :group 'lsp-mode - :type '(choice - (const :tag "Use modeline" lsp-on-progress-modeline) - (const :tag "Legacy(uses either `progress-reporter' or `spinner' based on `lsp-progress-via-spinner')" - lsp-on-progress-legacy) - (const :tag "Ignore" ignore) - (function :tag "Other function")) - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-request-while-no-input-may-block nil - "Have `lsp-request-while-no-input` block unless `non-essential` is t." - :group 'lsp-mode - :type 'boolean) - -(defun lsp--progress-status () - "Returns the status of the progress for the current workspaces." - (-let ((progress-status - (s-join - "|" - (-keep - (lambda (workspace) - (let ((tokens (lsp--workspace-work-done-tokens workspace))) - (unless (ht-empty? tokens) - (mapconcat - (-lambda ((&WorkDoneProgressBegin :message? :title :percentage?)) - (concat (if percentage? - (if (numberp percentage?) - (format "%.0f%%%% " percentage?) - (format "%s%%%% " percentage?)) - "") - (or message? title))) - (ht-values tokens) - "|")))) - (lsp-workspaces))))) - (unless (s-blank? progress-status) - (concat lsp-progress-prefix progress-status " ")))) - -(lsp-defun lsp-on-progress-modeline (workspace (&ProgressParams :token :value - (value &as &WorkDoneProgress :kind))) - "PARAMS contains the progress data. -WORKSPACE is the workspace that contains the progress token." - (add-to-list 'global-mode-string '(t (:eval (lsp--progress-status)))) - (pcase kind - ("begin" (lsp-workspace-set-work-done-token token value workspace)) - ("report" (lsp-workspace-set-work-done-token token value workspace)) - ("end" (lsp-workspace-rem-work-done-token token workspace))) - (force-mode-line-update)) - -(lsp-defun lsp-on-progress-legacy (workspace (&ProgressParams :token :value - (value &as &WorkDoneProgress :kind))) - "PARAMS contains the progress data. -WORKSPACE is the workspace that contains the progress token." - (pcase kind - ("begin" - (-let* (((&WorkDoneProgressBegin :title :percentage?) value) - (reporter - (if lsp-progress-via-spinner - (let* ((spinner-strings (alist-get (lsp-progress-spinner-type) spinner-types)) - ;; Set message as a tooltip for the spinner strings - (propertized-strings - (seq-map (lambda (string) (propertize string 'help-echo title)) - spinner-strings)) - (spinner-type (vconcat propertized-strings))) - ;; The progress relates to the server as a whole, - ;; display it on all buffers. - (mapcar (lambda (buffer) - (lsp-with-current-buffer buffer - (spinner-start spinner-type)) - buffer) - (lsp--workspace-buffers workspace))) - (if percentage? - (make-progress-reporter title 0 100 percentage?) - ;; No percentage, just progress - (make-progress-reporter title nil nil))))) - (lsp-workspace-set-work-done-token token reporter workspace))) - ("report" - (when-let ((reporter (lsp-workspace-get-work-done-token token workspace))) - (unless lsp-progress-via-spinner - (progress-reporter-update reporter (lsp:work-done-progress-report-percentage? value))))) - - ("end" - (when-let ((reporter (lsp-workspace-get-work-done-token token workspace))) - (if lsp-progress-via-spinner - (mapc (lambda (buffer) - (when (lsp-buffer-live-p buffer) - (lsp-with-current-buffer buffer - (spinner-stop)))) - reporter) - (progress-reporter-done reporter)) - (lsp-workspace-rem-work-done-token token workspace))))) - - -;; diagnostics - -(defvar lsp-diagnostic-filter nil - "A a function which will be called with - `&PublishDiagnosticsParams' and `workspace' which can be used - to filter out the diagnostics. The function should return - `&PublishDiagnosticsParams'. - -Common usecase are: -1. Filter the diagnostics for a particular language server. -2. Filter out the diagnostics under specific level.") - -(defvar lsp-diagnostic-stats (ht)) - -(defun lsp-diagnostics (&optional current-workspace?) - "Return the diagnostics from all workspaces." - (or (pcase (if current-workspace? - (lsp-workspaces) - (lsp--session-workspaces (lsp-session))) - (`() ()) - (`(,workspace) (lsp--workspace-diagnostics workspace)) - (`,workspaces (let ((result (make-hash-table :test 'equal))) - (mapc (lambda (workspace) - (->> workspace - (lsp--workspace-diagnostics) - (maphash (lambda (file-name diagnostics) - (puthash file-name - (append (gethash file-name result) diagnostics) - result))))) - workspaces) - result))) - (ht))) - -(defun lsp-diagnostics-stats-for (path) - "Get diagnostics statistics for PATH. -The result format is vector [_ errors warnings infos hints] or nil." - (gethash (lsp--fix-path-casing path) lsp-diagnostic-stats)) - -(defun lsp-diagnostics--request-pull-diagnostics (workspace) - "Request new diagnostics for the current file within WORKSPACE. -This is only executed if the server supports pull diagnostics." - (when (lsp-feature? "textDocument/diagnostic") - (let ((path (lsp--fix-path-casing (buffer-file-name)))) - (lsp-request-async "textDocument/diagnostic" - (list :textDocument (lsp--text-document-identifier)) - (-lambda ((&DocumentDiagnosticReport :kind :items?)) - (lsp-diagnostics--apply-pull-diagnostics workspace path kind items?)) - :mode 'tick)))) - -(defun lsp-diagnostics--update-path (path new-stats) - (let ((new-stats (copy-sequence new-stats)) - (path (lsp--fix-path-casing (directory-file-name path)))) - (if-let ((old-data (gethash path lsp-diagnostic-stats))) - (dotimes (idx 5) - (cl-callf + (aref old-data idx) - (aref new-stats idx))) - (puthash path new-stats lsp-diagnostic-stats)))) - -(defun lsp-diagnostics--convert-and-update-path-stats (workspace path diagnostics) - (let ((path (lsp--fix-path-casing path)) - (new-stats (make-vector 5 0))) - (mapc (-lambda ((&Diagnostic :severity?)) - (cl-incf (aref new-stats (or severity? 1)))) - diagnostics) - (when-let ((old-diags (gethash path (lsp--workspace-diagnostics workspace)))) - (mapc (-lambda ((&Diagnostic :severity?)) - (cl-decf (aref new-stats (or severity? 1)))) - old-diags)) - (lsp-diagnostics--update-path path new-stats) - (while (not (string= path (setf path (file-name-directory - (directory-file-name path))))) - (lsp-diagnostics--update-path path new-stats)))) - -(lsp-defun lsp--on-diagnostics-update-stats (workspace - (&PublishDiagnosticsParams :uri :diagnostics)) - (lsp-diagnostics--convert-and-update-path-stats workspace (lsp--uri-to-path uri) diagnostics)) - -(defun lsp-diagnostics--apply-pull-diagnostics (workspace path kind diagnostics?) - "Update WORKSPACE diagnostics at PATH with DIAGNOSTICS?. -Depends on KIND being a \\='full\\=' update." - (cond - ((equal kind "full") - ;; TODO support `lsp-diagnostic-filter' - ;; (the params types differ from the published diagnostics response) - (lsp-diagnostics--convert-and-update-path-stats workspace path diagnostics?) - (-let* ((lsp--virtual-buffer-mappings (ht)) - (workspace-diagnostics (lsp--workspace-diagnostics workspace))) - (if (seq-empty-p diagnostics?) - (remhash path workspace-diagnostics) - (puthash path (append diagnostics? nil) workspace-diagnostics)) - (run-hooks 'lsp-diagnostics-updated-hook))) - ((equal kind "unchanged") t) - (t (lsp--error "Unknown pull diagnostic result kind '%s'" kind)))) - -(defun lsp--on-diagnostics (workspace params) - "Callback for textDocument/publishDiagnostics. -interface PublishDiagnosticsParams { - uri: string; - diagnostics: Diagnostic[]; -} -PARAMS contains the diagnostics data. -WORKSPACE is the workspace that contains the diagnostics." - (when lsp-diagnostic-filter - (setf params (funcall lsp-diagnostic-filter params workspace))) - - (lsp--on-diagnostics-update-stats workspace params) - - (-let* (((&PublishDiagnosticsParams :uri :diagnostics) params) - (lsp--virtual-buffer-mappings (ht)) - (file (lsp--fix-path-casing (lsp--uri-to-path uri))) - (workspace-diagnostics (lsp--workspace-diagnostics workspace))) - - (if (seq-empty-p diagnostics) - (remhash file workspace-diagnostics) - (puthash file (append diagnostics nil) workspace-diagnostics)) - - (run-hooks 'lsp-diagnostics-updated-hook))) - -(defun lsp-diagnostics--workspace-cleanup (workspace) - (->> workspace - (lsp--workspace-diagnostics) - (maphash (lambda (key _) - (lsp--on-diagnostics-update-stats - workspace - (lsp-make-publish-diagnostics-params - :uri (lsp--path-to-uri key) - :diagnostics []))))) - (clrhash (lsp--workspace-diagnostics workspace))) - - - -;; textDocument/foldingRange support - -(cl-defstruct lsp--folding-range beg end kind children) - -(defvar-local lsp--cached-folding-ranges nil) -(defvar-local lsp--cached-nested-folding-ranges nil) - -(defun lsp--folding-range-width (range) - (- (lsp--folding-range-end range) - (lsp--folding-range-beg range))) - -(defun lsp--get-folding-ranges () - "Get the folding ranges for the current buffer." - (unless (eq (buffer-chars-modified-tick) (car lsp--cached-folding-ranges)) - (let* ((ranges (lsp-request "textDocument/foldingRange" - `(:textDocument ,(lsp--text-document-identifier)))) - (sorted-line-col-pairs (->> ranges - (cl-mapcan (-lambda ((&FoldingRange :start-line - :start-character? - :end-line - :end-character?)) - (list (cons start-line start-character?) - (cons end-line end-character?)))) - (-sort #'lsp--line-col-comparator))) - (line-col-to-point-map (lsp--convert-line-col-to-points-batch - sorted-line-col-pairs))) - (setq lsp--cached-folding-ranges - (cons (buffer-chars-modified-tick) - (--> ranges - (seq-map (-lambda ((range &as - &FoldingRange :start-line - :start-character? - :end-line - :end-character? - :kind?)) - (make-lsp--folding-range - :beg (ht-get line-col-to-point-map - (cons start-line start-character?)) - :end (ht-get line-col-to-point-map - (cons end-line end-character?)) - :kind kind?)) - it) - (seq-filter (lambda (folding-range) - (< (lsp--folding-range-beg folding-range) - (lsp--folding-range-end folding-range))) - it) - (seq-into it 'list) - (delete-dups it)))))) - (cdr lsp--cached-folding-ranges)) - -(defun lsp--get-nested-folding-ranges () - "Get a list of nested folding ranges for the current buffer." - (-let [(tick . _) lsp--cached-folding-ranges] - (if (and (eq tick (buffer-chars-modified-tick)) - lsp--cached-nested-folding-ranges) - lsp--cached-nested-folding-ranges - (setq lsp--cached-nested-folding-ranges - (lsp--folding-range-build-trees (lsp--get-folding-ranges)))))) - -(defun lsp--folding-range-build-trees (ranges) - (setq ranges (seq-sort #'lsp--range-before-p ranges)) - (let* ((dummy-node (make-lsp--folding-range - :beg most-negative-fixnum - :end most-positive-fixnum)) - (stack (list dummy-node))) - (dolist (range ranges) - (while (not (lsp--range-inside-p range (car stack))) - (pop stack)) - (push range (lsp--folding-range-children (car stack))) - (push range stack)) - (lsp--folding-range-children dummy-node))) - -(defun lsp--range-inside-p (r1 r2) - "Return non-nil if folding range R1 lies inside R2" - (and (>= (lsp--folding-range-beg r1) (lsp--folding-range-beg r2)) - (<= (lsp--folding-range-end r1) (lsp--folding-range-end r2)))) - -(defun lsp--range-before-p (r1 r2) - "Return non-nil if folding range R1 ends before R2" - ;; Ensure r1 comes before r2 - (or (< (lsp--folding-range-beg r1) - (lsp--folding-range-beg r2)) - ;; If beg(r1) == beg(r2) make sure r2 ends first - (and (= (lsp--folding-range-beg r1) - (lsp--folding-range-beg r2)) - (< (lsp--folding-range-end r2) - (lsp--folding-range-end r1))))) - -(defun lsp--point-inside-range-p (point range) - "Return non-nil if POINT lies inside folding range RANGE." - (and (>= point (lsp--folding-range-beg range)) - (<= point (lsp--folding-range-end range)))) - -(cl-defun lsp--get-current-innermost-folding-range (&optional (point (point))) - "Return the innermost folding range POINT lies in." - (seq-reduce (lambda (innermost-range curr-range) - (if (and (lsp--point-inside-range-p point curr-range) - (or (null innermost-range) - (lsp--range-inside-p curr-range innermost-range))) - curr-range - innermost-range)) - (lsp--get-folding-ranges) - nil)) - -(cl-defun lsp--get-current-outermost-folding-range (&optional (point (point))) - "Return the outermost folding range POINT lies in." - (cdr (seq-reduce (-lambda ((best-pair &as outermost-width . _) curr-range) - (let ((curr-width (lsp--folding-range-width curr-range))) - (if (and (lsp--point-inside-range-p point curr-range) - (or (null best-pair) - (> curr-width outermost-width))) - (cons curr-width curr-range) - best-pair))) - (lsp--get-folding-ranges) - nil))) - -(defun lsp--folding-range-at-point-bounds () - (when (and lsp-enable-folding - (lsp-feature? "textDocument/foldingRange")) - (if-let ((range (lsp--get-current-innermost-folding-range))) - (cons (lsp--folding-range-beg range) - (lsp--folding-range-end range))))) -(put 'lsp--folding-range 'bounds-of-thing-at-point - #'lsp--folding-range-at-point-bounds) - -(defun lsp--get-nearest-folding-range (&optional backward) - (let ((point (point)) - (found nil)) - (while (not - (or found - (if backward - (<= point (point-min)) - (>= point (point-max))))) - (if backward (cl-decf point) (cl-incf point)) - (setq found (lsp--get-current-innermost-folding-range point))) - found)) - -(defun lsp--folding-range-at-point-forward-op (n) - (when (and lsp-enable-folding - (not (zerop n)) - (lsp-feature? "textDocument/foldingRange")) - (cl-block break - (dotimes (_ (abs n)) - (if-let ((range (lsp--get-nearest-folding-range (< n 0)))) - (goto-char (if (< n 0) - (lsp--folding-range-beg range) - (lsp--folding-range-end range))) - (cl-return-from break)))))) -(put 'lsp--folding-range 'forward-op - #'lsp--folding-range-at-point-forward-op) - -(defun lsp--folding-range-at-point-beginning-op () - (goto-char (car (lsp--folding-range-at-point-bounds)))) -(put 'lsp--folding-range 'beginning-op - #'lsp--folding-range-at-point-beginning-op) - -(defun lsp--folding-range-at-point-end-op () - (goto-char (cdr (lsp--folding-range-at-point-bounds)))) -(put 'lsp--folding-range 'end-op - #'lsp--folding-range-at-point-end-op) - -(defun lsp--range-at-point-bounds () - (or (lsp--folding-range-at-point-bounds) - (when-let ((range (and - (lsp-feature? "textDocument/hover") - (->> (lsp--text-document-position-params) - (lsp-request "textDocument/hover") - (lsp:hover-range?))))) - (lsp--range-to-region range)))) - -;; A more general purpose "thing", useful for applications like focus.el -(put 'lsp--range 'bounds-of-thing-at-point - #'lsp--range-at-point-bounds) - -(defun lsp--log-io-p (method) - "Return non nil if should log for METHOD." - (and lsp-log-io - (or (not lsp-log-io-allowlist-methods) - (member method lsp-log-io-allowlist-methods)))) - - -;; toggles - -(defun lsp-toggle-trace-io () - "Toggle client-server protocol logging." - (interactive) - (setq lsp-log-io (not lsp-log-io)) - (lsp--info "Server logging %s." (if lsp-log-io "enabled" "disabled"))) - -(defun lsp-toggle-signature-auto-activate () - "Toggle signature auto activate." - (interactive) - (setq lsp-signature-auto-activate - (unless lsp-signature-auto-activate '(:on-trigger-char))) - (lsp--info "Signature autoactivate %s." (if lsp-signature-auto-activate "enabled" "disabled")) - (lsp--update-signature-help-hook)) - -(defun lsp-toggle-on-type-formatting () - "Toggle on type formatting." - (interactive) - (setq lsp-enable-on-type-formatting (not lsp-enable-on-type-formatting)) - (lsp--info "On type formatting is %s." (if lsp-enable-on-type-formatting "enabled" "disabled")) - (lsp--update-on-type-formatting-hook)) - -(defun lsp-toggle-symbol-highlight () - "Toggle symbol highlighting." - (interactive) - (setq lsp-enable-symbol-highlighting (not lsp-enable-symbol-highlighting)) - - (cond - ((and lsp-enable-symbol-highlighting - (lsp-feature? "textDocument/documentHighlight")) - (add-hook 'lsp-on-idle-hook #'lsp--document-highlight nil t) - (lsp--info "Symbol highlighting enabled in current buffer.")) - ((not lsp-enable-symbol-highlighting) - (remove-hook 'lsp-on-idle-hook #'lsp--document-highlight t) - (lsp--remove-overlays 'lsp-highlight) - (lsp--info "Symbol highlighting disabled in current buffer.")))) - - -;; keybindings -(defvar lsp--binding-descriptions nil - "List of key binding/short description pair.") - -(defmacro lsp-define-conditional-key (keymap key def desc cond &rest bindings) - "In KEYMAP, define key sequence KEY as DEF conditionally. -This is like `define-key', except the definition disappears -whenever COND evaluates to nil. -DESC is the short-description for the binding. -BINDINGS is a list of (key def desc cond)." - (declare (indent defun) - (debug (form form form form form &rest sexp))) - (->> (cl-list* key def desc cond bindings) - (-partition 4) - (-mapcat (-lambda ((key def desc cond)) - `((define-key ,keymap ,key - '(menu-item - ,(format "maybe-%s" def) - ,def - :filter - (lambda (item) - (when (with-current-buffer (or (when (buffer-live-p lsp--describe-buffer) - lsp--describe-buffer) - (current-buffer)) - ,cond) - item)))) - (when (stringp ,key) - (setq lsp--binding-descriptions - (append lsp--binding-descriptions '(,key ,desc))))))) - macroexp-progn)) - -(defvar lsp--describe-buffer nil) - -(defun lsp-describe-buffer-bindings-advice (fn buffer &optional prefix menus) - (let ((lsp--describe-buffer buffer)) - (funcall fn buffer prefix menus))) - -(advice-add 'describe-buffer-bindings - :around - #'lsp-describe-buffer-bindings-advice) - -(defun lsp--prepend-prefix (mappings) - (->> mappings - (-partition 2) - (-mapcat (-lambda ((key description)) - (list (concat lsp-keymap-prefix " " key) - description))))) - -(defvar lsp-command-map - (-doto (make-sparse-keymap) - (lsp-define-conditional-key - ;; workspaces - "wD" lsp-disconnect "disconnect" (lsp-workspaces) - "wd" lsp-describe-session "describe session" t - "wq" lsp-workspace-shutdown "shutdown server" (lsp-workspaces) - "wr" lsp-workspace-restart "restart server" (lsp-workspaces) - "ws" lsp "start server" t - - ;; formatting - "==" lsp-format-buffer "format buffer" (or (lsp-feature? "textDocument/rangeFormatting") - (lsp-feature? "textDocument/formatting")) - "=r" lsp-format-region "format region" (lsp-feature? "textDocument/rangeFormatting") - - ;; folders - "Fa" lsp-workspace-folders-add "add folder" t - "Fb" lsp-workspace-blocklist-remove "un-blocklist folder" t - "Fr" lsp-workspace-folders-remove "remove folder" t - - ;; toggles - "TD" lsp-modeline-diagnostics-mode "toggle modeline diagnostics" (lsp-feature? - "textDocument/publishDiagnostics") - "TL" lsp-toggle-trace-io "toggle log io" t - "TS" lsp-ui-sideline-mode "toggle sideline" (featurep 'lsp-ui-sideline) - "TT" lsp-treemacs-sync-mode "toggle treemacs integration" (featurep 'lsp-treemacs) - "Ta" lsp-modeline-code-actions-mode "toggle modeline code actions" (lsp-feature? - "textDocument/codeAction") - "Tb" lsp-headerline-breadcrumb-mode "toggle breadcrumb" (lsp-feature? - "textDocument/documentSymbol") - "Td" lsp-ui-doc-mode "toggle documentation popup" (featurep 'lsp-ui-doc) - "Tf" lsp-toggle-on-type-formatting "toggle on type formatting" (lsp-feature? - "textDocument/onTypeFormatting") - "Th" lsp-toggle-symbol-highlight "toggle highlighting" (lsp-feature? "textDocument/documentHighlight") - "Tl" lsp-lens-mode "toggle lenses" (lsp-feature? "textDocument/codeLens") - "Ts" lsp-toggle-signature-auto-activate "toggle signature" (lsp-feature? "textDocument/signatureHelp") - - ;; goto - "ga" xref-find-apropos "find symbol in workspace" (lsp-feature? "workspace/symbol") - "gd" lsp-find-declaration "find declarations" (lsp-feature? "textDocument/declaration") - "ge" lsp-treemacs-errors-list "show errors" (fboundp 'lsp-treemacs-errors-list) - "gg" lsp-find-definition "find definitions" (lsp-feature? "textDocument/definition") - "gh" lsp-treemacs-call-hierarchy "call hierarchy" (and (lsp-feature? "callHierarchy/incomingCalls") - (fboundp 'lsp-treemacs-call-hierarchy)) - "gi" lsp-find-implementation "find implementations" (lsp-feature? "textDocument/implementation") - "gr" lsp-find-references "find references" (lsp-feature? "textDocument/references") - "gt" lsp-find-type-definition "find type definition" (lsp-feature? "textDocument/typeDefinition") - - ;; help - "hg" lsp-ui-doc-glance "glance symbol" (and (featurep 'lsp-ui-doc) - (lsp-feature? "textDocument/hover")) - "hh" lsp-describe-thing-at-point "describe symbol at point" (lsp-feature? "textDocument/hover") - "hs" lsp-signature-activate "signature help" (lsp-feature? "textDocument/signatureHelp") - - ;; refactoring - "ro" lsp-organize-imports "organize imports" (lsp-feature? "textDocument/codeAction") - "rr" lsp-rename "rename" (lsp-feature? "textDocument/rename") - - ;; actions - "aa" lsp-execute-code-action "code actions" (lsp-feature? "textDocument/codeAction") - "ah" lsp-document-highlight "highlight symbol" (lsp-feature? "textDocument/documentHighlight") - "al" lsp-avy-lens "lens" (and (bound-and-true-p lsp-lens-mode) (featurep 'avy)) - - ;; peeks - "Gg" lsp-ui-peek-find-definitions "peek definitions" (and (lsp-feature? "textDocument/definition") - (fboundp 'lsp-ui-peek-find-definitions)) - "Gi" lsp-ui-peek-find-implementation "peek implementations" (and - (fboundp 'lsp-ui-peek-find-implementation) - (lsp-feature? "textDocument/implementation")) - "Gr" lsp-ui-peek-find-references "peek references" (and (fboundp 'lsp-ui-peek-find-references) - (lsp-feature? "textDocument/references")) - "Gs" lsp-ui-peek-find-workspace-symbol "peek workspace symbol" (and (fboundp - 'lsp-ui-peek-find-workspace-symbol) - (lsp-feature? "workspace/symbol"))))) - - -;; which-key integration - -(declare-function which-key-add-major-mode-key-based-replacements "ext:which-key") -(declare-function which-key-add-key-based-replacements "ext:which-key") - -(defun lsp-enable-which-key-integration (&optional all-modes) - "Adds descriptions for `lsp-mode-map' to `which-key-mode' for the current -active `major-mode', or for all major modes when ALL-MODES is t." - (cl-flet ((which-key-fn (if all-modes - 'which-key-add-key-based-replacements - (apply-partially 'which-key-add-major-mode-key-based-replacements major-mode)))) - (apply - #'which-key-fn - (lsp--prepend-prefix - (cl-list* - "" "lsp" - "w" "workspaces" - "F" "folders" - "=" "formatting" - "T" "toggle" - "g" "goto" - "h" "help" - "r" "refactor" - "a" "code actions" - "G" "peek" - lsp--binding-descriptions))))) - - -;; Globbing syntax - -;; We port VSCode's glob-to-regexp code -;; (https://github.com/Microsoft/vscode/blob/466da1c9013c624140f6d1473b23a870abc82d44/src/vs/base/common/glob.ts) -;; since the LSP globbing syntax seems to be the same as that of -;; VSCode. - -(defconst lsp-globstar "**" - "Globstar pattern.") - -(defconst lsp-glob-split ?/ - "The character by which we split path components in a glob -pattern.") - -(defconst lsp-path-regexp "[/\\\\]" - "Forward or backslash to be used as a path separator in -computed regexps.") - -(defconst lsp-non-path-regexp "[^/\\\\]" - "A regexp matching anything other than a slash.") - -(defconst lsp-globstar-regexp - (format "\\(?:%s\\|%s+%s\\|%s%s+\\)*?" - lsp-path-regexp - lsp-non-path-regexp lsp-path-regexp - lsp-path-regexp lsp-non-path-regexp) - "Globstar in regexp form.") - -(defun lsp-split-glob-pattern (pattern split-char) - "Split PATTERN at SPLIT-CHAR while respecting braces and brackets." - (when pattern - (let ((segments nil) - (in-braces nil) - (in-brackets nil) - (current-segment "")) - (dolist (char (string-to-list pattern)) - (cl-block 'exit-point - (if (eq char split-char) - (when (and (null in-braces) - (null in-brackets)) - (push current-segment segments) - (setq current-segment "") - (cl-return-from 'exit-point)) - (pcase char - (?{ - (setq in-braces t)) - (?} - (setq in-braces nil)) - (?\[ - (setq in-brackets t)) - (?\] - (setq in-brackets nil)))) - (setq current-segment (concat current-segment - (char-to-string char))))) - (unless (string-empty-p current-segment) - (push current-segment segments)) - (nreverse segments)))) - -(defun lsp--glob-to-regexp (pattern) - "Helper function to convert a PATTERN from LSP's glob syntax to -an Elisp regexp." - (if (string-empty-p pattern) - "" - (let ((current-regexp "") - (glob-segments (lsp-split-glob-pattern pattern lsp-glob-split))) - (if (-all? (lambda (segment) (eq segment lsp-globstar)) - glob-segments) - ".*" - (let ((prev-segment-was-globstar nil)) - (seq-do-indexed - (lambda (segment index) - (if (string-equal segment lsp-globstar) - (unless prev-segment-was-globstar - (setq current-regexp (concat current-regexp - lsp-globstar-regexp)) - (setq prev-segment-was-globstar t)) - (let ((in-braces nil) - (brace-val "") - (in-brackets nil) - (bracket-val "")) - (dolist (char (string-to-list segment)) - (cond - ((and (not (char-equal char ?\})) - in-braces) - (setq brace-val (concat brace-val - (char-to-string char)))) - ((and in-brackets - (or (not (char-equal char ?\])) - (string-empty-p bracket-val))) - (let ((curr (cond - ((char-equal char ?-) - "-") - ;; NOTE: ?\^ and ?^ are different characters - ((and (memq char '(?^ ?!)) - (string-empty-p bracket-val)) - "^") - ((char-equal char lsp-glob-split) - "") - (t - (regexp-quote (char-to-string char)))))) - (setq bracket-val (concat bracket-val curr)))) - (t - (cl-case char - (?{ - (setq in-braces t)) - (?\[ - (setq in-brackets t)) - (?} - (let* ((choices (lsp-split-glob-pattern brace-val ?\,)) - (brace-regexp (concat "\\(?:" - (mapconcat #'lsp--glob-to-regexp choices "\\|") - "\\)"))) - (setq current-regexp (concat current-regexp - brace-regexp)) - (setq in-braces nil) - (setq brace-val ""))) - (?\] - (setq current-regexp - (concat current-regexp - "[" bracket-val "]")) - (setq in-brackets nil) - (setq bracket-val "")) - (?? - (setq current-regexp - (concat current-regexp - lsp-non-path-regexp))) - (?* - (setq current-regexp - (concat current-regexp - lsp-non-path-regexp "*?"))) - (t - (setq current-regexp - (concat current-regexp - (regexp-quote (char-to-string char))))))))) - (when (and (< index (1- (length glob-segments))) - (or (not (string-equal (nth (1+ index) glob-segments) - lsp-globstar)) - (< (+ index 2) - (length glob-segments)))) - (setq current-regexp - (concat current-regexp - lsp-path-regexp))) - (setq prev-segment-was-globstar nil)))) - glob-segments) - current-regexp))))) - -;; See https://github.com/emacs-lsp/lsp-mode/issues/2365 -(defun lsp-glob-unbrace-at-top-level (glob-pattern) - "If GLOB-PATTERN does not start with a brace, return a singleton list -containing GLOB-PATTERN. - -If GLOB-PATTERN does start with a brace, return a list of the -comma-separated globs within the top-level braces." - (if (not (string-prefix-p "{" glob-pattern)) - (list glob-pattern) - (lsp-split-glob-pattern (substring glob-pattern 1 -1) ?\,))) - -(defun lsp-glob-convert-to-wrapped-regexp (glob-pattern) - "Convert GLOB-PATTERN to a regexp wrapped with the beginning- -and end-of-string meta-characters." - (concat "\\`" (lsp--glob-to-regexp (string-trim glob-pattern)) "\\'")) - -(defun lsp-glob-to-regexps (glob-pattern) - "Convert a GLOB-PATTERN to a list of Elisp regexps." - (when-let* - ((glob-pattern (cond ((hash-table-p glob-pattern) - (ht-get glob-pattern "pattern")) - ((stringp glob-pattern) glob-pattern) - (t (error "Unknown glob-pattern type: %s" glob-pattern)))) - (trimmed-pattern (string-trim glob-pattern)) - (top-level-unbraced-patterns (lsp-glob-unbrace-at-top-level trimmed-pattern))) - (seq-map #'lsp-glob-convert-to-wrapped-regexp - top-level-unbraced-patterns))) - - - -(defvar lsp-mode-menu) - -(defun lsp-mouse-click (event) - (interactive "e") - (let* ((ec (event-start event)) - (choice (x-popup-menu event lsp-mode-menu)) - (action (lookup-key lsp-mode-menu (apply 'vector choice)))) - - (select-window (posn-window ec)) - - (unless (and (region-active-p) (eq action 'lsp-execute-code-action)) - (goto-char (posn-point ec))) - (run-with-idle-timer - 0.001 nil - (lambda () - (cl-labels ((check (value) (not (null value)))) - (when choice - (call-interactively action))))))) - -(defvar lsp-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-<down-mouse-1>") #'lsp-find-definition-mouse) - (define-key map (kbd "C-<mouse-1>") #'ignore) - (define-key map (kbd "<mouse-3>") #'lsp-mouse-click) - (define-key map (kbd "C-S-SPC") #'lsp-signature-activate) - (when lsp-keymap-prefix - (define-key map (kbd lsp-keymap-prefix) lsp-command-map)) - map) - "Keymap for `lsp-mode'.") - -(define-minor-mode lsp-mode "Mode for LSP interaction." - :keymap lsp-mode-map - :lighter - (" LSP[" - (lsp--buffer-workspaces - (:eval (mapconcat #'lsp--workspace-print lsp--buffer-workspaces "][")) - (:propertize "Disconnected" face warning)) - "]") - :group 'lsp-mode - (when (and lsp-mode (not lsp--buffer-workspaces) (not lsp--buffer-deferred)) - ;; fire up `lsp' when someone calls `lsp-mode' instead of `lsp' - (lsp))) - -(defvar lsp-mode-menu - (easy-menu-create-menu - nil - `(["Go to definition" lsp-find-definition - :active (lsp-feature? "textDocument/definition")] - ["Find references" lsp-find-references - :active (lsp-feature? "textDocument/references")] - ["Find implementations" lsp-find-implementation - :active (lsp-feature? "textDocument/implementation")] - ["Find declarations" lsp-find-declaration - :active (lsp-feature? "textDocument/declaration")] - ["Go to type declaration" lsp-find-type-definition - :active (lsp-feature? "textDocument/typeDefinition")] - "--" - ["Describe" lsp-describe-thing-at-point] - ["Code action" lsp-execute-code-action] - ["Format" lsp-format-buffer] - ["Highlight references" lsp-document-highlight] - ["Type Hierarchy" lsp-java-type-hierarchy - :visible (lsp-can-execute-command? "java.navigate.resolveTypeHierarchy")] - ["Type Hierarchy" lsp-treemacs-type-hierarchy - :visible (and (not (lsp-can-execute-command? "java.navigate.resolveTypeHierarchy")) - (functionp 'lsp-treemacs-type-hierarchy) - (lsp-feature? "textDocument/typeHierarchy"))] - ["Call Hierarchy" lsp-treemacs-call-hierarchy - :visible (and (functionp 'lsp-treemacs-call-hierarchy) - (lsp-feature? "textDocument/callHierarchy"))] - ["Rename" lsp-rename - :active (lsp-feature? "textDocument/rename")] - "--" - ("Session" - ["View logs" lsp-workspace-show-log] - ["Describe" lsp-describe-session] - ["Shutdown" lsp-shutdown-workspace] - ["Restart" lsp-restart-workspace]) - ("Workspace Folders" - ["Add" lsp-workspace-folders-add] - ["Remove" lsp-workspace-folders-remove] - ["Open" lsp-workspace-folders-open]) - ("Toggle features" - ["Lenses" lsp-lens-mode] - ["Headerline breadcrumb" lsp-headerline-breadcrumb-mode] - ["Modeline code actions" lsp-modeline-code-actions-mode] - ["Modeline diagnostics" lsp-modeline-diagnostics-mode]) - "---" - ("Debug" - :active (bound-and-true-p dap-ui-mode) - :filter ,(lambda (_) - (and (boundp 'dap-ui-menu-items) - (nthcdr 3 dap-ui-menu-items)))))) - "Menu for lsp-mode.") - -(defalias 'make-lsp-client 'make-lsp--client) - -(cl-defstruct lsp--registered-capability - (id "") - (method " ") - (options nil)) - -;; A ‘lsp--workspace’ object represents exactly one language server process. -(cl-defstruct lsp--workspace - ;; the `ewoc' object for displaying I/O to and from the server - (ewoc nil) - - ;; ‘server-capabilities’ is a hash table of the language server capabilities. - ;; It is the hash table representation of a LSP ServerCapabilities structure; - ;; cf. https://microsoft.github.io/language-server-protocol/specification#initialize. - (server-capabilities nil) - - ;; ‘registered-server-capabilities’ is a list of hash tables that represent - ;; dynamically-registered Registration objects. See - ;; https://microsoft.github.io/language-server-protocol/specification#client_registerCapability. - (registered-server-capabilities nil) - - ;; ‘root’ is a directory name or a directory file name for the workspace - ;; root. ‘lsp-mode’ passes this directory to the ‘initialize’ method of the - ;; language server; see - ;; https://microsoft.github.io/language-server-protocol/specification#initialize. - (root nil) - - ;; ‘client’ is the ‘lsp--client’ object associated with this workspace. - (client nil) - - ;; ‘host-root’ contains the host root info as derived from `file-remote-p'. It - ;; used to derive the file path in `lsp--uri-to-path' when using tramp - ;; connection. - (host-root nil) - - ;; ‘proc’ is a process object; it may represent a regular process, a pipe, or - ;; a network connection. ‘lsp-mode’ communicates with ‘proc’ using the - ;; language server protocol. ‘proc’ corresponds to the COMMUNICATION-PROCESS - ;; element of the return value of the client’s ‘get-root’ field, which see. - (proc nil) - - ;; ‘proc’ is a process object; it must represent a regular process, not a - ;; pipe or network process. It represents the actual server process that - ;; corresponds to this workspace. ‘cmd-proc’ corresponds to the - ;; COMMAND-PROCESS element of the return value of the client’s ‘get-root’ - ;; field, which see. - (cmd-proc nil) - - ;; ‘buffers’ is a list of buffers associated with this workspace. - (buffers nil) - - ;; if semantic tokens is enabled, `semantic-tokens-faces' contains - ;; one face (or nil) for each token type supported by the language server. - (semantic-tokens-faces nil) - - ;; If semantic highlighting is enabled, `semantic-tokens-modifier-faces' - ;; contains one face (or nil) for each modifier type supported by the language - ;; server - (semantic-tokens-modifier-faces nil) - - ;; Extra client capabilities provided by third-party packages using - ;; `lsp-register-client-capabilities'. It's value is an alist of (PACKAGE-NAME - ;; . CAPS), where PACKAGE-NAME is a symbol of the third-party package name, - ;; and CAPS is either a plist of the client capabilities, or a function that - ;; takes no argument and returns a plist of the client capabilities or nil. - (extra-client-capabilities nil) - - ;; Workspace status - (status nil) - - ;; ‘metadata’ is a generic storage for workspace specific data. It is - ;; accessed via `lsp-workspace-set-metadata' and `lsp-workspace-set-metadata' - (metadata (make-hash-table :test 'equal)) - - ;; contains all the file notification watches that have been created for the - ;; current workspace in format filePath->file notification handle. - (watches (make-hash-table :test 'equal)) - - ;; list of workspace folders - (workspace-folders nil) - - ;; ‘last-id’ the last request id for the current workspace. - (last-id 0) - - ;; ‘status-string’ allows extensions to specify custom status string based on - ;; the Language Server specific messages. - (status-string nil) - - ;; ‘shutdown-action’ flag used to mark that workspace should not be restarted (e.g. it - ;; was stopped). - shutdown-action - - ;; ‘diagnostics’ a hashmap with workspace diagnostics. - (diagnostics (make-hash-table :test 'equal)) - - ;; contains all the workDone progress tokens that have been created - ;; for the current workspace. - (work-done-tokens (make-hash-table :test 'equal))) - - -(cl-defstruct lsp-session - ;; contains the folders that are part of the current session - folders - ;; contains the folders that must not be imported in the current workspace. - folders-blocklist - ;; contains the list of folders that must be imported in a project in case of - ;; multi root LSP server. - (server-id->folders (make-hash-table :test 'equal)) - ;; folder to list of the servers that are associated with the folder. - (folder->servers (make-hash-table :test 'equal)) - ;; ‘metadata’ is a generic storage for workspace specific data. It is - ;; accessed via `lsp-workspace-set-metadata' and `lsp-workspace-set-metadata' - (metadata (make-hash-table :test 'equal))) - -(defun lsp-workspace-status (status-string &optional workspace) - "Set current workspace status to STATUS-STRING. -If WORKSPACE is not specified defaults to lsp--cur-workspace." - (let ((status-string (when status-string (replace-regexp-in-string "%" "%%" status-string)))) - (setf (lsp--workspace-status-string (or workspace lsp--cur-workspace)) status-string))) - -(defun lsp-session-set-metadata (key value &optional _workspace) - "Associate KEY with VALUE in the WORKSPACE metadata. -If WORKSPACE is not provided current workspace will be used." - (puthash key value (lsp-session-metadata (lsp-session)))) - -(defalias 'lsp-workspace-set-metadata 'lsp-session-set-metadata) - -(defun lsp-session-get-metadata (key &optional _workspace) - "Lookup KEY in WORKSPACE metadata. -If WORKSPACE is not provided current workspace will be used." - (gethash key (lsp-session-metadata (lsp-session)))) - -(defalias 'lsp-workspace-get-metadata 'lsp-session-get-metadata) - -(defun lsp-workspace-set-work-done-token (token value workspace) - "Associate TOKEN with VALUE in the WORKSPACE work-done-tokens." - (puthash token value (lsp--workspace-work-done-tokens workspace))) - -(defun lsp-workspace-get-work-done-token (token workspace) - "Lookup TOKEN in the WORKSPACE work-done-tokens." - (gethash token (lsp--workspace-work-done-tokens workspace))) - -(defun lsp-workspace-rem-work-done-token (token workspace) - "Remove TOKEN from the WORKSPACE work-done-tokens." - (remhash token (lsp--workspace-work-done-tokens workspace))) - - -(defun lsp--make-notification (method &optional params) - "Create notification body for method METHOD and parameters PARAMS." - (list :jsonrpc "2.0" :method method :params params)) - -(defalias 'lsp--make-request 'lsp--make-notification) -(defalias 'lsp-make-request 'lsp--make-notification) - -(defun lsp--make-response (id result) - "Create response for REQUEST with RESULT." - `(:jsonrpc "2.0" :id ,id :result ,result)) - -(defun lsp-make-notification (method &optional params) - "Create notification body for method METHOD and parameters PARAMS." - (lsp--make-notification method params)) - -(defmacro lsp--json-serialize (params) - (if (progn - (require 'json) - (fboundp 'json-serialize)) - `(json-serialize ,params - :null-object nil - :false-object :json-false) - `(let ((json-false :json-false)) - (json-encode ,params)))) - -(defun lsp--make-message (params) - "Create a LSP message from PARAMS, after encoding it to a JSON string." - (let ((body (lsp--json-serialize params))) - (concat "Content-Length: " - (number-to-string (1+ (string-bytes body))) - "\r\n\r\n" - body - "\n"))) - -(cl-defstruct lsp--log-entry timestamp process-time type method id body) - -(defun lsp--make-log-entry (method id body type &optional process-time) - "Create an outgoing log object from BODY with method METHOD and id ID. -If ID is non-nil, then the body is assumed to be a notification. -TYPE can either be `incoming' or `outgoing'" - (cl-assert (memq type '(incoming-req outgoing-req incoming-notif - outgoing-notif incoming-resp - outgoing-resp))) - (make-lsp--log-entry - :timestamp (format-time-string "%I:%M:%S %p") - :process-time process-time - :method method - :id id - :type type - :body body)) - -(defun lsp--log-font-lock-json (body) - "Font lock JSON BODY." - (with-temp-buffer - (insert body) - ;; We set the temp buffer file-name extension to .json and call `set-auto-mode' - ;; so the users configured json mode is used which could be - ;; `json-mode', `json-ts-mode', `jsonian-mode', etc. - (let ((buffer-file-name "lsp-log.json")) - (delay-mode-hooks - (set-auto-mode) - (if (fboundp 'font-lock-ensure) - (font-lock-ensure) - (with-no-warnings - (font-lock-fontify-buffer))))) - (buffer-string))) - -(defun lsp--log-entry-pp (entry) - (cl-assert (lsp--log-entry-p entry)) - (pcase-let (((cl-struct lsp--log-entry timestamp method id type process-time - body) - entry) - (json-false :json-false) - (json-encoding-pretty-print t) - (str nil)) - (setq str - (concat (format "[Trace - %s] " timestamp) - (pcase type - ('incoming-req (format "Received request '%s - (%s)." method id)) - ('outgoing-req (format "Sending request '%s - (%s)'." method id)) - - ('incoming-notif (format "Received notification '%s'." method)) - ('outgoing-notif (format "Sending notification '%s'." method)) - - ('incoming-resp (format "Received response '%s - (%s)' in %dms." - method id process-time)) - ('outgoing-resp - (format - "Sending response '%s - (%s)'. Processing request took %dms" - method id process-time))) - "\n" - (if (memq type '(incoming-resp ougoing-resp)) - "Result: " - "Params: ") - (lsp--log-font-lock-json (json-encode body)) - "\n\n\n")) - (setq str (propertize str 'mouse-face 'highlight 'read-only t)) - (insert str))) - -(defvar-local lsp--log-io-ewoc nil) - -(defun lsp--get-create-io-ewoc (workspace) - (if (and (lsp--workspace-ewoc workspace) - (buffer-live-p (ewoc-buffer (lsp--workspace-ewoc workspace)))) - (lsp--workspace-ewoc workspace) - (with-current-buffer (lsp--get-log-buffer-create workspace) - (unless (eq 'lsp-log-io-mode major-mode) (lsp-log-io-mode)) - (setq-local window-point-insertion-type t) - (setq lsp--log-io-ewoc (ewoc-create #'lsp--log-entry-pp nil nil t)) - (setf (lsp--workspace-ewoc workspace) lsp--log-io-ewoc)) - (lsp--workspace-ewoc workspace))) - -(defun lsp--ewoc-count (ewoc) - (let* ((count 0) - (count-fn (lambda (_) (setq count (1+ count))))) - (ewoc-map count-fn ewoc) - count)) - -(defun lsp--log-entry-new (entry workspace) - (let* ((ewoc (lsp--get-create-io-ewoc workspace)) - (count (and (not (eq lsp-io-messages-max t)) (lsp--ewoc-count ewoc))) - (node (if (or (eq lsp-io-messages-max t) - (>= lsp-io-messages-max count)) - nil - (ewoc-nth ewoc (1- lsp-io-messages-max)))) - (prev nil) - (inhibit-read-only t)) - (while node - (setq prev (ewoc-prev ewoc node)) - (ewoc-delete ewoc node) - (setq node prev)) - (ewoc-enter-last ewoc entry))) - -(defun lsp--send-notification (body) - "Send BODY as a notification to the language server." - (lsp-foreach-workspace - (when (lsp--log-io-p (plist-get body :method)) - (lsp--log-entry-new (lsp--make-log-entry - (plist-get body :method) - nil (plist-get body :params) 'outgoing-notif) - lsp--cur-workspace)) - (lsp--send-no-wait body - (lsp--workspace-proc lsp--cur-workspace)))) - -(defalias 'lsp-send-notification 'lsp--send-notification) - -(defun lsp-notify (method params) - "Send notification METHOD with PARAMS." - (lsp--send-notification (lsp--make-notification method params))) - -(defun lsp--cur-workspace-check () - "Check whether buffer lsp workspace(s) are set." - (cl-assert (lsp-workspaces) nil - "No language server(s) is associated with this buffer.")) - -(defun lsp--send-request (body &optional no-wait no-merge) - "Send BODY as a request to the language server, get the response. -If NO-WAIT is non-nil, don't synchronously wait for a response. -If NO-MERGE is non-nil, don't merge the results but return an -alist mapping workspace->result." - (lsp-request (plist-get body :method) - (plist-get body :params) - :no-wait no-wait - :no-merge no-merge)) - -(defalias 'lsp-send-request 'lsp--send-request - "Send BODY as a request to the language server and return the response -synchronously. -\n(fn BODY)") - -(cl-defun lsp-request (method params &key no-wait no-merge) - "Send request METHOD with PARAMS. -If NO-MERGE is non-nil, don't merge the results but return alist -workspace->result. -If NO-WAIT is non-nil send the request as notification." - (if no-wait - (lsp-notify method params) - (let* ((send-time (float-time)) - ;; max time by which we must get a response - (expected-time - (and - lsp-response-timeout - (+ send-time lsp-response-timeout))) - resp-result resp-error done?) - (unwind-protect - (progn - (lsp-request-async method params - (lambda (res) (setf resp-result (or res :finished)) (throw 'lsp-done '_)) - :error-handler (lambda (err) (setf resp-error err) (throw 'lsp-done '_)) - :no-merge no-merge - :mode 'detached - :cancel-token :sync-request) - (while (not (or resp-error resp-result)) - (if (functionp 'json-rpc-connection) - (catch 'lsp-done (sit-for 0.01)) - (catch 'lsp-done - (accept-process-output - nil - (if expected-time (- expected-time send-time) 1)))) - (setq send-time (float-time)) - (when (and expected-time (< expected-time send-time)) - (error "Timeout while waiting for response. Method: %s" method))) - (setq done? t) - (cond - ((eq resp-result :finished) nil) - (resp-result resp-result) - ((lsp-json-error? resp-error) (error (lsp:json-error-message resp-error))) - ((lsp-json-error? (cl-first resp-error)) - (error (lsp:json-error-message (cl-first resp-error)))))) - (unless done? - (lsp-cancel-request-by-token :sync-request)))))) - -(cl-defun lsp-request-while-no-input (method params) - "Send request METHOD with PARAMS and waits until there is no input. -Return same value as `lsp--while-no-input' and respecting `non-essential'." - (if (or non-essential (not lsp-request-while-no-input-may-block)) - (let* ((send-time (float-time)) - ;; max time by which we must get a response - (expected-time - (and - lsp-response-timeout - (+ send-time lsp-response-timeout))) - resp-result resp-error done?) - (unwind-protect - (progn - (lsp-request-async method params - (lambda (res) (setf resp-result (or res :finished)) (throw 'lsp-done '_)) - :error-handler (lambda (err) (setf resp-error err) (throw 'lsp-done '_)) - :mode 'detached - :cancel-token :sync-request) - (while (not (or resp-error resp-result (input-pending-p))) - (catch 'lsp-done - (sit-for - (if expected-time (- expected-time send-time) 1))) - (setq send-time (float-time)) - (when (and expected-time (< expected-time send-time)) - (error "Timeout while waiting for response. Method: %s" method))) - (setq done? (or resp-error resp-result)) - (cond - ((eq resp-result :finished) nil) - (resp-result resp-result) - ((lsp-json-error? resp-error) (error (lsp:json-error-message resp-error))) - ((lsp-json-error? (cl-first resp-error)) - (error (lsp:json-error-message (cl-first resp-error)))))) - (unless done? - (lsp-cancel-request-by-token :sync-request)) - (when (and (input-pending-p) lsp--throw-on-input) - (throw 'input :interrupted)))) - (lsp-request method params))) - -(defvar lsp--cancelable-requests (ht)) - -(cl-defun lsp-request-async (method params callback - &key mode error-handler cancel-handler no-merge cancel-token) - "Send METHOD with PARAMS as a request to the language server. -Call CALLBACK with the response received from the server -asynchronously. -MODE determines when the callback will be called depending on the -condition of the original buffer. It could be: -- `detached' which means that the callback will be executed no -matter what has happened to the buffer. -- `alive' - the callback will be executed only if the buffer from -which the call was executed is still alive. -- `current' the callback will be executed only if the original buffer -is still selected. -- `tick' - the callback will be executed only if the buffer was not modified. -- `unchanged' - the callback will be executed only if the buffer hasn't -changed and if the buffer is not modified. - -ERROR-HANDLER will be called in case the request has failed. -CANCEL-HANDLER will be called in case the request is being canceled. -If NO-MERGE is non-nil, don't merge the results but return alist -workspace->result. -CANCEL-TOKEN is the token that can be used to cancel request." - (lsp--send-request-async `(:jsonrpc "2.0" :method ,method :params ,params) - callback mode error-handler cancel-handler no-merge cancel-token)) - -(defun lsp--create-request-cancel (id workspaces hook buf method cancel-callback) - (lambda (&rest _) - (unless (and (equal 'post-command-hook hook) - (equal (current-buffer) buf)) - (lsp--request-cleanup-hooks id) - (with-lsp-workspaces workspaces - (lsp--cancel-request id) - (when cancel-callback (funcall cancel-callback))) - (lsp-log "Cancelling %s(%s) in hook %s" method id hook)))) - -(defun lsp--create-async-callback - (callback method no-merge workspaces) - "Create async handler expecting COUNT results, merge them and call CALLBACK. -MODE determines when the callback will be called depending on the -condition of the original buffer. METHOD is the invoked method. -If NO-MERGE is non-nil, don't merge the results but return alist -workspace->result. ID is the request id." - (let (results errors) - (lambda (result) - (push (cons lsp--cur-workspace result) - (if (eq result :error) errors results)) - (when (and (not (eq (length errors) (length workspaces))) - (eq (+ (length errors) (length results)) (length workspaces))) - (funcall callback - (if no-merge - results - (lsp--merge-results (-map #'cl-rest results) method))))))) - -(defcustom lsp-default-create-error-handler-fn nil - "Default error handler customization. -Handler should give METHOD as argument and return function of one argument -ERROR." - :type 'function - :group 'lsp-mode - :package-version '(lsp-mode . "9.0.0")) - -(defun lsp--create-default-error-handler (method) - "Default error handler. -METHOD is the executed method." - (if lsp-default-create-error-handler-fn - (funcall lsp-default-create-error-handler-fn method) - (lambda (error) - (lsp--warn "%s" (or (lsp--error-string error) - (format "%s Request has failed" method)))))) - -(defvar lsp--request-cleanup-hooks (ht)) - -(defun lsp--request-cleanup-hooks (request-id) - (when-let ((cleanup-function (gethash request-id lsp--request-cleanup-hooks))) - (funcall cleanup-function) - (remhash request-id lsp--request-cleanup-hooks))) - -(defun lsp-cancel-request-by-token (cancel-token) - "Cancel request using CANCEL-TOKEN." - (-when-let ((request-id . workspaces) (gethash cancel-token lsp--cancelable-requests)) - (with-lsp-workspaces workspaces - (lsp--cancel-request request-id)) - (remhash cancel-token lsp--cancelable-requests) - (lsp--request-cleanup-hooks request-id))) - -(defun lsp--send-request-async (body callback - &optional mode error-callback cancel-callback - no-merge cancel-token) - "Send BODY as a request to the language server. -Call CALLBACK with the response received from the server -asynchronously. -MODE determines when the callback will be called depending on the -condition of the original buffer. It could be: -- `detached' which means that the callback will be executed no -matter what has happened to the buffer. -- `alive' - the callback will be executed only if the buffer from -which the call was executed is still alive. -- `current' the callback will be executed only if the original buffer -is still selected. -- `tick' - the callback will be executed only if the buffer was not modified. -- `unchanged' - the callback will be executed only if the buffer hasn't -changed and if the buffer is not modified. - -ERROR-CALLBACK will be called in case the request has failed. -CANCEL-CALLBACK will be called in case the request is being canceled. -If NO-MERGE is non-nil, don't merge the results but return alist -workspace->result. -CANCEL-TOKEN is the token that can be used to cancel request." - (when cancel-token - (lsp-cancel-request-by-token cancel-token)) - - (if-let ((target-workspaces (lsp--find-workspaces-for body))) - (let* ((start-time (current-time)) - (method (plist-get body :method)) - (id (cl-incf lsp-last-id)) - (buf (current-buffer)) - (cancel-callback (when cancel-callback - (pcase mode - ((or 'alive 'tick 'unchanged) - (lambda () - (with-current-buffer buf - (funcall cancel-callback)))) - (_ cancel-callback)))) - ;; calculate what are the (hook . local) pairs which will cancel - ;; the request - (hooks (pcase mode - ('alive '((kill-buffer-hook . t))) - ('tick '((kill-buffer-hook . t) (after-change-functions . t))) - ('unchanged '((after-change-functions . t) (post-command-hook . nil))) - ('current '((post-command-hook . nil))))) - ;; note: lambdas in emacs can be compared but we should make sure - ;; that all of the captured arguments are the same - in our case - ;; `lsp--create-request-cancel' will return the same lambda when - ;; called with the same params. - (cleanup-hooks - (lambda () (mapc - (-lambda ((hook . local)) - (if local - (when (buffer-live-p buf) - (with-current-buffer buf - (remove-hook hook - (lsp--create-request-cancel - id target-workspaces hook buf method cancel-callback) - t))) - (remove-hook hook (lsp--create-request-cancel - id target-workspaces hook buf method cancel-callback)))) - hooks) - (remhash cancel-token lsp--cancelable-requests))) - (callback (pcase mode - ((or 'alive 'tick 'unchanged) (lambda (&rest args) - (with-current-buffer buf - (apply callback args)))) - (_ callback))) - (callback (lsp--create-async-callback callback - method - no-merge - target-workspaces)) - (callback (lambda (result) - (lsp--request-cleanup-hooks id) - (funcall callback result))) - (error-callback (lsp--create-async-callback - (or error-callback - (lsp--create-default-error-handler method)) - method - nil - target-workspaces)) - (error-callback (lambda (error) - (funcall callback :error) - (lsp--request-cleanup-hooks id) - (funcall error-callback error))) - (body (plist-put body :id id))) - - ;; cancel request in any of the hooks - (mapc (-lambda ((hook . local)) - (add-hook hook - (lsp--create-request-cancel - id target-workspaces hook buf method cancel-callback) - nil local)) - hooks) - (puthash id cleanup-hooks lsp--request-cleanup-hooks) - - (setq lsp--last-active-workspaces target-workspaces) - - (when cancel-token - (puthash cancel-token (cons id target-workspaces) lsp--cancelable-requests)) - - (seq-doseq (workspace target-workspaces) - (when (lsp--log-io-p method) - (lsp--log-entry-new (lsp--make-log-entry method id - (plist-get body :params) - 'outgoing-req) - workspace)) - (puthash id - (list callback error-callback method start-time (current-time)) - (-> workspace - (lsp--workspace-client) - (lsp--client-response-handlers))) - (lsp--send-no-wait body (lsp--workspace-proc workspace))) - body) - (error "The connected server(s) does not support method %s. -To find out what capabilities support your server use `M-x lsp-describe-session' -and expand the capabilities section" - (plist-get body :method)))) - -;; deprecated, use lsp-request-async. -(defalias 'lsp-send-request-async 'lsp--send-request-async) -(make-obsolete 'lsp-send-request-async 'lsp-request-async "lsp-mode 7.0.1") - -;; Clean up the entire state of lsp mode when Emacs is killed, to get rid of any -;; pending language servers. -(add-hook 'kill-emacs-hook #'lsp--global-teardown) - -(defun lsp--global-teardown () - "Unload working workspaces." - (lsp-foreach-workspace (lsp--shutdown-workspace))) - -(defun lsp--shutdown-workspace (&optional restart) - "Shut down the language server process for ‘lsp--cur-workspace’." - (with-demoted-errors "LSP error: %S" - (let ((lsp-response-timeout 0.5)) - (condition-case err - (lsp-request "shutdown" nil) - (error (lsp--error "%s" err)))) - (lsp-notify "exit" nil)) - (setf (lsp--workspace-shutdown-action lsp--cur-workspace) (or (and restart 'restart) 'shutdown)) - (lsp--uninitialize-workspace)) - -(defcustom lsp-inlay-hint-enable nil - "If non-nil it will enable inlay hints." - :type 'boolean - :group 'lsp-mode - :package-version '(lsp-mode . "9.0.0")) - -(defun lsp--uninitialize-workspace () - "Cleanup buffer state. -When a workspace is shut down, by request or from just -disappearing, unset all the variables related to it." - (-let [(&lsp-wks 'cmd-proc 'buffers) lsp--cur-workspace] - (lsp-process-kill cmd-proc) - (mapc (lambda (buf) - (when (lsp-buffer-live-p buf) - (lsp-with-current-buffer buf - (lsp-managed-mode -1)))) - buffers) - (lsp-diagnostics--workspace-cleanup lsp--cur-workspace))) - -(defun lsp--client-capabilities (&optional custom-capabilities) - "Return the client capabilities appending CUSTOM-CAPABILITIES." - (append - `((general . ((positionEncodings . ["utf-32", "utf-16"]))) - (workspace . ((workspaceEdit . ((documentChanges . t) - (resourceOperations . ["create" "rename" "delete"]))) - (applyEdit . t) - (symbol . ((symbolKind . ((valueSet . ,(apply 'vector (number-sequence 1 26))))))) - (executeCommand . ((dynamicRegistration . :json-false))) - ,@(when lsp-enable-file-watchers '((didChangeWatchedFiles . ((dynamicRegistration . t))))) - (workspaceFolders . t) - (configuration . t) - ,@(when lsp-semantic-tokens-enable - `((semanticTokens . ((refreshSupport . ,(or (and (boundp 'lsp-semantic-tokens-honor-refresh-requests) - lsp-semantic-tokens-honor-refresh-requests) - :json-false)))))) - ,@(when lsp-lens-enable '((codeLens . ((refreshSupport . t))))) - ,@(when lsp-inlay-hint-enable '((inlayHint . ((refreshSupport . :json-false))))) - (diagnostics . ((refreshSupport . :json-false))) - (fileOperations . ((didCreate . :json-false) - (willCreate . :json-false) - (didRename . t) - (willRename . t) - (didDelete . :json-false) - (willDelete . :json-false))))) - (textDocument . ((declaration . ((dynamicRegistration . t) - (linkSupport . t))) - (definition . ((dynamicRegistration . t) - (linkSupport . t))) - (references . ((dynamicRegistration . t))) - (implementation . ((dynamicRegistration . t) - (linkSupport . t))) - (typeDefinition . ((dynamicRegistration . t) - (linkSupport . t))) - (synchronization . ((willSave . t) (didSave . t) (willSaveWaitUntil . t))) - (documentSymbol . ((symbolKind . ((valueSet . ,(apply 'vector (number-sequence 1 26))))) - (hierarchicalDocumentSymbolSupport . t))) - (formatting . ((dynamicRegistration . t))) - (rangeFormatting . ((dynamicRegistration . t))) - (onTypeFormatting . ((dynamicRegistration . t))) - ,@(when (and lsp-semantic-tokens-enable - (functionp 'lsp--semantic-tokens-capabilities)) - (lsp--semantic-tokens-capabilities)) - (rename . ((dynamicRegistration . t) (prepareSupport . t))) - (codeAction . ((dynamicRegistration . t) - (isPreferredSupport . t) - (codeActionLiteralSupport . ((codeActionKind . ((valueSet . ["" - "quickfix" - "refactor" - "refactor.extract" - "refactor.inline" - "refactor.rewrite" - "source" - "source.organizeImports"]))))) - (resolveSupport . ((properties . ["edit" "command"]))) - (dataSupport . t))) - (completion . ((completionItem . ((snippetSupport . ,(cond - ((and lsp-enable-snippet (not (fboundp 'yas-minor-mode))) - (lsp--warn (concat - "Yasnippet is not installed, but `lsp-enable-snippet' is set to `t'. " - "You must either install yasnippet, or disable snippet support.")) - :json-false) - (lsp-enable-snippet t) - (t :json-false))) - (documentationFormat . ["markdown" "plaintext"]) - ;; Remove this after jdtls support resolveSupport - (resolveAdditionalTextEditsSupport . t) - (insertReplaceSupport . t) - (deprecatedSupport . t) - (resolveSupport - . ((properties . ["documentation" - "detail" - "additionalTextEdits" - "command" - "insertTextFormat" - "insertTextMode"]))) - (insertTextModeSupport . ((valueSet . [1 2]))))) - (contextSupport . t) - (dynamicRegistration . t))) - (signatureHelp . ((signatureInformation . ((parameterInformation . ((labelOffsetSupport . t))))) - (dynamicRegistration . t))) - (documentLink . ((dynamicRegistration . t) - (tooltipSupport . t))) - (hover . ((contentFormat . ["markdown" "plaintext"]) - (dynamicRegistration . t))) - ,@(when lsp-enable-folding - `((foldingRange . ((dynamicRegistration . t) - ,@(when lsp-folding-range-limit - `((rangeLimit . ,lsp-folding-range-limit))) - ,@(when lsp-folding-line-folding-only - `((lineFoldingOnly . t))))))) - (selectionRange . ((dynamicRegistration . t))) - (callHierarchy . ((dynamicRegistration . :json-false))) - (typeHierarchy . ((dynamicRegistration . t))) - (publishDiagnostics . ((relatedInformation . t) - (tagSupport . ((valueSet . [1 2]))) - (versionSupport . t))) - (diagnostic . ((dynamicRegistration . :json-false) - (relatedDocumentSupport . :json-false))) - (linkedEditingRange . ((dynamicRegistration . t))))) - (window . ((workDoneProgress . t) - (showDocument . ((support . t)))))) - custom-capabilities)) - -(defun lsp-find-roots-for-workspace (workspace session) - "Get all roots for the WORKSPACE." - (-filter #'identity (ht-map (lambda (folder workspaces) - (when (-contains? workspaces workspace) - folder)) - (lsp-session-folder->servers session)))) - -(defun lsp-session-watches (&optional session) - "Get watches created for SESSION." - (or (gethash "__watches" (lsp-session-metadata (or session (lsp-session)))) - (-let [res (make-hash-table :test 'equal)] - (puthash "__watches" res (lsp-session-metadata (or session (lsp-session)))) - res))) - -(defun lsp--file-process-event (session root-folder event) - "Process file event." - (let* ((changed-file (cl-third event)) - (rel-changed-file (f-relative changed-file root-folder)) - (event-numeric-kind (alist-get (cl-second event) lsp--file-change-type)) - (bit-position (1- event-numeric-kind)) - (watch-bit (ash 1 bit-position))) - (->> - session - lsp-session-folder->servers - (gethash root-folder) - (seq-do (lambda (workspace) - (when (->> - workspace - lsp--workspace-registered-server-capabilities - (-any? - (lambda (capability) - (and - (equal (lsp--registered-capability-method capability) - "workspace/didChangeWatchedFiles") - (->> - capability - lsp--registered-capability-options - (lsp:did-change-watched-files-registration-options-watchers) - (seq-find - (-lambda ((fs-watcher &as &FileSystemWatcher :glob-pattern :kind? :_cachedRegexp cached-regexp)) - (when (or (null kind?) - (> (logand kind? watch-bit) 0)) - (-let [regexes (or cached-regexp - (let ((regexp (lsp-glob-to-regexps glob-pattern))) - (lsp-put fs-watcher :_cachedRegexp regexp) - regexp))] - (-any? (lambda (re) - (or (string-match re changed-file) - (string-match re rel-changed-file))) - regexes)))))))))) - (with-lsp-workspace workspace - (lsp-notify - "workspace/didChangeWatchedFiles" - `((changes . [((type . ,event-numeric-kind) - (uri . ,(lsp--path-to-uri changed-file)))])))))))))) - -(lsp-defun lsp--server-register-capability ((&Registration :method :id :register-options?)) - "Register capability REG." - (when (and lsp-enable-file-watchers - (equal method "workspace/didChangeWatchedFiles")) - (-let* ((created-watches (lsp-session-watches (lsp-session))) - (root-folders (cl-set-difference - (lsp-find-roots-for-workspace lsp--cur-workspace (lsp-session)) - (ht-keys created-watches)))) - ;; create watch for each root folder without such - (dolist (folder root-folders) - (let* ((watch (make-lsp-watch :root-directory folder)) - (ignored-things (lsp--get-ignored-regexes-for-workspace-root folder)) - (ignored-files-regex-list (car ignored-things)) - (ignored-directories-regex-list (cadr ignored-things))) - (puthash folder watch created-watches) - (lsp-watch-root-folder (file-truename folder) - (-partial #'lsp--file-process-event (lsp-session) folder) - ignored-files-regex-list - ignored-directories-regex-list - watch - t))))) - - (push - (make-lsp--registered-capability :id id :method method :options register-options?) - (lsp--workspace-registered-server-capabilities lsp--cur-workspace))) - -(defmacro lsp--with-workspace-temp-buffer (workspace-root &rest body) - "With a temp-buffer under `WORKSPACE-ROOT' and evaluate `BODY', useful to -access dir-local variables." - (declare (indent 1) (debug t)) - `(with-temp-buffer - ;; Set the buffer's name to something under the root so that we can hack the local variables - ;; This file doesn't need to exist and will not be created due to this. - (setq-local buffer-file-name (expand-file-name "lsp-mode-temp" (expand-file-name ,workspace-root))) - (hack-local-variables) - (prog1 ,@body - (setq-local buffer-file-name nil)))) - -(defun lsp--get-ignored-regexes-for-workspace-root (workspace-root) - "Return a list of the form -(lsp-file-watch-ignored-files lsp-file-watch-ignored-directories) for the given -WORKSPACE-ROOT." - ;; The intent of this function is to provide per-root workspace-level customization of the - ;; lsp-file-watch-ignored-directories and lsp-file-watch-ignored-files variables. - (lsp--with-workspace-temp-buffer workspace-root - (list lsp-file-watch-ignored-files (lsp-file-watch-ignored-directories)))) - - -(defun lsp--cleanup-hanging-watches () - "Cleanup watches in case there are no more workspaces that are interested -in that particular folder." - (let* ((session (lsp-session)) - (watches (lsp-session-watches session))) - (dolist (watched-folder (ht-keys watches)) - (when (-none? (lambda (workspace) - (with-lsp-workspace workspace - (lsp--registered-capability "workspace/didChangeWatchedFiles"))) - (gethash watched-folder (lsp-session-folder->servers (lsp-session)))) - (lsp-log "Cleaning up watches for folder %s. There is no workspace watching this folder..." watched-folder) - (lsp-kill-watch (gethash watched-folder watches)) - (remhash watched-folder watches))))) - -(lsp-defun lsp--server-unregister-capability ((&Unregistration :id :method)) - "Unregister capability UNREG." - (setf (lsp--workspace-registered-server-capabilities lsp--cur-workspace) - (seq-remove (lambda (e) (equal (lsp--registered-capability-id e) id)) - (lsp--workspace-registered-server-capabilities lsp--cur-workspace))) - (when (equal method "workspace/didChangeWatchedFiles") - (lsp--cleanup-hanging-watches))) - -(defun lsp--server-capabilities () - "Return the capabilities of the language server associated with the buffer." - (->> (lsp-workspaces) - (-keep #'lsp--workspace-server-capabilities) - (apply #'lsp-merge))) - -(defun lsp--send-open-close-p () - "Return whether open and close notifications should be sent to the server." - (let ((sync (lsp:server-capabilities-text-document-sync? (lsp--server-capabilities)))) - (or (memq sync '(1 2)) - (lsp:text-document-sync-options-open-close? sync)))) - -(defun lsp--send-will-save-p () - "Return whether willSave notifications should be sent to the server." - (-> (lsp--server-capabilities) - (lsp:server-capabilities-text-document-sync?) - (lsp:text-document-sync-options-will-save?))) - -(defun lsp--send-will-save-wait-until-p () - "Return whether willSaveWaitUntil notifications should be sent to the server." - (-> (lsp--server-capabilities) - (lsp:server-capabilities-text-document-sync?) - (lsp:text-document-sync-options-will-save-wait-until?))) - -(defun lsp--send-did-save-p () - "Return whether didSave notifications should be sent to the server." - (let ((sync (lsp:server-capabilities-text-document-sync? (lsp--server-capabilities)))) - (or (memq sync '(1 2)) - (lsp:text-document-sync-options-save? sync)))) - -(defun lsp--save-include-text-p () - "Return whether save notifications should include the text document's contents." - (->> (lsp--server-capabilities) - (lsp:server-capabilities-text-document-sync?) - (lsp:text-document-sync-options-save?) - (lsp:text-document-save-registration-options-include-text?))) - -(defun lsp--send-will-rename-files-p (path) - "Return whether willRenameFiles request should be sent to the server. -If any filters, checks if it applies for PATH." - (let* ((will-rename (-> (lsp--server-capabilities) - (lsp:server-capabilities-workspace?) - (lsp:workspace-server-capabilities-file-operations?) - (lsp:workspace-file-operations-will-rename?))) - (filters (seq-into (lsp:file-operation-registration-options-filters will-rename) 'list))) - (and will-rename - (or (seq-empty-p filters) - (-any? (-lambda ((&FileOperationFilter :scheme? :pattern (&FileOperationPattern :glob))) - (-let [regexes (lsp-glob-to-regexps glob)] - (and (or (not scheme?) - (string-prefix-p scheme? (lsp--path-to-uri path))) - (-any? (lambda (re) - (string-match re path)) - regexes)))) - filters))))) - -(defun lsp--send-did-rename-files-p () - "Return whether didRenameFiles notification should be sent to the server." - (-> (lsp--server-capabilities) - (lsp:server-capabilities-workspace?) - (lsp:workspace-server-capabilities-file-operations?) - (lsp:workspace-file-operations-did-rename?))) - -(declare-function project-roots "ext:project" (project) t) -(declare-function project-root "ext:project" (project) t) - -(defun lsp--suggest-project-root () - "Get project root." - (or - (when (fboundp 'projectile-project-root) - (condition-case nil - (projectile-project-root) - (error nil))) - (when (fboundp 'project-current) - (when-let ((project (project-current))) - (if (fboundp 'project-root) - (project-root project) - (car (with-no-warnings - (project-roots project)))))) - default-directory)) - -(defun lsp--read-from-file (file) - "Read FILE content." - (when (file-exists-p file) - (cl-first (read-from-string (f-read-text file 'utf-8))))) - -(defun lsp--persist (file-name to-persist) - "Persist TO-PERSIST in FILE-NAME. - -This function creates the parent directories if they don't exist -yet." - (let ((print-length nil) - (print-level nil)) - ;; Create all parent directories: - (make-directory (f-parent file-name) t) - (f-write-text (prin1-to-string to-persist) 'utf-8 file-name))) - -(defun lsp-workspace-folders-add (project-root) - "Add PROJECT-ROOT to the list of workspace folders." - (interactive - (list (read-directory-name "Select folder to add: " - (or (lsp--suggest-project-root) default-directory) nil t))) - (cl-pushnew (lsp-f-canonical project-root) - (lsp-session-folders (lsp-session)) :test 'equal) - (lsp--persist-session (lsp-session)) - - (run-hook-with-args 'lsp-workspace-folders-changed-functions (list project-root) nil)) - -(defun lsp-workspace-folders-remove (project-root) - "Remove PROJECT-ROOT from the list of workspace folders." - (interactive (list (completing-read "Select folder to remove: " - (lsp-session-folders (lsp-session)) - nil t nil nil - (lsp-find-session-folder (lsp-session) default-directory)))) - - (setq project-root (lsp-f-canonical project-root)) - - ;; send remove folder to each multiroot workspace associated with the folder - (dolist (wks (->> (lsp-session) - (lsp-session-folder->servers) - (gethash project-root) - (--filter (lsp--client-multi-root (lsp--workspace-client it))))) - (with-lsp-workspace wks - (lsp-notify "workspace/didChangeWorkspaceFolders" - (lsp-make-did-change-workspace-folders-params - :event (lsp-make-workspace-folders-change-event - :removed (vector (lsp-make-workspace-folder - :uri (lsp--path-to-uri project-root) - :name (f-filename project-root))) - :added []))))) - - ;; turn off servers in the removed directory - (let* ((session (lsp-session)) - (folder->servers (lsp-session-folder->servers session)) - (server-id->folders (lsp-session-server-id->folders session)) - (workspaces (gethash project-root folder->servers))) - - (remhash project-root folder->servers) - - ;; turn off the servers without root folders - (dolist (workspace workspaces) - (when (--none? (-contains? it workspace) (ht-values folder->servers)) - (lsp--info "Shutdown %s since folder %s is removed..." - (lsp--workspace-print workspace) project-root) - (with-lsp-workspace workspace (lsp--shutdown-workspace)))) - - (setf (lsp-session-folders session) - (-remove-item project-root (lsp-session-folders session))) - - (ht-aeach (puthash key - (-remove-item project-root value) - server-id->folders) - server-id->folders) - (lsp--persist-session (lsp-session))) - - (run-hook-with-args 'lsp-workspace-folders-changed-functions nil (list project-root))) - -(defun lsp-workspace-blocklist-remove (project-root) - "Remove PROJECT-ROOT from the workspace blocklist." - (interactive (list (completing-read "Select folder to remove:" - (lsp-session-folders-blocklist (lsp-session)) - nil t))) - (setf (lsp-session-folders-blocklist (lsp-session)) - (delete project-root - (lsp-session-folders-blocklist (lsp-session)))) - (lsp--persist-session (lsp-session))) - -(define-obsolete-function-alias 'lsp-workspace-folders-switch - 'lsp-workspace-folders-open "lsp-mode 6.1") - -(defun lsp-workspace-folders-open (project-root) - "Open the directory located at PROJECT-ROOT" - (interactive (list (completing-read "Open folder: " - (lsp-session-folders (lsp-session)) - nil t))) - (find-file project-root)) - -(defun lsp--maybe-enable-signature-help (trigger-characters) - (let ((ch last-command-event)) - (when (cl-find ch trigger-characters :key #'string-to-char) - (lsp-signature-activate)))) - -(defun lsp--on-type-formatting-handler-create () - (when-let ((provider (lsp--capability-for-method "textDocument/onTypeFormatting" ))) - (-let [(&DocumentOnTypeFormattingOptions :more-trigger-character? - :first-trigger-character) provider] - (lambda () - (lsp--on-type-formatting first-trigger-character - more-trigger-character?))))) - -(defun lsp--update-on-type-formatting-hook (&optional cleanup?) - (let ((on-type-formatting-handler (lsp--on-type-formatting-handler-create))) - (cond - ((and lsp-enable-on-type-formatting on-type-formatting-handler (not cleanup?)) - (add-hook 'post-self-insert-hook on-type-formatting-handler nil t)) - ((or cleanup? - (not lsp-enable-on-type-formatting)) - (remove-hook 'post-self-insert-hook on-type-formatting-handler t))))) - -(defun lsp--signature-help-handler-create () - (-when-let ((&SignatureHelpOptions? :trigger-characters?) - (lsp--capability-for-method "textDocument/signatureHelp")) - (lambda () - (lsp--maybe-enable-signature-help trigger-characters?)))) - -(defun lsp--update-signature-help-hook (&optional cleanup?) - (let ((signature-help-handler (lsp--signature-help-handler-create))) - (cond - ((and (or (equal lsp-signature-auto-activate t) - (memq :on-trigger-char lsp-signature-auto-activate)) - signature-help-handler - (not cleanup?)) - (add-hook 'post-self-insert-hook signature-help-handler nil t)) - - ((or cleanup? - (not (or (equal lsp-signature-auto-activate t) - (memq :on-trigger-char lsp-signature-auto-activate)))) - (remove-hook 'post-self-insert-hook signature-help-handler t))))) - -(defun lsp--after-set-visited-file-name () - (lsp-disconnect) - (lsp)) - -;; TODO remove those eldoc workarounds when dropping support for Emacs 27 -;; https://github.com/emacs-lsp/lsp-mode/issues/3295#issuecomment-1308994099 -(defvar eldoc-documentation-default) ; CI -(when (< emacs-major-version 28) - (unless (boundp 'eldoc-documentation-functions) - (load "eldoc" nil 'nomessage)) - (when (memq (default-value 'eldoc-documentation-function) '(nil ignore)) - ;; actually `eldoc-documentation-strategy', but CI was failing - (setq-default eldoc-documentation-function 'eldoc-documentation-default))) - -(define-minor-mode lsp-managed-mode - "Mode for source buffers managed by lsp-mode." - :lighter nil - (cond - (lsp-managed-mode - (when (lsp-feature? "textDocument/hover") - (add-hook 'eldoc-documentation-functions #'lsp-eldoc-function nil t) - (eldoc-mode 1)) - - (add-hook 'after-change-functions #'lsp-on-change nil t) - (add-hook 'after-revert-hook #'lsp-on-revert nil t) - (add-hook 'after-save-hook #'lsp-on-save nil t) - (add-hook 'auto-save-hook #'lsp--on-auto-save nil t) - (add-hook 'before-change-functions #'lsp-before-change nil t) - (add-hook 'before-save-hook #'lsp--before-save nil t) - (add-hook 'kill-buffer-hook #'lsp--text-document-did-close nil t) - (add-hook 'post-command-hook #'lsp--post-command nil t) - - (lsp--update-on-type-formatting-hook) - (lsp--update-signature-help-hook) - - (when lsp-enable-xref - (add-hook 'xref-backend-functions #'lsp--xref-backend nil t)) - - (lsp-configure-buffer) - - ;; make sure we turn off lsp-mode in case major mode changes, because major - ;; mode change will wipe the buffer locals. - (add-hook 'change-major-mode-hook #'lsp-disconnect nil t) - (add-hook 'after-set-visited-file-name-hook #'lsp--after-set-visited-file-name nil t) - - (let ((buffer (lsp-current-buffer))) - (run-with-idle-timer - 0.0 nil - (lambda () - (when (lsp-buffer-live-p buffer) - (lsp-with-current-buffer buffer - (lsp--on-change-debounce buffer) - (lsp--on-idle buffer))))))) - (t - (lsp-unconfig-buffer) - - (remove-hook 'eldoc-documentation-functions #'lsp-eldoc-function t) - (remove-hook 'post-command-hook #'lsp--post-command t) - (remove-hook 'after-change-functions #'lsp-on-change t) - (remove-hook 'after-revert-hook #'lsp-on-revert t) - (remove-hook 'after-save-hook #'lsp-on-save t) - (remove-hook 'auto-save-hook #'lsp--on-auto-save t) - (remove-hook 'before-change-functions #'lsp-before-change t) - (remove-hook 'before-save-hook #'lsp--before-save t) - (remove-hook 'kill-buffer-hook #'lsp--text-document-did-close t) - - (lsp--update-on-type-formatting-hook :cleanup) - (lsp--update-signature-help-hook :cleanup) - - (when lsp--on-idle-timer - (cancel-timer lsp--on-idle-timer) - (setq lsp--on-idle-timer nil)) - - (remove-hook 'lsp-on-idle-hook #'lsp--document-links t) - (remove-hook 'lsp-on-idle-hook #'lsp--document-highlight t) - - (lsp--remove-overlays 'lsp-highlight) - (lsp--remove-overlays 'lsp-links) - - (remove-hook 'xref-backend-functions #'lsp--xref-backend t) - (remove-hook 'change-major-mode-hook #'lsp-disconnect t) - (remove-hook 'after-set-visited-file-name-hook #'lsp--after-set-visited-file-name t) - (setq-local lsp-buffer-uri nil)))) - -(defun lsp-configure-buffer () - "Configure LSP features for current buffer." - ;; make sure the core is running in the context of all available workspaces - ;; to avoid misconfiguration in case we are running in `with-lsp-workspace' context - (let ((lsp--buffer-workspaces (cond - (lsp--buffer-workspaces) - (lsp--cur-workspace (list lsp--cur-workspace)))) - lsp--cur-workspace) - (when lsp-auto-configure - (lsp--auto-configure) - - (when (and lsp-enable-text-document-color - (lsp-feature? "textDocument/documentColor")) - (add-hook 'lsp-on-change-hook #'lsp--document-color nil t)) - - (when (and lsp-enable-imenu - (lsp-feature? "textDocument/documentSymbol")) - (lsp-enable-imenu)) - - (when (and lsp-enable-indentation - (lsp-feature? "textDocument/rangeFormatting")) - (add-function :override (local 'indent-region-function) #'lsp-format-region)) - - (when (and lsp-enable-symbol-highlighting - (lsp-feature? "textDocument/documentHighlight")) - (add-hook 'lsp-on-idle-hook #'lsp--document-highlight nil t)) - - (when (and lsp-enable-links - (lsp-feature? "textDocument/documentLink")) - (add-hook 'lsp-on-idle-hook #'lsp--document-links nil t)) - - (when (and lsp-inlay-hint-enable - (lsp-feature? "textDocument/inlayHint")) - (lsp-inlay-hints-mode)) - - (when (and lsp-enable-dap-auto-configure - (functionp 'dap-mode)) - (dap-auto-configure-mode 1))) - (run-hooks 'lsp-configure-hook))) - -(defun lsp-unconfig-buffer () - "Unconfigure LSP features for buffer." - (lsp--remove-overlays 'lsp-color) - - (when (advice-function-member-p 'lsp--imenu-create-index imenu-create-index-function) - (remove-function (local 'imenu-create-index-function) #'lsp--imenu-create-index) - (setq-local imenu-menubar-modified-tick 0) - (setq-local imenu--index-alist nil) - (imenu--cleanup)) - - (remove-function (local 'indent-region-function) #'lsp-format-region) - - (remove-hook 'lsp-on-change-hook #'lsp--document-color t) - (remove-hook 'lsp-on-idle-hook #'lsp--document-highlight t) - (remove-hook 'lsp-on-idle-hook #'lsp--document-links t) - - (when (and lsp-enable-dap-auto-configure - (functionp 'dap-mode)) - (dap-auto-configure-mode -1)) - - (run-hooks 'lsp-unconfigure-hook)) - -(defun lsp--buffer-content () - (lsp-save-restriction-and-excursion - (or (lsp-virtual-buffer-call :buffer-string) - (buffer-substring-no-properties (point-min) - (point-max))))) - -(defun lsp--text-document-did-open () - "`document/didOpen' event." - (run-hooks 'lsp-before-open-hook) - (when (and lsp-auto-touch-files - (not (f-exists? (lsp--uri-to-path (lsp--buffer-uri))))) - (lsp--info "Saving file '%s' because it is not present on the disk." (lsp--buffer-uri)) - (save-buffer)) - - (setq lsp--cur-version (or lsp--cur-version 0)) - (cl-pushnew (lsp-current-buffer) (lsp--workspace-buffers lsp--cur-workspace)) - (lsp-notify - "textDocument/didOpen" - (list :textDocument - (list :uri (lsp--buffer-uri) - :languageId (lsp-buffer-language) - :version lsp--cur-version - :text (lsp--buffer-content)))) - - (lsp-managed-mode 1) - - (lsp-diagnostics--request-pull-diagnostics lsp--cur-workspace) - - (run-hooks 'lsp-after-open-hook) - (when-let ((client (-some-> lsp--cur-workspace (lsp--workspace-client)))) - (-some-> (lsp--client-after-open-fn client) - (funcall)) - (-some-> (format "lsp-%s-after-open-hook" (lsp--client-server-id client)) - (intern-soft) - (run-hooks)))) - -(defun lsp--text-document-identifier () - "Make TextDocumentIdentifier." - (list :uri (lsp--buffer-uri))) - -(defun lsp--versioned-text-document-identifier () - "Make VersionedTextDocumentIdentifier." - (plist-put (lsp--text-document-identifier) :version lsp--cur-version)) - -(defun lsp--cur-line (&optional point) - (1- (line-number-at-pos point))) - -(defun lsp--cur-position () - "Make a Position object for the current point." - (or (lsp-virtual-buffer-call :cur-position) - (lsp-save-restriction-and-excursion - (list :line (lsp--cur-line) - :character (- (point) (line-beginning-position)))))) - -(defun lsp--point-to-position (point) - "Convert POINT to Position." - (lsp-save-restriction-and-excursion - (goto-char point) - (lsp--cur-position))) - -(defun lsp--range (start end) - "Make Range body from START and END." - ;; make sure start and end are Position objects - (list :start start :end end)) - -(defun lsp--region-to-range (start end) - "Make Range object for the current region." - (lsp--range (lsp--point-to-position start) - (lsp--point-to-position end))) - -(defun lsp--region-or-line () - "The active region or the current line." - (if (use-region-p) - (lsp--region-to-range (region-beginning) (region-end)) - (lsp--region-to-range (line-beginning-position) (line-end-position)))) - -(defun lsp--check-document-changes-version (document-changes) - "Verify that DOCUMENT-CHANGES have the proper version." - (unless (seq-every-p - (-lambda ((&TextDocumentEdit :text-document)) - (or - (not text-document) - (let* ((filename (-> text-document - lsp:versioned-text-document-identifier-uri - lsp--uri-to-path)) - (version (lsp:versioned-text-document-identifier-version? text-document))) - (with-current-buffer (find-file-noselect filename) - (or (null version) (zerop version) (= -1 version) - (equal version lsp--cur-version)))))) - document-changes) - (error "Document changes cannot be applied due to different document version"))) - -(defun lsp--apply-workspace-edit (workspace-edit &optional operation) - "Apply the WorkspaceEdit object WORKSPACE-EDIT. -OPERATION is symbol representing the source of this text edit." - (-let (((&WorkspaceEdit :document-changes? :changes?) workspace-edit)) - (if-let ((document-changes (seq-reverse document-changes?))) - (progn - (lsp--check-document-changes-version document-changes) - (->> document-changes - (seq-filter (-lambda ((&CreateFile :kind)) (equal kind "create"))) - (seq-do (lambda (change) (lsp--apply-text-document-edit change operation)))) - (->> document-changes - (seq-filter (-lambda ((&CreateFile :kind)) - (and (or (not kind) (equal kind "edit")) - (not (equal kind "create"))))) - (seq-do (lambda (change) (lsp--apply-text-document-edit change operation)))) - (->> document-changes - (seq-filter (-lambda ((&CreateFile :kind)) - (and (not (or (not kind) (equal kind "edit"))) - (not (equal kind "create"))))) - (seq-do (lambda (change) (lsp--apply-text-document-edit change operation))))) - (lsp-map - (lambda (uri text-edits) - (with-current-buffer (-> uri lsp--uri-to-path find-file-noselect) - (lsp--apply-text-edits text-edits operation))) - changes?)))) - -(defmacro lsp-with-filename (file &rest body) - "Execute BODY with FILE as a context. -Need to handle the case when FILE indicates virtual buffer." - (declare (indent 1) (debug t)) - `(if-let ((lsp--virtual-buffer (get-text-property 0 'lsp-virtual-buffer ,file))) - (lsp-with-current-buffer lsp--virtual-buffer - ,@body) - ,@body)) - -(defun lsp--apply-text-document-edit (edit &optional operation) - "Apply the TextDocumentEdit object EDIT. -OPERATION is symbol representing the source of this text edit. -If the file is not being visited by any buffer, it is opened with -`find-file-noselect'. -Because lsp-mode does not store previous document versions, the edit is only -applied if the version of the textDocument matches the version of the -corresponding file. - -interface TextDocumentEdit { - textDocument: VersionedTextDocumentIdentifier; - edits: TextEdit[]; -}" - (pcase (lsp:edit-kind edit) - ("create" (-let* (((&CreateFile :uri :options?) edit) - (file-name (lsp--uri-to-path uri))) - (mkdir (f-dirname file-name) t) - (f-touch file-name) - (when (lsp:create-file-options-overwrite? options?) - (f-write-text "" nil file-name)) - (find-file-noselect file-name))) - ("delete" (-let (((&DeleteFile :uri :options? (&DeleteFileOptions? :recursive?)) edit)) - (f-delete (lsp--uri-to-path uri) recursive?))) - ("rename" (-let* (((&RenameFile :old-uri :new-uri :options? (&RenameFileOptions? :overwrite?)) edit) - (old-file-name (lsp--uri-to-path old-uri)) - (new-file-name (lsp--uri-to-path new-uri)) - (buf (find-buffer-visiting old-file-name))) - (when buf - (lsp-with-current-buffer buf - (save-buffer) - (lsp--text-document-did-close))) - (mkdir (f-dirname new-file-name) t) - (rename-file old-file-name new-file-name overwrite?) - (when buf - (lsp-with-current-buffer buf - (set-buffer-modified-p nil) - (setq lsp-buffer-uri nil) - (set-visited-file-name new-file-name) - (lsp))))) - (_ (let ((file-name (->> edit - (lsp:text-document-edit-text-document) - (lsp:versioned-text-document-identifier-uri) - (lsp--uri-to-path)))) - (lsp-with-current-buffer (find-buffer-visiting file-name) - (lsp-with-filename file-name - (lsp--apply-text-edits (lsp:text-document-edit-edits edit) operation))))))) - -(lsp-defun lsp--position-compare ((&Position :line left-line - :character left-character) - (&Position :line right-line - :character right-character)) - "Return t if position LEFT is greater than RIGHT." - (if (= left-line right-line) - (> left-character right-character) - (> left-line right-line))) - -(lsp-defun lsp-point-in-range? (position (&Range :start :end)) - "Returns if POINT is in RANGE." - (not (or (lsp--position-compare start position) - (lsp--position-compare position end)))) - -(lsp-defun lsp--position-equal ((&Position :line left-line - :character left-character) - (&Position :line right-line - :character right-character)) - "Return whether LEFT and RIGHT positions are equal." - (and (= left-line right-line) - (= left-character right-character))) - -(lsp-defun lsp--text-edit-sort-predicate ((&TextEdit :range (&Range :start left-start :end left-end)) - (&TextEdit :range (&Range :start right-start :end right-end))) - (if (lsp--position-equal left-start right-start) - (lsp--position-compare left-end right-end) - (lsp--position-compare left-start right-start))) - -(lsp-defun lsp--apply-text-edit ((edit &as &TextEdit :range (&RangeToPoint :start :end) :new-text)) - "Apply the edits described in the TextEdit object in TEXT-EDIT." - (setq new-text (s-replace "\r" "" (or new-text ""))) - (lsp:set-text-edit-new-text edit new-text) - (goto-char start) - (delete-region start end) - (insert new-text)) - -;; WORKAROUND: typescript-language might send -1 when applying code actions. -;; see https://github.com/emacs-lsp/lsp-mode/issues/1582 -(lsp-defun lsp--fix-point ((point &as &Position :character :line)) - (-doto point - (lsp:set-position-line (max 0 line)) - (lsp:set-position-character (max 0 character)))) - -(lsp-defun lsp--apply-text-edit-replace-buffer-contents ((edit &as - &TextEdit - :range (&Range :start :end) - :new-text)) - "Apply the edits described in the TextEdit object in TEXT-EDIT. -The method uses `replace-buffer-contents'." - (setq new-text (s-replace "\r" "" (or new-text ""))) - (lsp:set-text-edit-new-text edit new-text) - (-let* ((source (current-buffer)) - ((beg . end) (lsp--range-to-region (lsp-make-range :start (lsp--fix-point start) - :end (lsp--fix-point end))))) - (with-temp-buffer - (insert new-text) - (let ((temp (current-buffer))) - (with-current-buffer source - (save-excursion - (save-restriction - (narrow-to-region beg end) - - ;; On emacs versions < 26.2, - ;; `replace-buffer-contents' is buggy - it calls - ;; change functions with invalid arguments - so we - ;; manually call the change functions here. - ;; - ;; See emacs bugs #32237, #32278: - ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32237 - ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32278 - (let ((inhibit-modification-hooks t) - (length (- end beg))) - (run-hook-with-args 'before-change-functions - beg end) - (replace-buffer-contents temp) - (run-hook-with-args 'after-change-functions - beg (+ beg (length new-text)) - length))))))))) - -(defun lsp--to-yasnippet-snippet (snippet) - "Convert LSP SNIPPET to yasnippet snippet." - ;; LSP snippet doesn't escape "{" and "`", but yasnippet requires escaping it. - (replace-regexp-in-string (rx (or bos (not (any "$" "\\"))) (group (or "{" "`"))) - (rx "\\" (backref 1)) - snippet - nil nil 1)) - -(defvar-local lsp-enable-relative-indentation nil - "Enable relative indentation when insert texts, snippets ... -from language server.") - -(defun lsp--expand-snippet (snippet &optional start end expand-env) - "Wrapper of `yas-expand-snippet' with all of it arguments. -The snippet will be convert to LSP style and indent according to -LSP server result." - (require 'yasnippet nil t) - (let* ((inhibit-field-text-motion t) - (yas-wrap-around-region nil) - (yas-indent-line 'none) - (yas-also-auto-indent-first-line nil)) - (yas-expand-snippet - (lsp--to-yasnippet-snippet snippet) - start end expand-env))) - -(defun lsp--indent-lines (start end &optional insert-text-mode?) - "Indent from START to END based on INSERT-TEXT-MODE? value. -- When INSERT-TEXT-MODE? is provided - - if it's `lsp/insert-text-mode-as-it', do no editor indentation. - - if it's `lsp/insert-text-mode-adjust-indentation', adjust leading - whitespaces to match the line where text is inserted. -- When it's not provided, using `indent-line-function' for each line." - (save-excursion - (goto-char end) - (let* ((end-line (line-number-at-pos)) - (offset (save-excursion - (goto-char start) - (current-indentation))) - (indent-line-function - (cond ((equal insert-text-mode? lsp/insert-text-mode-as-it) - #'ignore) - ((or (equal insert-text-mode? lsp/insert-text-mode-adjust-indentation) - lsp-enable-relative-indentation - ;; Indenting snippets is extremely slow in `org-mode' buffers - ;; since it has to calculate indentation based on SRC block - ;; position. Thus we use relative indentation as default. - (derived-mode-p 'org-mode)) - (lambda () (save-excursion - (beginning-of-line) - (indent-to-column offset)))) - (t indent-line-function)))) - (goto-char start) - (forward-line) - (while (and (not (eobp)) - (<= (line-number-at-pos) end-line)) - (funcall indent-line-function) - (forward-line))))) - -(defun lsp--apply-text-edits (edits &optional operation) - "Apply the EDITS described in the TextEdit[] object. -OPERATION is symbol representing the source of this text edit." - (unless (seq-empty-p edits) - (atomic-change-group - (run-hooks 'lsp-before-apply-edits-hook) - (let* ((change-group (prepare-change-group)) - (howmany (length edits)) - (message (format "Applying %s edits to `%s' ..." howmany (current-buffer))) - (_ (lsp--info message)) - (reporter (make-progress-reporter message 0 howmany)) - (done 0) - (apply-edit (if (not lsp--virtual-buffer) - #'lsp--apply-text-edit-replace-buffer-contents - #'lsp--apply-text-edit))) - (unwind-protect - (->> edits - ;; We sort text edits so as to apply edits that modify latter - ;; parts of the document first. Furthermore, because the LSP - ;; spec dictates that: "If multiple inserts have the same - ;; position, the order in the array defines which edit to - ;; apply first." We reverse the initial list and sort stably - ;; to make sure the order among edits with the same position - ;; is preserved. - (nreverse) - (seq-sort #'lsp--text-edit-sort-predicate) - (mapc (lambda (edit) - (progress-reporter-update reporter (cl-incf done)) - (funcall apply-edit edit) - (when (lsp:snippet-text-edit-insert-text-format? edit) - (-when-let ((&SnippetTextEdit :range (&RangeToPoint :start) - :insert-text-format? :new-text) edit) - (when (eq insert-text-format? lsp/insert-text-format-snippet) - ;; No `save-excursion' needed since expand snippet will change point anyway - (goto-char (+ start (length new-text))) - (lsp--indent-lines start (point)) - (lsp--expand-snippet new-text start (point))))) - (run-hook-with-args 'lsp-after-apply-edits-hook operation)))) - (undo-amalgamate-change-group change-group) - (progress-reporter-done reporter)))))) - -(defun lsp--create-apply-text-edits-handlers () - "Create (handler cleanup-fn) for applying text edits in async request. -Only works when mode is `tick or `alive." - (let* (first-edited - (func (lambda (start &rest _) - (setq first-edited (if first-edited - (min start first-edited) - start))))) - (add-hook 'before-change-functions func nil t) - (list - (lambda (edits) - (if (and first-edited - (seq-find (-lambda ((&TextEdit :range (&RangeToPoint :end))) - ;; Text edit region is overlapped - (> end first-edited)) - edits)) - (lsp--warn "TextEdits will not be applied since document has been modified before of them.") - (lsp--apply-text-edits edits 'completion-cleanup))) - (lambda () - (remove-hook 'before-change-functions func t))))) - -(defun lsp--capability (cap &optional capabilities) - "Get the value of capability CAP. If CAPABILITIES is non-nil, use them instead." - (when (stringp cap) - (setq cap (intern (concat ":" cap)))) - - (lsp-get (or capabilities - (lsp--server-capabilities)) - cap)) - -(defun lsp--registered-capability (method) - "Check whether there is workspace providing METHOD." - (->> (lsp-workspaces) - (--keep (seq-find (lambda (reg) - (equal (lsp--registered-capability-method reg) method)) - (lsp--workspace-registered-server-capabilities it))) - cl-first)) - -(defun lsp--capability-for-method (method) - "Get the value of capability for METHOD." - (-let* ((reqs (cdr (assoc method lsp-method-requirements))) - ((&plist :capability) reqs)) - (or (and capability (lsp--capability capability)) - (-some-> (lsp--registered-capability method) - (lsp--registered-capability-options))))) - -(defvar-local lsp--before-change-vals nil - "Store the positions from the `lsp-before-change' function call, for -validation and use in the `lsp-on-change' function.") - -(defun lsp--text-document-content-change-event (start end length) - "Make a TextDocumentContentChangeEvent body for START to END, of length LENGTH." - ;; So (47 54 0) means add 7 chars starting at pos 47 - ;; must become - ;; {"range":{"start":{"line":5,"character":6} - ;; ,"end" :{"line":5,"character":6}} - ;; ,"rangeLength":0 - ;; ,"text":"\nbb = 5"} - ;; - ;; And (47 47 7) means delete 7 chars starting at pos 47 - ;; must become - ;; {"range":{"start":{"line":6,"character":0} - ;; ,"end" :{"line":7,"character":0}} - ;; ,"rangeLength":7 - ;; ,"text":""} - ;; - ;; (208 221 3) means delete 3 chars starting at pos 208, and replace them with - ;; 13 chars. So it must become - ;; {"range":{"start":{"line":5,"character":8} - ;; ,"end" :{"line":5,"character":11}} - ;; ,"rangeLength":3 - ;; ,"text":"new-chars-xxx"} - ;; - - ;; Adding text: - ;; lsp-before-change:(start,end)=(33,33) - ;; lsp-on-change:(start,end,length)=(33,34,0) - ;; - ;; Changing text: - ;; lsp-before-change:(start,end)=(208,211) - ;; lsp-on-change:(start,end,length)=(208,221,3) - ;; - ;; Deleting text: - ;; lsp-before-change:(start,end)=(19,27) - ;; lsp-on-change:(start,end,length)=(19,19,8) - (if (zerop length) - ;; Adding something only, work from start only - `( :range ,(lsp--range - (lsp--point-to-position start) - (lsp--point-to-position start)) - :rangeLength 0 - :text ,(buffer-substring-no-properties start end)) - - (if (eq start end) - ;; Deleting something only - (if (lsp--bracketed-change-p start length) - ;; The before-change value is bracketed, use it - `( :range ,(lsp--range - (lsp--point-to-position start) - (plist-get lsp--before-change-vals :end-pos)) - :rangeLength ,length - :text "") - ;; If the change is not bracketed, send a full change event instead. - (lsp--full-change-event)) - - ;; Deleting some things, adding others - (if (lsp--bracketed-change-p start length) - ;; The before-change value is valid, use it - `( :range ,(lsp--range - (lsp--point-to-position start) - (plist-get lsp--before-change-vals :end-pos)) - :rangeLength ,length - :text ,(buffer-substring-no-properties start end)) - (lsp--full-change-event))))) - -(defun lsp--bracketed-change-p (start length) - "If the before and after positions are the same, and the length -is the size of the start range, we are probably good." - (-let [(&plist :end before-end :start before-start) lsp--before-change-vals] - (and (eq start before-start) - (eq length (- before-end before-start))))) - -(defun lsp--full-change-event () - `(:text ,(lsp--buffer-content))) - -(defun lsp-before-change (start end) - "Executed before a file is changed. -Added to `before-change-functions'." - ;; Note: - ;; - ;; This variable holds a list of functions to call when Emacs is about to - ;; modify a buffer. Each function gets two arguments, the beginning and end of - ;; the region that is about to change, represented as integers. The buffer - ;; that is about to change is always the current buffer when the function is - ;; called. - ;; - ;; WARNING: - ;; - ;; Do not expect the before-change hooks and the after-change hooks be called - ;; in balanced pairs around each buffer change. Also don't expect the - ;; before-change hooks to be called for every chunk of text Emacs is about to - ;; delete. These hooks are provided on the assumption that Lisp programs will - ;; use either before- or the after-change hooks, but not both, and the - ;; boundaries of the region where the changes happen might include more than - ;; just the actual changed text, or even lump together several changes done - ;; piecemeal. - (save-match-data - (lsp-save-restriction-and-excursion - (setq lsp--before-change-vals - (list :start start - :end end - :end-pos (lsp--point-to-position end)))))) - -(defun lsp--flush-delayed-changes () - (let ((inhibit-quit t)) - (when lsp--delay-timer - (cancel-timer lsp--delay-timer)) - (mapc (-lambda ((workspace buffer document change)) - (with-current-buffer buffer - (with-lsp-workspace workspace - (lsp-notify "textDocument/didChange" - (list :textDocument document - :contentChanges (vector change)))))) - (prog1 (nreverse lsp--delayed-requests) - (setq lsp--delayed-requests nil))))) - -(defun lsp--workspace-sync-method (workspace) - (let ((sync (-> workspace - (lsp--workspace-server-capabilities) - (lsp:server-capabilities-text-document-sync?)))) - (if (lsp-text-document-sync-options? sync) - (lsp:text-document-sync-options-change? sync) - sync))) - -(defun lsp-on-change (start end length &optional content-change-event-fn) - "Executed when a file is changed. -Added to `after-change-functions'." - ;; Note: - ;; - ;; Each function receives three arguments: the beginning and end of the region - ;; just changed, and the length of the text that existed before the change. - ;; All three arguments are integers. The buffer that has been changed is - ;; always the current buffer when the function is called. - ;; - ;; The length of the old text is the difference between the buffer positions - ;; before and after that text as it was before the change. As for the - ;; changed text, its length is simply the difference between the first two - ;; arguments. - ;; - ;; So (47 54 0) means add 7 chars starting at pos 47 - ;; So (47 47 7) means delete 7 chars starting at pos 47 - (save-match-data - (let ((inhibit-quit t) - ;; make sure that `lsp-on-change' is called in multi-workspace context - ;; see #2901 - lsp--cur-workspace) - ;; A (revert-buffer) call with the 'preserve-modes parameter (eg, as done - ;; by auto-revert-mode) will cause this handler to get called with a nil - ;; buffer-file-name. We need the buffer-file-name to send notifications; - ;; so we skip handling revert-buffer-caused changes and instead handle - ;; reverts separately in lsp-on-revert - (when (not revert-buffer-in-progress-p) - (cl-incf lsp--cur-version) - (mapc - (lambda (workspace) - (pcase (or lsp-document-sync-method - (lsp--workspace-sync-method workspace)) - (1 - (if lsp-debounce-full-sync-notifications - (setq lsp--delayed-requests - (->> lsp--delayed-requests - (-remove (-lambda ((_ buffer)) - (equal (current-buffer) buffer))) - (cons (list workspace - (current-buffer) - (lsp--versioned-text-document-identifier) - (lsp--full-change-event))))) - (with-lsp-workspace workspace - (lsp-notify "textDocument/didChange" - (list :contentChanges (vector (lsp--full-change-event)) - :textDocument (lsp--versioned-text-document-identifier))) - (lsp-diagnostics--request-pull-diagnostics workspace)))) - (2 - (with-lsp-workspace workspace - (lsp-notify - "textDocument/didChange" - (list :textDocument (lsp--versioned-text-document-identifier) - :contentChanges (vector - (if content-change-event-fn - (funcall content-change-event-fn start end length) - (lsp--text-document-content-change-event - start end length))))) - (lsp-diagnostics--request-pull-diagnostics workspace))))) - (lsp-workspaces)) - (when lsp--delay-timer (cancel-timer lsp--delay-timer)) - (setq lsp--delay-timer (run-with-idle-timer - lsp-debounce-full-sync-notifications-interval - nil - #'lsp--flush-delayed-changes)) - ;; force cleanup overlays after each change - (lsp--remove-overlays 'lsp-highlight) - (lsp--after-change (current-buffer)))))) - - - -;; facilities for on change hooks. We do not want to make lsp calls on each -;; change event so we add debounce to avoid flooding the server with events. -;; Additionally, we want to have a mechanism for stopping the server calls in -;; particular cases like, e. g. when performing completion. - -(defvar lsp-inhibit-lsp-hooks nil - "Flag to control.") - -(defcustom lsp-on-change-hook nil - "Hooks to run when buffer has changed." - :type 'hook - :group 'lsp-mode) - -(defcustom lsp-idle-delay 0.500 - "Debounce interval for `after-change-functions'." - :type 'number - :group 'lsp-mode) - -(defcustom lsp-on-idle-hook nil - "Hooks to run after `lsp-idle-delay'." - :type 'hook - :group 'lsp-mode) - -(defun lsp--idle-reschedule (buffer) - (when lsp--on-idle-timer - (cancel-timer lsp--on-idle-timer)) - - (setq lsp--on-idle-timer (run-with-idle-timer - lsp-idle-delay - nil - #'lsp--on-idle - buffer))) - -(defun lsp--post-command () - (lsp--cleanup-highlights-if-needed) - (lsp--idle-reschedule (current-buffer))) - -(defun lsp--on-idle (buffer) - "Start post command loop." - (when (and (buffer-live-p buffer) - (equal buffer (current-buffer)) - (not lsp-inhibit-lsp-hooks) - lsp-managed-mode) - (run-hooks 'lsp-on-idle-hook))) - -(defun lsp--on-change-debounce (buffer) - (when (and (buffer-live-p buffer) - (equal buffer (current-buffer)) - (not lsp-inhibit-lsp-hooks) - lsp-managed-mode) - (run-hooks 'lsp-on-change-hook))) - -(defun lsp--after-change (buffer) - "Called after most textDocument/didChange events." - (setq lsp--signature-last-index nil - lsp--signature-last nil) - - ;; cleanup diagnostics - (when lsp-diagnostic-clean-after-change - (dolist (workspace (lsp-workspaces)) - (-let [diagnostics (lsp--workspace-diagnostics workspace)] - (remhash (lsp--fix-path-casing (buffer-file-name)) diagnostics)))) - - (when (fboundp 'lsp--semantic-tokens-refresh-if-enabled) - (lsp--semantic-tokens-refresh-if-enabled buffer)) - (when lsp--on-change-timer - (cancel-timer lsp--on-change-timer)) - (setq lsp--on-change-timer (run-with-idle-timer - lsp-idle-delay - nil - #'lsp--on-change-debounce - buffer)) - (lsp--idle-reschedule buffer)) - - -(defcustom lsp-trim-trailing-whitespace t - "Trim trailing whitespace on a line." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-insert-final-newline t - "Insert a newline character at the end of the file if one does not exist." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-trim-final-newlines t - "Trim all newlines after the final newline at the end of the file." - :group 'lsp-mode - :type 'boolean) - - -(defun lsp--on-type-formatting (first-trigger-characters more-trigger-characters) - "Self insert handling. -Applies on type formatting." - (let ((ch last-command-event)) - (when (or (eq (string-to-char first-trigger-characters) ch) - (cl-find ch more-trigger-characters :key #'string-to-char)) - (lsp-request-async "textDocument/onTypeFormatting" - (lsp-make-document-on-type-formatting-params - :text-document (lsp--text-document-identifier) - :options (lsp-make-formatting-options - :tab-size (symbol-value (lsp--get-indent-width major-mode)) - :insert-spaces (lsp-json-bool (not indent-tabs-mode)) - :trim-trailing-whitespace? (lsp-json-bool lsp-trim-trailing-whitespace) - :insert-final-newline? (lsp-json-bool lsp-insert-final-newline) - :trim-final-newlines? (lsp-json-bool lsp-trim-final-newlines)) - :ch (char-to-string ch) - :position (lsp--cur-position)) - (lambda (data) (lsp--apply-text-edits data 'format)) - :mode 'tick)))) - - -;; links -(defun lsp--document-links () - (when (lsp-feature? "textDocument/documentLink") - (lsp-request-async - "textDocument/documentLink" - `(:textDocument ,(lsp--text-document-identifier)) - (lambda (links) - (lsp--remove-overlays 'lsp-link) - (seq-do - (-lambda ((link &as &DocumentLink :range (&Range :start :end))) - (-doto (make-button (lsp--position-to-point start) - (lsp--position-to-point end) - 'action (lsp--document-link-keymap link) - 'keymap (let ((map (make-sparse-keymap))) - (define-key map [M-return] 'push-button) - (define-key map [mouse-2] 'push-button) - map) - 'help-echo "mouse-2, M-RET: Visit this link") - (overlay-put 'lsp-link t))) - links)) - :mode 'unchanged))) - -(defun lsp--document-link-handle-target (url) - (let* ((parsed-url (url-generic-parse-url (url-unhex-string url))) - (type (url-type parsed-url))) - (pcase type - ("file" - (xref-push-marker-stack) - (find-file (lsp--uri-to-path url)) - (-when-let ((_ line column) (s-match (rx "#" (group (1+ num)) (or "," "#") (group (1+ num))) url)) - (goto-char (lsp--position-to-point - (lsp-make-position :character (1- (string-to-number column)) - :line (1- (string-to-number line))))))) - ((or "http" "https") (browse-url url)) - (type (if-let ((handler (lsp--get-uri-handler type))) - (funcall handler url) - (signal 'lsp-file-scheme-not-supported (list url))))))) - -(lsp-defun lsp--document-link-keymap ((link &as &DocumentLink :target?)) - (if target? - (lambda (_) - (interactive) - (lsp--document-link-handle-target target?)) - (lambda (_) - (interactive) - (when (lsp:document-link-registration-options-resolve-provider? - (lsp--capability-for-method "textDocument/documentLink")) - (lsp-request-async - "documentLink/resolve" - link - (-lambda ((&DocumentLink :target?)) - (lsp--document-link-handle-target target?))))))) - - - -(defcustom lsp-warn-no-matched-clients t - "Whether to show messages when there are no supported clients." - :group 'lsp-mode - :type 'boolean) - -(defun lsp-buffer-language--configured-id () - "Return nil when not registered." - (->> lsp-language-id-configuration - (-first - (-lambda ((mode-or-pattern . language)) - (cond - ((and (stringp mode-or-pattern) - (s-matches? mode-or-pattern (buffer-file-name))) - language) - ((eq mode-or-pattern major-mode) language)))) - cl-rest)) - -(defvar-local lsp--buffer-language nil - "Locally cached returned value of `lsp-buffer-language'.") - -(defun lsp-buffer-language () - "Get language corresponding current buffer." - (or lsp--buffer-language - (let* ((configured-language (lsp-buffer-language--configured-id))) - (setq lsp--buffer-language - (or configured-language - ;; ensure non-nil - (string-remove-suffix "-mode" (symbol-name major-mode)))) - (when (and lsp-warn-no-matched-clients - (null configured-language)) - (lsp-warn "Unable to calculate the languageId for buffer `%s'. \ -Take a look at `lsp-language-id-configuration'. The `major-mode' is %s" - (buffer-name) - major-mode)) - lsp--buffer-language))) - -(defun lsp-activate-on (&rest languages) - "Returns language activation function. -The function will return t when the `lsp-buffer-language' returns -one of the LANGUAGES." - (lambda (_file-name _mode) - (-contains? languages (lsp-buffer-language)))) - -(defun lsp-workspace-root (&optional path) - "Find the workspace root for the current file or PATH." - (-when-let* ((file-name (or path (buffer-file-name))) - (file-name (lsp-f-canonical file-name))) - (->> (lsp-session) - (lsp-session-folders) - (--filter (and (lsp--files-same-host it file-name) - (or (lsp-f-ancestor-of? it file-name) - (equal it file-name)))) - (--max-by (> (length it) (length other)))))) - -(defun lsp-on-revert () - "Executed when a file is reverted. -Added to `after-revert-hook'." - (let ((n (buffer-size)) - (revert-buffer-in-progress-p nil)) - (lsp-on-change 0 n n))) - -(defun lsp--text-document-did-close (&optional keep-workspace-alive) - "Executed when the file is closed, added to `kill-buffer-hook'. - -If KEEP-WORKSPACE-ALIVE is non-nil, do not shutdown the workspace -if it's closing the last buffer in the workspace." - (lsp-foreach-workspace - (cl-callf2 delq (lsp-current-buffer) (lsp--workspace-buffers lsp--cur-workspace)) - (with-demoted-errors "Error sending didClose notification in ‘lsp--text-document-did-close’: %S" - (lsp-notify "textDocument/didClose" - `(:textDocument ,(lsp--text-document-identifier)))) - (when (and (not lsp-keep-workspace-alive) - (not keep-workspace-alive) - (not (lsp--workspace-buffers lsp--cur-workspace))) - (lsp--shutdown-workspace)))) - -(defun lsp--will-save-text-document-params (reason) - (list :textDocument (lsp--text-document-identifier) - :reason reason)) - -(defun lsp--before-save () - "Before save handler." - (with-demoted-errors "Error in ‘lsp--before-save’: %S" - (let ((params (lsp--will-save-text-document-params 1))) - (when (lsp--send-will-save-p) - (lsp-notify "textDocument/willSave" params)) - (when (and (lsp--send-will-save-wait-until-p) lsp-before-save-edits) - (let ((lsp-response-timeout 0.1)) - (condition-case nil - (lsp--apply-text-edits - (lsp-request "textDocument/willSaveWaitUntil" - params) - 'before-save) - (error))))))) - -(defun lsp--on-auto-save () - "Handler for auto-save." - (when (lsp--send-will-save-p) - (with-demoted-errors "Error in ‘lsp--on-auto-save’: %S" - (lsp-notify "textDocument/willSave" (lsp--will-save-text-document-params 2))))) - -(defun lsp--text-document-did-save () - "Executed when the file is closed, added to `after-save-hook''." - (when (lsp--send-did-save-p) - (with-demoted-errors "Error on ‘lsp--text-document-did-save: %S’" - (lsp-notify "textDocument/didSave" - `( :textDocument ,(lsp--versioned-text-document-identifier) - ,@(when (lsp--save-include-text-p) - (list :text (lsp--buffer-content)))))))) - -(defun lsp--text-document-position-params (&optional identifier position) - "Make TextDocumentPositionParams for the current point in the current document. -If IDENTIFIER and POSITION are non-nil, they will be used as the document -identifier and the position respectively." - (list :textDocument (or identifier (lsp--text-document-identifier)) - :position (or position (lsp--cur-position)))) - -(defun lsp--get-buffer-diagnostics () - "Return buffer diagnostics." - (gethash (or - (plist-get lsp--virtual-buffer :buffer-file-name) - (lsp--fix-path-casing (buffer-file-name))) - (lsp-diagnostics t))) - -(defun lsp-cur-line-diagnostics () - "Return any diagnostics that apply to the current line." - (-let [(&plist :start (&plist :line start) :end (&plist :line end)) (lsp--region-or-line)] - (cl-coerce (-filter - (-lambda ((&Diagnostic :range (&Range :start (&Position :line)))) - (and (>= line start) (<= line end))) - (lsp--get-buffer-diagnostics)) - 'vector))) - -(lsp-defun lsp-range-overlapping?((left &as &Range :start left-start :end left-end) - (right &as &Range :start right-start :end right-end)) - (or (lsp-point-in-range? right-start left) - (lsp-point-in-range? right-end left) - (lsp-point-in-range? left-start right) - (lsp-point-in-range? left-end right))) - -(defun lsp-make-position-1 (position) - (lsp-make-position :line (plist-get position :line) - :character (plist-get position :character))) - -(defun lsp-cur-possition-diagnostics () - "Return any diagnostics that apply to the current line." - (-let* ((start (if (use-region-p) (region-beginning) (point))) - (end (if (use-region-p) (region-end) (point))) - (current-range (lsp-make-range :start (lsp-make-position-1 (lsp-point-to-position start)) - :end (lsp-make-position-1 (lsp-point-to-position end))))) - (->> (lsp--get-buffer-diagnostics) - (-filter - (-lambda ((&Diagnostic :range)) - (lsp-range-overlapping? range current-range))) - (apply 'vector)))) - -(defalias 'lsp--cur-line-diagnotics 'lsp-cur-line-diagnostics) - -(defun lsp--extract-line-from-buffer (pos) - "Return the line pointed to by POS (a Position object) in the current buffer." - (let* ((point (lsp--position-to-point pos)) - (inhibit-field-text-motion t)) - (save-excursion - (goto-char point) - (buffer-substring (line-beginning-position) (line-end-position))))) - -(lsp-defun lsp--xref-make-item (filename (&Range :start (start &as &Position :character start-char :line start-line) - :end (end &as &Position :character end-char))) - "Return a xref-item from a RANGE in FILENAME." - (let* ((line (lsp--extract-line-from-buffer start)) - (len (length line))) - (add-face-text-property (max (min start-char len) 0) - (max (min end-char len) 0) - 'xref-match t line) - ;; LINE is nil when FILENAME is not being current visited by any buffer. - (xref-make-match (or line filename) - (xref-make-file-location - filename - (lsp-translate-line (1+ start-line)) - (lsp-translate-column start-char)) - (- end-char start-char)))) - -(defun lsp--location-uri (loc) - (if (lsp-location? loc) - (lsp:location-uri loc) - (lsp:location-link-target-uri loc))) - -(lsp-defun lsp-goto-location ((loc &as &Location :uri :range (&Range :start))) - "Go to location." - (let ((path (lsp--uri-to-path uri))) - (if (f-exists? path) - (with-current-buffer (find-file path) - (goto-char (lsp--position-to-point start))) - (error "There is no file %s" path)))) - -(defun lsp--location-range (loc) - (if (lsp-location? loc) - (lsp:location-range loc) - (lsp:location-link-target-selection-range loc))) - -(defun lsp--locations-to-xref-items (locations) - "Return a list of `xref-item' given LOCATIONS, which can be of -type Location, LocationLink, Location[] or LocationLink[]." - (setq locations - (pcase locations - ((seq (or (lsp-interface Location) - (lsp-interface LocationLink))) - (append locations nil)) - ((or (lsp-interface Location) - (lsp-interface LocationLink)) - (list locations)))) - - (cl-labels ((get-xrefs-in-file - (file-locs) - (-let [(filename . matches) file-locs] - (condition-case err - (let ((visiting (find-buffer-visiting filename)) - (fn (lambda (loc) - (lsp-with-filename filename - (lsp--xref-make-item filename - (lsp--location-range loc)))))) - (if visiting - (with-current-buffer visiting - (seq-map fn matches)) - (when (file-readable-p filename) - (with-temp-buffer - (insert-file-contents-literally filename) - (seq-map fn matches))))) - (error (lsp-warn "Failed to process xref entry for filename '%s': %s" - filename (error-message-string err))) - (file-error (lsp-warn "Failed to process xref entry, file-error, '%s': %s" - filename (error-message-string err))))))) - - (->> locations - (seq-sort #'lsp--location-before-p) - (seq-group-by (-compose #'lsp--uri-to-path #'lsp--location-uri)) - (seq-map #'get-xrefs-in-file) - (apply #'nconc)))) - -(defun lsp--location-before-p (left right) - "Sort first by file, then by line, then by column." - (let ((left-uri (lsp--location-uri left)) - (right-uri (lsp--location-uri right))) - (if (not (string= left-uri right-uri)) - (string< left-uri right-uri) - (-let (((&Range :start left-start) (lsp--location-range left)) - ((&Range :start right-start) (lsp--location-range right))) - (lsp--position-compare right-start left-start))))) - -(defun lsp--make-reference-params (&optional td-position exclude-declaration) - "Make a ReferenceParam object. -If TD-POSITION is non-nil, use it as TextDocumentPositionParams object instead. -If EXCLUDE-DECLARATION is non-nil, request the server to include declarations." - (let ((json-false :json-false)) - (plist-put (or td-position (lsp--text-document-position-params)) - :context `(:includeDeclaration ,(lsp-json-bool (not exclude-declaration)))))) - -(defun lsp--cancel-request (id) - "Cancel request with ID in all workspaces." - (lsp-foreach-workspace - (->> lsp--cur-workspace lsp--workspace-client lsp--client-response-handlers (remhash id)) - (lsp-notify "$/cancelRequest" `(:id ,id)))) - -(defvar-local lsp--hover-saved-bounds nil) - -(defun lsp-eldoc-function (cb &rest _ignored) - "`lsp-mode' eldoc function to display hover info (based on `textDocument/hover')." - (if (and lsp--hover-saved-bounds - (lsp--point-in-bounds-p lsp--hover-saved-bounds)) - lsp--eldoc-saved-message - (setq lsp--hover-saved-bounds nil - lsp--eldoc-saved-message nil) - (if (looking-at-p "[[:space:]\n]") - (setq lsp--eldoc-saved-message nil) ; And returns nil. - (when (and lsp-eldoc-enable-hover (lsp-feature? "textDocument/hover")) - (lsp-request-async - "textDocument/hover" - (lsp--text-document-position-params) - (-lambda ((hover &as &Hover? :range? :contents)) - (setq lsp--hover-saved-bounds (when range? - (lsp--range-to-region range?))) - (funcall cb (setq lsp--eldoc-saved-message - (when contents - (lsp--render-on-hover-content - contents - lsp-eldoc-render-all))))) - :error-handler #'ignore - :mode 'tick - :cancel-token :eldoc-hover))))) - -(defun lsp--point-on-highlight? () - (-some? (lambda (overlay) - (overlay-get overlay 'lsp-highlight)) - (overlays-at (point)))) - -(defun lsp--cleanup-highlights-if-needed () - (when (and lsp-enable-symbol-highlighting - lsp--have-document-highlights - (not (lsp--point-on-highlight?))) - (lsp--remove-overlays 'lsp-highlight) - (setq lsp--have-document-highlights nil) - (lsp-cancel-request-by-token :highlights))) - -(defvar-local lsp--symbol-bounds-of-last-highlight-invocation nil - "The bounds of the symbol from which `lsp--document-highlight' - most recently requested highlights.") - -(defun lsp--document-highlight () - (when (lsp-feature? "textDocument/documentHighlight") - (let ((curr-sym-bounds (bounds-of-thing-at-point 'symbol))) - (unless (or (looking-at-p "[[:space:]\n]") - (not lsp-enable-symbol-highlighting) - (and lsp--have-document-highlights - curr-sym-bounds - (equal curr-sym-bounds - lsp--symbol-bounds-of-last-highlight-invocation))) - (setq lsp--symbol-bounds-of-last-highlight-invocation - curr-sym-bounds) - (lsp-request-async "textDocument/documentHighlight" - (lsp--text-document-position-params) - #'lsp--document-highlight-callback - :mode 'tick - :cancel-token :highlights))))) - -(defun lsp--help-open-link (&rest _) - "Open markdown link at point via mouse or keyboard." - (interactive "P") - (let ((buffer-list-update-hook nil)) - (-let [(buffer point) (if-let* ((valid (and (listp last-input-event) - (eq (car last-input-event) 'mouse-2))) - (event (cadr last-input-event)) - (win (posn-window event)) - (buffer (window-buffer win))) - `(,buffer ,(posn-point event)) - `(,(current-buffer) ,(point)))] - (with-current-buffer buffer - (when-let* ((face (get-text-property point 'face)) - (url (or (and (eq face 'markdown-link-face) - (get-text-property point 'help-echo)) - (and (memq face '(markdown-url-face markdown-plain-url-face)) - (nth 3 (markdown-link-at-pos point)))))) - (lsp--document-link-handle-target url)))))) - -(defvar lsp-help-mode-map - (-doto (make-sparse-keymap) - (define-key [remap markdown-follow-link-at-point] #'lsp--help-open-link)) - "Keymap for `lsp-help-mode'.") - -(define-derived-mode lsp-help-mode help-mode "LspHelp" - "Major mode for displaying lsp help.") - -(defun lsp-describe-thing-at-point () - "Display the type signature and documentation of the thing at point." - (interactive) - (let ((contents (-some->> (lsp--text-document-position-params) - (lsp--make-request "textDocument/hover") - (lsp--send-request) - (lsp:hover-contents)))) - (if (and contents (not (equal contents ""))) - (let ((lsp-help-buf-name "*lsp-help*")) - (with-current-buffer (get-buffer-create lsp-help-buf-name) - (delay-mode-hooks - (lsp-help-mode) - (with-help-window lsp-help-buf-name - (insert - (mapconcat 'string-trim-right - (split-string (lsp--render-on-hover-content contents t) "\n") - "\n")))) - (run-mode-hooks))) - (lsp--info "No content at point.")))) - -(defun lsp--point-in-bounds-p (bounds) - "Return whether the current point is within BOUNDS." - (and (<= (car bounds) (point)) (< (point) (cdr bounds)))) - -(defun lsp-get-renderer (language) - "Get renderer for LANGUAGE." - (lambda (str) - (lsp--render-string str language))) - -(defun lsp--setup-markdown (mode) - "Setup the ‘markdown-mode’ in the frame. -MODE is the mode used in the parent frame." - (make-local-variable 'markdown-code-lang-modes) - (dolist (mark (alist-get mode lsp-custom-markup-modes)) - (add-to-list 'markdown-code-lang-modes (cons mark mode))) - (setq-local markdown-fontify-code-blocks-natively t) - (setq-local markdown-fontify-code-block-default-mode mode) - (setq-local markdown-hide-markup t) - - ;; Render some common HTML entities. - ;; This should really happen in markdown-mode instead, - ;; but it doesn't, so we do it here for now. - (setq prettify-symbols-alist - (cl-loop for i from 0 to 255 - collect (cons (format "&#x%02X;" i) i))) - (push '("<" . ?<) prettify-symbols-alist) - (push '(">" . ?>) prettify-symbols-alist) - (push '("&" . ?&) prettify-symbols-alist) - (push '(" " . ? ) prettify-symbols-alist) - (setq prettify-symbols-compose-predicate - (lambda (_start _end _match) t)) - (prettify-symbols-mode 1)) - -(defvar lsp-help-link-keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] #'lsp--help-open-link) - (define-key map "\r" #'lsp--help-open-link) - map) - "Keymap active on links in *lsp-help* mode.") - -(defun lsp--fix-markdown-links () - (let ((inhibit-read-only t) - (inhibit-modification-hooks t) - (prop)) - (save-restriction - (goto-char (point-min)) - (while (setq prop (markdown-find-next-prop 'face)) - (let ((end (or (next-single-property-change (car prop) 'face) - (point-max)))) - (when (memq (get-text-property (car prop) 'face) - '(markdown-link-face - markdown-url-face - markdown-plain-url-face)) - (add-text-properties (car prop) end - (list 'button t - 'category 'lsp-help-link - 'follow-link t - 'keymap lsp-help-link-keymap))) - (goto-char end)))))) - -(defun lsp--buffer-string-visible () - "Return visible buffer string. -Stolen from `org-copy-visible'." - (let ((temp (generate-new-buffer " *temp*")) - (beg (point-min)) - (end (point-max))) - (while (/= beg end) - (when (get-char-property beg 'invisible) - (setq beg (next-single-char-property-change beg 'invisible nil end))) - (let* ((next (next-single-char-property-change beg 'invisible nil end)) - (substring (buffer-substring beg next))) - (with-current-buffer temp (insert substring)) - ;; (setq result (concat result substring)) - (setq beg next))) - (setq deactivate-mark t) - (prog1 (with-current-buffer temp - (s-chop-suffix "\n" (buffer-string))) - (kill-buffer temp)))) - -(defvar lsp-buffer-major-mode nil - "Holds the major mode when fontification function is running. -See #2588") - -(defvar view-inhibit-help-message) - -(defun lsp--render-markdown () - "Render markdown." - - (let ((markdown-enable-math nil)) - (goto-char (point-min)) - (while (re-search-forward - (rx (and "\\" (group (or "\\" "`" "*" "_" ":" "/" - "{" "}" "[" "]" "(" ")" - "#" "+" "-" "." "!" "|")))) - nil t) - (replace-match (rx (backref 1)))) - - ;; markdown-mode v2.3 does not yet provide gfm-view-mode - (if (fboundp 'gfm-view-mode) - (let ((view-inhibit-help-message t)) - (gfm-view-mode)) - (gfm-mode)) - - (lsp--setup-markdown lsp-buffer-major-mode))) - -(defvar lsp--display-inline-image-alist - '((lsp--render-markdown - (:regexp - "!\\[.*?\\](data:image/[a-zA-Z]+;base64,\\([A-Za-z0-9+/\n]+?=*?\\)\\(|[^)]+\\)?)" - :sexp - (create-image - (base64-decode-string - (buffer-substring-no-properties (match-beginning 1) (match-end 1))) - nil t)))) - "Replaced string regexp and function returning image. -Each element should have the form (MODE . (PROPERTY-LIST...)). -MODE (car) is function which is defined in `lsp-language-id-configuration'. -Cdr should be list of PROPERTY-LIST. - -Each PROPERTY-LIST should have properties: -:regexp Regexp which determines what string is relpaced to image. - You should also get information of image, by parenthesis constructs. - By default, all matched string is replaced to image, but you can - change index of replaced string by keyword :replaced-index. - -:sexp Return image when evaluated. You can use information of regexp - by using (match-beggining N), (match-end N) or (match-substring N). - -In addition, each can have property: -:replaced-index Determine index which is used to replace regexp to image. - The value means first argument of `match-beginning' and - `match-end'. If omitted, interpreted as index 0.") - -(defcustom lsp-display-inline-image t - "Showing inline image or not." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-enable-suggest-server-download t - "When non-nil enable server downloading suggestions." - :group 'lsp-mode - :type 'boolean - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-auto-register-remote-clients t - "When non-nil register remote when registering the local one." - :group 'lsp-mode - :type 'boolean - :package-version '(lsp-mode . "9.0.0")) - -(defun lsp--display-inline-image (mode) - "Add image property if available." - (let ((plist-list (cdr (assq mode lsp--display-inline-image-alist)))) - (when (and (display-images-p) lsp-display-inline-image) - (cl-loop - for plist in plist-list - with regexp with replaced-index - do - (setq regexp (plist-get plist :regexp)) - (setq replaced-index (or (plist-get plist :replaced-index) 0)) - - (font-lock-remove-keywords nil (list regexp replaced-index)) - (let ((inhibit-read-only t)) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (set-text-properties - (match-beginning replaced-index) (match-end replaced-index) - nil) - (add-text-properties - (match-beginning replaced-index) (match-end replaced-index) - `(display ,(eval (plist-get plist :sexp))))))))))) - -(defun lsp--fontlock-with-mode (str mode) - "Fontlock STR with MODE." - (let ((lsp-buffer-major-mode major-mode)) - (with-temp-buffer - (with-demoted-errors "Error during doc rendering: %s" - (insert str) - (delay-mode-hooks (funcall mode)) - (cl-flet ((window-body-width () lsp-window-body-width)) - ;; This can go wrong in some cases, and the fontification would - ;; not work as expected. - ;; - ;; See #2984 - (ignore-errors (font-lock-ensure)) - (lsp--display-inline-image mode) - (when (eq mode 'lsp--render-markdown) - (lsp--fix-markdown-links)))) - (lsp--buffer-string-visible)))) - -(defun lsp--render-string (str language) - "Render STR using `major-mode' corresponding to LANGUAGE. -When language is nil render as markup if `markdown-mode' is loaded." - (setq str (s-replace "\r" "" (or str ""))) - (if-let* ((modes (-keep (-lambda ((mode . lang)) - (when (and (equal lang language) (functionp mode)) - mode)) - lsp-language-id-configuration)) - (mode (car (or (member major-mode modes) modes)))) - (lsp--fontlock-with-mode str mode) - str)) - -(defun lsp--render-element (content) - "Render CONTENT element." - (let ((inhibit-message t)) - (or - (pcase content - ((lsp-interface MarkedString :value :language) - (lsp--render-string value language)) - ((lsp-interface MarkupContent :value :kind) - (lsp--render-string value kind)) - ;; plain string - ((pred stringp) (lsp--render-string content "markdown")) - ((pred null) "") - (_ (error "Failed to handle %s" content))) - ""))) - -(defun lsp--create-unique-string-fn () - (let (elements) - (lambda (element) - (let ((count (cl-count element elements :test #'string=))) - (prog1 (if (zerop count) - element - (format "%s (%s)" element count)) - (push element elements)))))) - -(defun lsp--select-action (actions) - "Select an action to execute from ACTIONS." - (cond - ((seq-empty-p actions) (signal 'lsp-no-code-actions nil)) - ((and (eq (seq-length actions) 1) lsp-auto-execute-action) - (lsp-seq-first actions)) - (t (let ((completion-ignore-case t)) - (lsp--completing-read "Select code action: " - (seq-into actions 'list) - (-compose (lsp--create-unique-string-fn) - #'lsp:code-action-title) - nil t))))) - -(defun lsp--workspace-server-id (workspace) - "Return the server ID of WORKSPACE." - (-> workspace lsp--workspace-client lsp--client-server-id)) - -(defun lsp--handle-rendered-for-echo-area (contents) - "Return a single line from RENDERED, appropriate for display in the echo area." - (pcase (lsp-workspaces) - (`(,workspace) - (lsp-clients-extract-signature-on-hover contents (lsp--workspace-server-id workspace))) - ;; For projects with multiple active workspaces we also default to - ;; render the first line. - (_ (lsp-clients-extract-signature-on-hover contents nil)))) - -(cl-defmethod lsp-clients-extract-signature-on-hover (contents _server-id) - "Extract a representative line from CONTENTS, to show in the echo area." - (car (s-lines (s-trim (lsp--render-element contents))))) - -(defun lsp--render-on-hover-content (contents render-all) - "Render the content received from `document/onHover' request. -CONTENTS - MarkedString | MarkedString[] | MarkupContent -RENDER-ALL - nil if only the signature should be rendered." - (cond - ((lsp-markup-content? contents) - ;; MarkupContent. - ;; It tends to be long and is not suitable to display fully in the echo area. - ;; Just display the first line which is typically the signature. - (if render-all - (lsp--render-element contents) - (lsp--handle-rendered-for-echo-area contents))) - ((and (stringp contents) (not (string-match-p "\n" contents))) - ;; If the contents is a single string containing a single line, - ;; render it always. - (lsp--render-element contents)) - (t - ;; MarkedString -> MarkedString[] - (when (or (lsp-marked-string? contents) (stringp contents)) - (setq contents (list contents))) - ;; Consider the signature consisting of the elements who have a renderable - ;; "language" property. When render-all is nil, ignore other elements. - (string-join - (seq-map - #'lsp--render-element - (if render-all - contents - ;; Only render contents that have an available renderer. - (seq-take - (seq-filter - (-andfn #'lsp-marked-string? - (-compose #'lsp-get-renderer #'lsp:marked-string-language)) - contents) - 1))) - (if (bound-and-true-p page-break-lines-mode) - "\n\n" - "\n"))))) - - - -(defvar lsp-signature-mode-map - (-doto (make-sparse-keymap) - (define-key (kbd "M-n") #'lsp-signature-next) - (define-key (kbd "M-p") #'lsp-signature-previous) - (define-key (kbd "M-a") #'lsp-signature-toggle-full-docs) - (define-key (kbd "C-c C-k") #'lsp-signature-stop) - (define-key (kbd "C-g") #'lsp-signature-stop)) - "Keymap for `lsp-signature-mode'.") - -(define-minor-mode lsp-signature-mode - "Mode used to show signature popup." - :keymap lsp-signature-mode-map - :lighter "" - :group 'lsp-mode) - -(defun lsp-signature-stop () - "Stop showing current signature help." - (interactive) - (lsp-cancel-request-by-token :signature) - (remove-hook 'post-command-hook #'lsp-signature) - (funcall lsp-signature-function nil) - (lsp-signature-mode -1)) - -(declare-function page-break-lines--update-display-tables "ext:page-break-lines") - -(defun lsp--setup-page-break-mode-if-present () - "Enable `page-break-lines-mode' in current buffer." - (when (fboundp 'page-break-lines-mode) - (page-break-lines-mode) - ;; force page-break-lines-mode to update the display tables. - (page-break-lines--update-display-tables))) - -(defun lsp-lv-message (message) - (add-hook 'lv-window-hook #'lsp--setup-page-break-mode-if-present) - (if message - (progn - (setq lsp--signature-last-buffer (current-buffer)) - (let ((lv-force-update t)) - (lv-message "%s" message))) - (lv-delete-window) - (remove-hook 'lv-window-hook #'lsp--setup-page-break-mode-if-present))) - -(declare-function posframe-show "ext:posframe") -(declare-function posframe-hide "ext:posframe") -(declare-function posframe-poshandler-point-bottom-left-corner-upward "ext:posframe") - -(defface lsp-signature-posframe - '((t :inherit tooltip)) - "Background and foreground for `lsp-signature-posframe'." - :group 'lsp-mode) - -(defvar lsp-signature-posframe-params - (list :poshandler #'posframe-poshandler-point-bottom-left-corner-upward - :height 10 - :width 60 - :border-width 1 - :min-width 60) - "Params for signature and `posframe-show'.") - -(defun lsp-signature-posframe (str) - "Use posframe to show the STR signatureHelp string." - (if str - (apply #'posframe-show - (with-current-buffer (get-buffer-create " *lsp-signature*") - (erase-buffer) - (insert str) - (visual-line-mode 1) - (lsp--setup-page-break-mode-if-present) - (current-buffer)) - (append - lsp-signature-posframe-params - (list :position (point) - :background-color (face-attribute 'lsp-signature-posframe :background nil t) - :foreground-color (face-attribute 'lsp-signature-posframe :foreground nil t) - :border-color (face-attribute (if (facep 'child-frame-border) - 'child-frame-border - 'internal-border) - :background nil t)))) - (posframe-hide " *lsp-signature*"))) - -(defun lsp--handle-signature-update (signature) - (let ((message - (if (lsp-signature-help? signature) - (lsp--signature->message signature) - (mapconcat #'lsp--signature->message signature "\n")))) - (if (s-present? message) - (funcall lsp-signature-function message) - (lsp-signature-stop)))) - -(defun lsp-signature-activate () - "Activate signature help. -It will show up only if current point has signature help." - (interactive) - (setq lsp--signature-last nil - lsp--signature-last-index nil - lsp--signature-last-buffer (current-buffer)) - (add-hook 'post-command-hook #'lsp-signature) - (lsp-signature-mode t)) - -(defcustom lsp-signature-cycle t - "Whether `lsp-signature-next' and prev should cycle." - :type 'boolean - :group 'lsp-mode) - -(defun lsp-signature-next () - "Show next signature." - (interactive) - (let ((nsigs (length (lsp:signature-help-signatures lsp--signature-last)))) - (when (and lsp--signature-last-index - lsp--signature-last - (or lsp-signature-cycle (< (1+ lsp--signature-last-index) nsigs))) - (setq lsp--signature-last-index (% (1+ lsp--signature-last-index) nsigs)) - (funcall lsp-signature-function (lsp--signature->message lsp--signature-last))))) - -(defun lsp-signature-previous () - "Next signature." - (interactive) - (when (and lsp--signature-last-index - lsp--signature-last - (or lsp-signature-cycle (not (zerop lsp--signature-last-index)))) - (setq lsp--signature-last-index (1- (if (zerop lsp--signature-last-index) - (length (lsp:signature-help-signatures lsp--signature-last)) - lsp--signature-last-index))) - (funcall lsp-signature-function (lsp--signature->message lsp--signature-last)))) - -(defun lsp-signature-toggle-full-docs () - "Toggle full/partial signature documentation." - (interactive) - (let ((all? (not (numberp lsp-signature-doc-lines)))) - (setq lsp-signature-doc-lines (if all? - (or (car-safe lsp-signature-doc-lines) - 20) - (list lsp-signature-doc-lines)))) - (lsp-signature-activate)) - -(defface lsp-signature-highlight-function-argument - '((t :inherit eldoc-highlight-function-argument)) - "The face to use to highlight function arguments in signatures." - :group 'lsp-mode) - -(defun lsp--signature->message (signature-help) - "Generate eldoc message from SIGNATURE-HELP response." - (setq lsp--signature-last signature-help) - - (when (and signature-help (not (seq-empty-p (lsp:signature-help-signatures signature-help)))) - (-let* (((&SignatureHelp :active-signature? - :active-parameter? - :signatures) signature-help) - (active-signature? (or lsp--signature-last-index active-signature? 0)) - (_ (setq lsp--signature-last-index active-signature?)) - ((signature &as &SignatureInformation? :label :parameters?) (seq-elt signatures active-signature?)) - (prefix (if (= (length signatures) 1) - "" - (concat (propertize (format " %s/%s" - (1+ active-signature?) - (length signatures)) - 'face 'success) - " "))) - (method-docs (when - (and lsp-signature-render-documentation - (or (not (numberp lsp-signature-doc-lines)) (< 0 lsp-signature-doc-lines))) - (let ((docs (lsp--render-element - (lsp:parameter-information-documentation? signature)))) - (when (s-present? docs) - (concat - "\n" - (if (fboundp 'page-break-lines-mode) - "\n" - "") - (if (and (numberp lsp-signature-doc-lines) - (> (length (s-lines docs)) lsp-signature-doc-lines)) - (concat (s-join "\n" (-take lsp-signature-doc-lines (s-lines docs))) - (propertize "\nTruncated..." 'face 'highlight)) - docs))))))) - (when (and active-parameter? (not (seq-empty-p parameters?))) - (-when-let* ((param (when (and (< -1 active-parameter? (length parameters?))) - (seq-elt parameters? active-parameter?))) - (selected-param-label (let ((label (lsp:parameter-information-label param))) - (if (stringp label) label (append label nil)))) - (start (if (stringp selected-param-label) - (s-index-of selected-param-label label) - (cl-first selected-param-label))) - (end (if (stringp selected-param-label) - (+ start (length selected-param-label)) - (cl-second selected-param-label)))) - (add-face-text-property start end 'lsp-signature-highlight-function-argument nil label))) - (concat prefix label method-docs)))) - -(defun lsp-signature () - "Display signature info (based on `textDocument/signatureHelp')" - (if (and lsp--signature-last-buffer - (not (equal (current-buffer) lsp--signature-last-buffer))) - (lsp-signature-stop) - (lsp-request-async "textDocument/signatureHelp" - (lsp--text-document-position-params) - #'lsp--handle-signature-update - :cancel-token :signature))) - - -(defcustom lsp-overlay-document-color-char "■" - "Display the char represent the document color in overlay" - :type 'string - :group 'lsp-mode) - -;; color presentation -(defun lsp--color-create-interactive-command (color range) - (lambda () - (interactive) - (-let [(&ColorPresentation? :text-edit? - :additional-text-edits?) - (lsp--completing-read - "Select color presentation: " - (lsp-request - "textDocument/colorPresentation" - `( :textDocument ,(lsp--text-document-identifier) - :color ,color - :range ,range)) - #'lsp:color-presentation-label - nil - t)] - (when text-edit? - (lsp--apply-text-edit text-edit?)) - (when additional-text-edits? - (lsp--apply-text-edits additional-text-edits? 'color-presentation))))) - -(defun lsp--number->color (number) - (let ((result (format "%x" - (round (* (or number 0) 255.0))))) - (if (= 1 (length result)) - (concat "0" result) - result))) - -(defun lsp--document-color () - "Document color handler." - (when (lsp-feature? "textDocument/documentColor") - (lsp-request-async - "textDocument/documentColor" - `(:textDocument ,(lsp--text-document-identifier)) - (lambda (result) - (lsp--remove-overlays 'lsp-color) - (seq-do - (-lambda ((&ColorInformation :color (color &as &Color :red :green :blue) - :range)) - (-let* (((beg . end) (lsp--range-to-region range)) - (overlay (make-overlay beg end)) - (command (lsp--color-create-interactive-command color range))) - (overlay-put overlay 'lsp-color t) - (overlay-put overlay 'evaporate t) - (overlay-put overlay - 'before-string - (propertize - lsp-overlay-document-color-char - 'face `((:foreground ,(format - "#%s%s%s" - (lsp--number->color red) - (lsp--number->color green) - (lsp--number->color blue)))) - 'action command - 'mouse-face 'lsp-lens-mouse-face - 'local-map (-doto (make-sparse-keymap) - (define-key [mouse-1] command)))))) - result)) - :mode 'unchanged - :cancel-token :document-color-token))) - - - -(defun lsp--action-trigger-parameter-hints (_command) - "Handler for editor.action.triggerParameterHints." - (when (member :on-server-request lsp-signature-auto-activate) - (lsp-signature-activate))) - -(defun lsp--action-trigger-suggest (_command) - "Handler for editor.action.triggerSuggest." - (cond - ((and (bound-and-true-p company-mode) - (fboundp 'company-auto-begin) - (fboundp 'company-post-command)) - (run-at-time 0 nil - (lambda () - (let ((this-command 'company-idle-begin) - (company-minimum-prefix-length 0)) - (company-auto-begin) - (company-post-command))))) - (t - (completion-at-point)))) - -(defconst lsp--default-action-handlers - (ht ("editor.action.triggerParameterHints" #'lsp--action-trigger-parameter-hints) - ("editor.action.triggerSuggest" #'lsp--action-trigger-suggest)) - "Default action handlers.") - -(defun lsp--find-action-handler (command) - "Find action handler for particular COMMAND." - (or - (--some (-some->> it - (lsp--workspace-client) - (lsp--client-action-handlers) - (gethash command)) - (lsp-workspaces)) - (gethash command lsp--default-action-handlers))) - -(defun lsp--text-document-code-action-params (&optional kind) - "Code action params." - (list :textDocument (lsp--text-document-identifier) - :range (if (use-region-p) - (lsp--region-to-range (region-beginning) (region-end)) - (lsp--region-to-range (point) (point))) - :context `( :diagnostics ,(lsp-cur-possition-diagnostics) - ,@(when kind (list :only (vector kind)))))) - -(defun lsp-code-actions-at-point (&optional kind) - "Retrieve the code actions for the active region or the current line. -It will filter by KIND if non nil." - (lsp-request "textDocument/codeAction" (lsp--text-document-code-action-params kind))) - -(defun lsp-execute-code-action-by-kind (command-kind) - "Execute code action by COMMAND-KIND." - (if-let ((action (->> (lsp-get-or-calculate-code-actions command-kind) - (-filter (-lambda ((&CodeAction :kind?)) - (and kind? (s-prefix? command-kind kind?)))) - lsp--select-action))) - (lsp-execute-code-action action) - (signal 'lsp-no-code-actions '(command-kind)))) - -(defalias 'lsp-get-or-calculate-code-actions 'lsp-code-actions-at-point) - -(lsp-defun lsp--execute-command ((action &as &Command :command :arguments?)) - "Parse and execute a code ACTION represented as a Command LSP type." - (let ((server-id (->> (lsp-workspaces) - (cl-first) - (or lsp--cur-workspace) - (lsp--workspace-client) - (lsp--client-server-id)))) - (condition-case nil - (with-no-warnings - (lsp-execute-command server-id (intern command) arguments?)) - (cl-no-applicable-method - (if-let ((action-handler (lsp--find-action-handler command))) - (funcall action-handler action) - (lsp-send-execute-command command arguments?)))))) - -(lsp-defun lsp-execute-code-action ((action &as &CodeAction :command? :edit?)) - "Execute code action ACTION. For example, when text under the -caret has a suggestion to apply a fix from an lsp-server, calling -this function will do so. -If ACTION is not set it will be selected from `lsp-code-actions-at-point'. -Request codeAction/resolve for more info if server supports." - (interactive (list (lsp--select-action (lsp-code-actions-at-point)))) - (if (and (lsp-feature? "codeAction/resolve") - (not command?) - (not edit?)) - (lsp--execute-code-action (lsp-request "codeAction/resolve" action)) - (lsp--execute-code-action action))) - -(lsp-defun lsp--execute-code-action ((action &as &CodeAction :command? :edit?)) - "Execute code action ACTION." - (when edit? - (lsp--apply-workspace-edit edit? 'code-action)) - - (cond - ((stringp command?) (lsp--execute-command action)) - ((lsp-command? command?) (progn - (when-let ((action-filter (->> (lsp-workspaces) - (cl-first) - (or lsp--cur-workspace) - (lsp--workspace-client) - (lsp--client-action-filter)))) - (funcall action-filter command?)) - (lsp--execute-command command?))))) - -(lsp-defun lsp-fix-code-action-booleans ((&Command :arguments?) boolean-action-arguments) - "Patch incorrect boolean argument values in the provided `CodeAction' command -in place, based on the BOOLEAN-ACTION-ARGUMENTS list. The values -in this list can be either symbols or lists of symbols that -represent paths to boolean arguments in code actions: - -> (lsp-fix-code-action-booleans command `(:foo :bar (:some :nested :boolean))) - -When there are available code actions, the server sends -`lsp-mode' a list of possible command names and arguments as -JSON. `lsp-mode' parses all boolean false values as `nil'. As a -result code action arguments containing falsy values don't -roundtrip correctly because `lsp-mode' will end up sending null -values back to the client. This list makes it possible to -selectively transform `nil' values back into `:json-false'." - (seq-doseq (path boolean-action-arguments) - (seq-doseq (args arguments?) - (lsp--fix-nested-boolean args (if (listp path) path (list path)))))) - -(defun lsp--fix-nested-boolean (structure path) - "Traverse STRUCTURE using the paths from the PATH list, changing the value to -`:json-false' if it was `nil'. PATH should be a list containing -one or more symbols, and STRUCTURE should be compatible with -`lsp-member?', `lsp-get', and `lsp-put'." - (let ((key (car path)) - (rest (cdr path))) - (if (null rest) - ;; `lsp-put' returns `nil' both when the key doesn't exist and when the - ;; value is `nil', so we need to explicitly check its presence here - (when (and (lsp-member? structure key) (not (lsp-get structure key))) - (lsp-put structure key :json-false)) - ;; If `key' does not exist, then we'll silently ignore it - (when-let ((child (lsp-get structure key))) - (lsp--fix-nested-boolean child rest))))) - -(defvar lsp--formatting-indent-alist - ;; Taken from `dtrt-indent-mode' - '( - (ada-mode . ada-indent) ; Ada - (ada-ts-mode . ada-ts-mode-indent-offset) - (c++-mode . c-basic-offset) ; C++ - (c++-ts-mode . c-ts-mode-indent-offset) - (c-mode . c-basic-offset) ; C - (c-ts-mode . c-ts-mode-indent-offset) - (cperl-mode . cperl-indent-level) ; Perl - (crystal-mode . crystal-indent-level) ; Crystal (Ruby) - (csharp-mode . c-basic-offset) ; C# - (csharp-tree-sitter-mode . csharp-tree-sitter-indent-offset) ; C# - (csharp-ts-mode . csharp-ts-mode-indent-offset) ; C# (tree-sitter, Emacs29) - (css-mode . css-indent-offset) ; CSS - (d-mode . c-basic-offset) ; D - (enh-ruby-mode . enh-ruby-indent-level) ; Ruby - (erlang-mode . erlang-indent-level) ; Erlang - (ess-mode . ess-indent-offset) ; ESS (R) - (go-ts-mode . go-ts-mode-indent-offset) - (gpr-mode . gpr-indent-offset) ; GNAT Project - (gpr-ts-mode . gpr-ts-mode-indent-offset) - (hack-mode . hack-indent-offset) ; Hack - (java-mode . c-basic-offset) ; Java - (java-ts-mode . java-ts-mode-indent-offset) - (jde-mode . c-basic-offset) ; Java (JDE) - (js-mode . js-indent-level) ; JavaScript - (js-ts-mode . js-indent-level) - (js2-mode . js2-basic-offset) ; JavaScript-IDE - (js3-mode . js3-indent-level) ; JavaScript-IDE - (json-mode . js-indent-level) ; JSON - (json-ts-mode . json-ts-mode-indent-offset) - (lua-mode . lua-indent-level) ; Lua - (lua-ts-mode . lua-ts-indent-offset) - (nxml-mode . nxml-child-indent) ; XML - (objc-mode . c-basic-offset) ; Objective C - (pascal-mode . pascal-indent-level) ; Pascal - (perl-mode . perl-indent-level) ; Perl - (php-mode . c-basic-offset) ; PHP - (php-ts-mode . php-ts-mode-indent-offset) ; PHP - (powershell-mode . powershell-indent) ; PowerShell - (powershell-ts-mode . powershell-ts-mode-indent-offset) ; PowerShell - (raku-mode . raku-indent-offset) ; Perl6/Raku - (ruby-mode . ruby-indent-level) ; Ruby - (rust-mode . rust-indent-offset) ; Rust - (rust-ts-mode . rust-ts-mode-indent-offset) - (rustic-mode . rustic-indent-offset) ; Rust - (scala-mode . scala-indent:step) ; Scala - (sgml-mode . sgml-basic-offset) ; SGML - (sh-mode . sh-basic-offset) ; Shell Script - (toml-ts-mode . toml-ts-mode-indent-offset) - (typescript-mode . typescript-indent-level) ; Typescript - (typescript-ts-mode . typescript-ts-mode-indent-offset) ; Typescript (tree-sitter, Emacs29) - (yaml-mode . yaml-indent-offset) ; YAML - (yang-mode . c-basic-offset) ; YANG (yang-mode) - - (default . standard-indent)) ; default fallback - "A mapping from `major-mode' to its indent variable.") - -(defun lsp--get-indent-width (mode) - "Get indentation offset for MODE." - (or (alist-get mode lsp--formatting-indent-alist) - (lsp--get-indent-width (or (get mode 'derived-mode-parent) 'default)))) - -(defun lsp--make-document-formatting-params () - "Create document formatting params." - (lsp-make-document-formatting-params - :text-document (lsp--text-document-identifier) - :options (lsp-make-formatting-options - :tab-size (symbol-value (lsp--get-indent-width major-mode)) - :insert-spaces (lsp-json-bool (not indent-tabs-mode)) - :trim-trailing-whitespace? (lsp-json-bool lsp-trim-trailing-whitespace) - :insert-final-newline? (lsp-json-bool lsp-insert-final-newline) - :trim-final-newlines? (lsp-json-bool lsp-trim-final-newlines)))) - -(defun lsp-format-buffer () - "Ask the server to format this document." - (interactive "*") - (cond ((lsp-feature? "textDocument/formatting") - (let ((edits (lsp-request "textDocument/formatting" - (lsp--make-document-formatting-params)))) - (if (seq-empty-p edits) - (lsp--info "No formatting changes provided") - (lsp--apply-text-edits edits 'format)))) - ((lsp-feature? "textDocument/rangeFormatting") - (save-restriction - (widen) - (lsp-format-region (point-min) (point-max)))) - (t (signal 'lsp-capability-not-supported (list "documentFormattingProvider"))))) - -(defun lsp-format-region (s e) - "Ask the server to format the region, or if none is selected, the current line." - (interactive "r") - (let ((edits (lsp-request - "textDocument/rangeFormatting" - (lsp--make-document-range-formatting-params s e)))) - (if (seq-empty-p edits) - (lsp--info "No formatting changes provided") - (lsp--apply-text-edits edits 'format)))) - -(defmacro lsp-make-interactive-code-action (func-name code-action-kind) - "Define an interactive function FUNC-NAME that attempts to -execute a CODE-ACTION-KIND action." - `(defun ,(intern (concat "lsp-" (symbol-name func-name))) () - ,(format "Perform the %s code action, if available." code-action-kind) - (interactive) - ;; Even when `lsp-auto-execute-action' is nil, it still makes sense to - ;; auto-execute here: the user has specified exactly what they want. - (let ((lsp-auto-execute-action t)) - (condition-case nil - (lsp-execute-code-action-by-kind ,code-action-kind) - (lsp-no-code-actions - (when (called-interactively-p 'any) - (lsp--info ,(format "%s action not available" code-action-kind)))))))) - -(lsp-make-interactive-code-action organize-imports "source.organizeImports") - -(defun lsp--make-document-range-formatting-params (start end) - "Make DocumentRangeFormattingParams for selected region." - (lsp:set-document-range-formatting-params-range (lsp--make-document-formatting-params) - (lsp--region-to-range start end))) - -(defconst lsp--highlight-kind-face - '((1 . lsp-face-highlight-textual) - (2 . lsp-face-highlight-read) - (3 . lsp-face-highlight-write))) - -(defun lsp--remove-overlays (name) - (save-restriction - (widen) - (remove-overlays (point-min) (point-max) name t))) - -(defun lsp-document-highlight () - "Highlight all relevant references to the symbol under point." - (interactive) - (lsp--remove-overlays 'lsp-highlight) ;; clear any previous highlights - (setq lsp--have-document-highlights nil - lsp--symbol-bounds-of-last-highlight-invocation nil) - (let ((lsp-enable-symbol-highlighting t)) - (lsp--document-highlight))) - -(defun lsp--document-highlight-callback (highlights) - "Create a callback to process the reply of a -`textDocument/documentHighlight' message for the buffer BUF. -A reference is highlighted only if it is visible in a window." - (lsp--remove-overlays 'lsp-highlight) - - (let* ((wins-visible-pos (-map (lambda (win) - (cons (1- (line-number-at-pos (window-start win) t)) - (1+ (line-number-at-pos (window-end win) t)))) - (get-buffer-window-list nil nil 'visible)))) - (setq lsp--have-document-highlights t) - (-map - (-lambda ((&DocumentHighlight :range (&Range :start (start &as &Position :line start-line) - :end (end &as &Position :line end-line)) - :kind?)) - (-map - (-lambda ((start-window . end-window)) - ;; Make the overlay only if the reference is visible - (when (and (> (1+ start-line) start-window) - (< (1+ end-line) end-window)) - (let ((start-point (lsp--position-to-point start)) - (end-point (lsp--position-to-point end))) - (when (not (and lsp-symbol-highlighting-skip-current - (<= start-point (point) end-point))) - (-doto (make-overlay start-point end-point) - (overlay-put 'face (cdr (assq (or kind? 1) lsp--highlight-kind-face))) - (overlay-put 'lsp-highlight t)))))) - wins-visible-pos)) - highlights))) - -(defcustom lsp-symbol-kinds - '((1 . "File") - (2 . "Module") - (3 . "Namespace") - (4 . "Package") - (5 . "Class") - (6 . "Method") - (7 . "Property") - (8 . "Field") - (9 . "Constructor") - (10 . "Enum") - (11 . "Interface") - (12 . "Function") - (13 . "Variable") - (14 . "Constant") - (15 . "String") - (16 . "Number") - (17 . "Boolean") - (18 . "Array") - (19 . "Object") - (20 . "Key") - (21 . "Null") - (22 . "Enum Member") - (23 . "Struct") - (24 . "Event") - (25 . "Operator") - (26 . "Type Parameter")) - "Alist mapping SymbolKinds to human-readable strings. -Various Symbol objects in the LSP protocol have an integral type, -specifying what they are. This alist maps such type integrals to -readable representations of them. See -`https://microsoft.github.io/language-server-protocol/specifications/specification-current/', -namespace SymbolKind." - :group 'lsp-mode - :type '(alist :key-type integer :value-type string)) -(defalias 'lsp--symbol-kind 'lsp-symbol-kinds) - -(lsp-defun lsp--symbol-information-to-xref - ((&SymbolInformation :kind :name - :location (&Location :uri :range (&Range :start - (&Position :line :character))))) - "Return a `xref-item' from SYMBOL information." - (xref-make (format "[%s] %s" (alist-get kind lsp-symbol-kinds) name) - (xref-make-file-location (lsp--uri-to-path uri) - line - character))) - -(defun lsp--get-document-symbols () - "Get document symbols. - -If the buffer has not been modified since symbols were last -retrieved, simply return the latest result. - -Else, if the request was initiated by Imenu updating its menu-bar -entry, perform it asynchronously; i.e., give Imenu the latest -result and then force a refresh when a new one is available. - -Else (e.g., due to interactive use of `imenu' or `xref'), -perform the request synchronously." - (if (= (buffer-chars-modified-tick) lsp--document-symbols-tick) - lsp--document-symbols - (let ((method "textDocument/documentSymbol") - (params `(:textDocument ,(lsp--text-document-identifier))) - (tick (buffer-chars-modified-tick))) - (if (not lsp--document-symbols-request-async) - (prog1 - (setq lsp--document-symbols (lsp-request method params)) - (setq lsp--document-symbols-tick tick)) - (lsp-request-async method params - (lambda (document-symbols) - (setq lsp--document-symbols document-symbols - lsp--document-symbols-tick tick) - (lsp--imenu-refresh)) - :mode 'alive - :cancel-token :document-symbols) - lsp--document-symbols)))) - -(advice-add 'imenu-update-menubar :around - (lambda (oldfun &rest r) - (let ((lsp--document-symbols-request-async t)) - (apply oldfun r)))) - -(defun lsp--document-symbols->document-symbols-hierarchy (document-symbols current-position) - "Convert DOCUMENT-SYMBOLS to symbols hierarchy on CURRENT-POSITION." - (-let (((symbol &as &DocumentSymbol? :children?) - (seq-find (-lambda ((&DocumentSymbol :range)) - (lsp-point-in-range? current-position range)) - document-symbols))) - (if children? - (cons symbol (lsp--document-symbols->document-symbols-hierarchy children? current-position)) - (when symbol - (list symbol))))) - -(lsp-defun lsp--symbol-information->document-symbol ((&SymbolInformation :name :kind :location :container-name? :deprecated?)) - "Convert a SymbolInformation to a DocumentInformation" - (lsp-make-document-symbol :name name - :kind kind - :range (lsp:location-range location) - :children? nil - :deprecated? deprecated? - :selection-range (lsp:location-range location) - :detail? container-name?)) - -(defun lsp--symbols-informations->document-symbols-hierarchy (symbols-informations current-position) - "Convert SYMBOLS-INFORMATIONS to symbols hierarchy on CURRENT-POSITION." - (--> symbols-informations - (-keep (-lambda ((symbol &as &SymbolInformation :location (&Location :range))) - (when (lsp-point-in-range? current-position range) - (lsp--symbol-information->document-symbol symbol))) - it) - (sort it (-lambda ((&DocumentSymbol :range (&Range :start a-start-position :end a-end-position)) - (&DocumentSymbol :range (&Range :start b-start-position :end b-end-position))) - (and (lsp--position-compare b-start-position a-start-position) - (lsp--position-compare a-end-position b-end-position)))))) - -(defun lsp--symbols->document-symbols-hierarchy (symbols) - "Convert SYMBOLS to symbols-hierarchy." - (when-let ((first-symbol (lsp-seq-first symbols))) - (let ((cur-position (lsp-make-position :line (plist-get (lsp--cur-position) :line) - :character (plist-get (lsp--cur-position) :character)))) - (if (lsp-symbol-information? first-symbol) - (lsp--symbols-informations->document-symbols-hierarchy symbols cur-position) - (lsp--document-symbols->document-symbols-hierarchy symbols cur-position))))) - -(defun lsp--xref-backend () 'xref-lsp) - -(cl-defmethod xref-backend-identifier-at-point ((_backend (eql xref-lsp))) - (propertize (or (thing-at-point 'symbol) "") - 'identifier-at-point t)) - -(defun lsp--xref-elements-index (symbols path) - (-mapcat - (-lambda (sym) - (pcase-exhaustive sym - ((lsp-interface DocumentSymbol :name :children? :selection-range (lsp-interface Range :start)) - (cons (cons (concat path name) - (lsp--position-to-point start)) - (lsp--xref-elements-index children? (concat path name " / ")))) - ((lsp-interface SymbolInformation :name :location (lsp-interface Location :range (lsp-interface Range :start))) - (list (cons (concat path name) - (lsp--position-to-point start)))))) - symbols)) - -(defvar-local lsp--symbols-cache nil) - -(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql xref-lsp))) - (if (lsp--find-workspaces-for "textDocument/documentSymbol") - (progn - (setq lsp--symbols-cache (lsp--xref-elements-index - (lsp--get-document-symbols) nil)) - lsp--symbols-cache) - (list (propertize (or (thing-at-point 'symbol) "") - 'identifier-at-point t)))) - -(cl-defmethod xref-backend-definitions ((_backend (eql xref-lsp)) identifier) - (save-excursion - (unless (get-text-property 0 'identifier-at-point identifier) - (goto-char (cl-rest (or (assoc identifier lsp--symbols-cache) - (user-error "Unable to find symbol %s in current document" identifier))))) - (lsp--locations-to-xref-items (lsp-request "textDocument/definition" - (lsp--text-document-position-params))))) - -(cl-defmethod xref-backend-references ((_backend (eql xref-lsp)) identifier) - (save-excursion - (unless (get-text-property 0 'identifier-at-point identifier) - (goto-char (cl-rest (or (assoc identifier lsp--symbols-cache) - (user-error "Unable to find symbol %s" identifier))))) - (lsp--locations-to-xref-items (lsp-request "textDocument/references" - (lsp--make-reference-params nil lsp-references-exclude-definition))))) - -(cl-defmethod xref-backend-apropos ((_backend (eql xref-lsp)) pattern) - (seq-map #'lsp--symbol-information-to-xref - (lsp-request "workspace/symbol" `(:query ,pattern)))) - -(defcustom lsp-rename-use-prepare t - "Whether `lsp-rename' should do a prepareRename first. -For some language servers, textDocument/prepareRename might be -too slow, in which case this variable may be set to nil. -`lsp-rename' will then use `thing-at-point' `symbol' to determine -the symbol to rename at point." - :group 'lsp-mode - :type 'boolean) - -(defun lsp--get-symbol-to-rename () - "Get a symbol to rename and placeholder at point. -Returns a cons ((START . END) . PLACEHOLDER?), and nil if -renaming is generally supported but cannot be done at point. -START and END are the bounds of the identifiers being renamed, -while PLACEHOLDER?, is either nil or a string suggested by the -language server as the initial input of a new-name prompt." - (unless (lsp-feature? "textDocument/rename") - (error "The connected server(s) doesn't support renaming")) - (if (and lsp-rename-use-prepare (lsp-feature? "textDocument/prepareRename")) - (when-let ((response - (lsp-request "textDocument/prepareRename" - (lsp--text-document-position-params)))) - (let* ((bounds (lsp--range-to-region - (if (lsp-range? response) - response - (lsp:prepare-rename-result-range response)))) - (placeholder - (and (not (lsp-range? response)) - (lsp:prepare-rename-result-placeholder response)))) - (cons bounds placeholder))) - (when-let ((bounds (bounds-of-thing-at-point 'symbol))) - (cons bounds nil)))) - -(defface lsp-face-rename '((t :underline t)) - "Face used to highlight the identifier being renamed. -Renaming can be done using `lsp-rename'." - :group 'lsp-mode) - -(defface lsp-rename-placeholder-face '((t :inherit font-lock-variable-name-face)) - "Face used to display the rename placeholder in. -When calling `lsp-rename' interactively, this will be the face of -the new name." - :group 'lsp-mode) - -(defvar lsp-rename-history '() - "History for `lsp--read-rename'.") - -(defun lsp--read-rename (at-point) - "Read a new name for a `lsp-rename' at `point' from the user. -AT-POINT shall be a structure as returned by -`lsp--get-symbol-to-rename'. - -Returns a string, which should be the new name for the identifier -at point. If renaming cannot be done at point (as determined from -AT-POINT), throw a `user-error'. - -This function is for use in `lsp-rename' only, and shall not be -relied upon." - (unless at-point - (user-error "`lsp-rename' is invalid here")) - (-let* ((((start . end) . placeholder?) at-point) - ;; Do the `buffer-substring' first to not include `lsp-face-rename' - (rename-me (buffer-substring start end)) - (placeholder (or placeholder? rename-me)) - (placeholder (propertize placeholder 'face 'lsp-rename-placeholder-face)) - - overlay) - ;; We need unwind protect, as the user might cancel here, causing the - ;; overlay to linger. - (unwind-protect - (progn - (setq overlay (make-overlay start end)) - (overlay-put overlay 'face 'lsp-face-rename) - - (read-string (format "Rename %s to: " rename-me) placeholder - 'lsp-rename-history)) - (and overlay (delete-overlay overlay))))) - -(defun lsp-rename (newname) - "Rename the symbol (and all references to it) under point to NEWNAME." - (interactive (list (lsp--read-rename (lsp--get-symbol-to-rename)))) - (when-let ((edits (lsp-request "textDocument/rename" - `( :textDocument ,(lsp--text-document-identifier) - :position ,(lsp--cur-position) - :newName ,newname)))) - (lsp--apply-workspace-edit edits 'rename))) - -(defun lsp--on-rename-file (old-func old-name new-name &optional ok-if-already-exists?) - "Advice around function `rename-file'. -Applies OLD-FUNC with OLD-NAME, NEW-NAME and OK-IF-ALREADY-EXISTS?. - -This advice sends workspace/willRenameFiles before renaming file -to check if server wants to apply any workspaceEdits after renamed." - (if (and lsp-apply-edits-after-file-operations - (lsp--send-will-rename-files-p old-name)) - (let ((params (lsp-make-rename-files-params - :files (vector (lsp-make-file-rename - :oldUri (lsp--path-to-uri old-name) - :newUri (lsp--path-to-uri new-name)))))) - (when-let ((edits (lsp-request "workspace/willRenameFiles" params))) - (lsp--apply-workspace-edit edits 'rename-file) - (funcall old-func old-name new-name ok-if-already-exists?) - (when (lsp--send-did-rename-files-p) - (lsp-notify "workspace/didRenameFiles" params)))) - (funcall old-func old-name new-name ok-if-already-exists?))) - -(advice-add 'rename-file :around #'lsp--on-rename-file) - -(defcustom lsp-xref-force-references nil - "If non-nil threat everything as references(e. g. jump if only one item.)" - :group 'lsp-mode - :type 'boolean) - -(defun lsp-show-xrefs (xrefs display-action references?) - (unless (region-active-p) (push-mark nil t)) - (if (boundp 'xref-show-definitions-function) - (with-no-warnings - (xref-push-marker-stack) - (funcall (if (and references? (not lsp-xref-force-references)) - xref-show-xrefs-function - xref-show-definitions-function) - (-const xrefs) - `((window . ,(selected-window)) - (display-action . ,display-action) - ,(if (and references? (not lsp-xref-force-references)) - `(auto-jump . ,xref-auto-jump-to-first-xref) - `(auto-jump . ,xref-auto-jump-to-first-definition))))) - (xref--show-xrefs xrefs display-action))) - -(cl-defmethod seq-empty-p ((ht hash-table)) - "Function `seq-empty-p' for hash-table." - (hash-table-empty-p ht)) - -(cl-defun lsp-find-locations (method &optional extra &key display-action references?) - "Send request named METHOD and get cross references of the symbol under point. -EXTRA is a plist of extra parameters. -REFERENCES? t when METHOD returns references." - (let ((loc (lsp-request method - (append (lsp--text-document-position-params) extra)))) - (if (seq-empty-p loc) - (lsp--error "Not found for: %s" (or (thing-at-point 'symbol t) "")) - (lsp-show-xrefs (lsp--locations-to-xref-items loc) display-action references?)))) - -(cl-defun lsp-find-declaration (&key display-action) - "Find declarations of the symbol under point." - (interactive) - (lsp-find-locations "textDocument/declaration" nil :display-action display-action)) - -(cl-defun lsp-find-definition (&key display-action) - "Find definitions of the symbol under point." - (interactive) - (lsp-find-locations "textDocument/definition" nil :display-action display-action)) - -(defun lsp-find-definition-mouse (click) - "Click to start `lsp-find-definition' at clicked point." - (interactive "e") - (let* ((ec (event-start click)) - (p1 (posn-point ec)) - (w1 (posn-window ec))) - (select-window w1) - (goto-char p1) - (lsp-find-definition))) - -(cl-defun lsp-find-implementation (&key display-action) - "Find implementations of the symbol under point." - (interactive) - (lsp-find-locations "textDocument/implementation" - nil - :display-action display-action - :references? t)) - -(cl-defun lsp-find-references (&optional exclude-declaration &key display-action) - "Find references of the symbol under point." - (interactive "P") - (lsp-find-locations "textDocument/references" - (list :context `(:includeDeclaration ,(lsp-json-bool (not (or exclude-declaration lsp-references-exclude-definition))))) - :display-action display-action - :references? t)) - -(cl-defun lsp-find-type-definition (&key display-action) - "Find type definitions of the symbol under point." - (interactive) - (lsp-find-locations "textDocument/typeDefinition" nil :display-action display-action)) - -(defalias 'lsp-find-custom #'lsp-find-locations) -(defalias 'lsp-goto-implementation #'lsp-find-implementation) -(defalias 'lsp-goto-type-definition #'lsp-find-type-definition) - -(with-eval-after-load 'evil - (evil-set-command-property 'lsp-find-definition :jump t) - (evil-set-command-property 'lsp-find-implementation :jump t) - (evil-set-command-property 'lsp-find-references :jump t) - (evil-set-command-property 'lsp-find-type-definition :jump t)) - -(defun lsp--workspace-method-supported? (check-command method capability workspace) - (with-lsp-workspace workspace - (if check-command - (funcall check-command workspace) - (or - (when capability (lsp--capability capability)) - (lsp--registered-capability method) - (and (not capability) (not check-command)))))) - -(defun lsp-disable-method-for-server (method server-id) - "Disable METHOD for SERVER-ID." - (cl-callf - (lambda (reqs) - (-let (((&plist :check-command :capability) reqs)) - (list :check-command - (lambda (workspace) - (unless (-> workspace - lsp--workspace-client - lsp--client-server-id - (eq server-id)) - (lsp--workspace-method-supported? check-command - method - capability - workspace)))))) - (alist-get method lsp-method-requirements nil nil 'string=))) - -(defun lsp--find-workspaces-for (msg-or-method) - "Find all workspaces in the current project that can handle MSG." - (let ((method (if (stringp msg-or-method) - msg-or-method - (plist-get msg-or-method :method)))) - (-if-let (reqs (cdr (assoc method lsp-method-requirements))) - (-let (((&plist :capability :check-command) reqs)) - (-filter - (-partial #'lsp--workspace-method-supported? - check-command method capability) - (lsp-workspaces))) - (lsp-workspaces)))) - -(defun lsp-can-execute-command? (command-name) - "Returns non-nil if current language server(s) can execute COMMAND-NAME. -The command is executed via `workspace/executeCommand'" - (cl-position - command-name - (lsp:execute-command-options-commands - (lsp:server-capabilities-execute-command-provider? - (lsp--server-capabilities))) - :test #'equal)) - -(defalias 'lsp-feature? 'lsp--find-workspaces-for) - -(cl-defmethod lsp-execute-command (_server _command _arguments) - "Dispatch COMMAND execution." - (signal 'cl-no-applicable-method nil)) - -(defun lsp-workspace-command-execute (command &optional args) - "Execute workspace COMMAND with ARGS." - (condition-case-unless-debug err - (let ((params (if args - (list :command command :arguments args) - (list :command command)))) - (lsp-request "workspace/executeCommand" params)) - (error - (error "`workspace/executeCommand' with `%s' failed.\n\n%S" - command err)))) - -(defun lsp-send-execute-command (command &optional args) - "Create and send a `workspace/executeCommand' message having command COMMAND -and optional ARGS." - (lsp-workspace-command-execute command args)) - -(defalias 'lsp-point-to-position #'lsp--point-to-position) -(defalias 'lsp-text-document-identifier #'lsp--text-document-identifier) -(defalias 'lsp--send-execute-command #'lsp-send-execute-command) -(defalias 'lsp-on-open #'lsp--text-document-did-open) -(defalias 'lsp-on-save #'lsp--text-document-did-save) - -(defun lsp--set-configuration (settings) - "Set the SETTINGS for the lsp server." - (lsp-notify "workspace/didChangeConfiguration" `(:settings ,settings))) - -(defun lsp-current-buffer () - (or lsp--virtual-buffer - (current-buffer))) - -(defun lsp-buffer-live-p (buffer-id) - (if-let ((buffer-live (plist-get buffer-id :buffer-live?))) - (funcall buffer-live buffer-id) - (buffer-live-p buffer-id))) - -(defun lsp--on-set-visited-file-name (old-func &rest args) - "Advice around function `set-visited-file-name'. - -This advice sends textDocument/didClose for the old file and -textDocument/didOpen for the new file." - (when lsp--cur-workspace - (lsp--text-document-did-close t)) - (prog1 (apply old-func args) - (when lsp--cur-workspace - (lsp--text-document-did-open)))) - -(advice-add 'set-visited-file-name :around #'lsp--on-set-visited-file-name) - -(defcustom lsp-flush-delayed-changes-before-next-message t - "If non-nil send the document changes update before sending other messages. - -If nil, and `lsp-debounce-full-sync-notifications' is non-nil, - change notifications will be throttled by - `lsp-debounce-full-sync-notifications-interval' regardless of - other messages." - :group 'lsp-mode - :type 'boolean) - -(defvar lsp--not-flushing-delayed-changes t) - -(defun lsp--send-no-wait (message proc) - "Send MESSAGE to PROC without waiting for further output." - - (when (and lsp--not-flushing-delayed-changes - lsp-flush-delayed-changes-before-next-message) - (let ((lsp--not-flushing-delayed-changes nil)) - (lsp--flush-delayed-changes))) - (lsp-process-send proc message)) - -(define-error 'lsp-parse-error - "Error parsing message from language server" 'lsp-error) -(define-error 'lsp-unknown-message-type - "Unknown message type" '(lsp-error lsp-parse-error)) -(define-error 'lsp-unknown-json-rpc-version - "Unknown JSON-RPC protocol version" '(lsp-error lsp-parse-error)) -(define-error 'lsp-no-content-length - "Content-Length header missing in message" '(lsp-error lsp-parse-error)) -(define-error 'lsp-invalid-header-name - "Invalid header name" '(lsp-error lsp-parse-error)) - -;; id method -;; x x request -;; x . response -;; . x notification -(defun lsp--get-message-type (json-data) - "Get the message type from JSON-DATA." - (if (lsp:json-message-id? json-data) - (if (lsp:json-message-error? json-data) - 'response-error - (if (lsp:json-message-method? json-data) - 'request - 'response)) - 'notification)) - -(defconst lsp--default-notification-handlers - (ht ("window/showMessage" #'lsp--window-show-message) - ("window/logMessage" #'lsp--window-log-message) - ("window/showInputBox" #'lsp--window-show-input-box) - ("window/showQuickPick" #'lsp--window-show-quick-pick) - ("textDocument/publishDiagnostics" #'lsp--on-diagnostics) - ("textDocument/diagnosticsEnd" #'ignore) - ("textDocument/diagnosticsBegin" #'ignore) - ("telemetry/event" #'ignore) - ("$/progress" (lambda (workspace params) - (funcall lsp-progress-function workspace params))))) - -(lsp-defun lsp--on-notification (workspace (&JSONNotification :params :method)) - "Call the appropriate handler for NOTIFICATION." - (-let ((client (lsp--workspace-client workspace))) - (when (lsp--log-io-p method) - (lsp--log-entry-new (lsp--make-log-entry method nil params 'incoming-notif) - lsp--cur-workspace)) - (if-let ((handler (or (gethash method (lsp--client-notification-handlers client)) - (gethash method lsp--default-notification-handlers)))) - (funcall handler workspace params) - (when (and method (not (string-prefix-p "$" method))) - (lsp-warn "Unknown notification: %s" method))))) - -(lsp-defun lsp--build-workspace-configuration-response ((&ConfigurationParams :items)) - "Get section configuration. -PARAMS are the `workspace/configuration' request params" - (->> items - (-map (-lambda ((&ConfigurationItem :section?)) - (-let* ((path-parts (split-string section? "\\.")) - (path-without-last (s-join "." (-slice path-parts 0 -1))) - (path-parts-len (length path-parts))) - (cond - ((<= path-parts-len 1) - (ht-get (lsp-configuration-section section?) - (car-safe path-parts) - (ht-create))) - ((> path-parts-len 1) - (when-let ((section (lsp-configuration-section path-without-last)) - (keys path-parts)) - (while (and keys section) - (setf section (ht-get section (pop keys)))) - section)))))) - (apply #'vector))) - -(defun lsp--ms-since (timestamp) - "Integer number of milliseconds since TIMESTAMP. Fractions discarded." - (floor (* 1000 (float-time (time-since timestamp))))) - -(defun lsp--send-request-response (workspace recv-time request response) - "Send the RESPONSE for REQUEST in WORKSPACE and log if needed." - (-let* (((&JSONResponse :params :method :id) request) - (process (lsp--workspace-proc workspace)) - (response (lsp--make-response id response)) - (req-entry (and lsp-log-io - (lsp--make-log-entry method id params 'incoming-req))) - (resp-entry (and lsp-log-io - (lsp--make-log-entry method id response 'outgoing-resp - (lsp--ms-since recv-time))))) - ;; Send response to the server. - (when (lsp--log-io-p method) - (lsp--log-entry-new req-entry workspace) - (lsp--log-entry-new resp-entry workspace)) - (lsp--send-no-wait response process))) - -(lsp-defun lsp--on-request (workspace (request &as &JSONRequest :params :method)) - "Call the appropriate handler for REQUEST, and send the return value to the -server. WORKSPACE is the active workspace." - (-let* ((recv-time (current-time)) - (client (lsp--workspace-client workspace)) - (buffers (lsp--workspace-buffers workspace)) - handler - (response (cond - ((setq handler (gethash method (lsp--client-request-handlers client) nil)) - (funcall handler workspace params)) - ((setq handler (gethash method (lsp--client-async-request-handlers client) nil)) - (funcall handler workspace params - (-partial #'lsp--send-request-response - workspace recv-time request)) - 'delay-response) - ((equal method "client/registerCapability") - (mapc #'lsp--server-register-capability - (lsp:registration-params-registrations params)) - (mapc (lambda (buf) - (when (lsp-buffer-live-p buf) - (lsp-with-current-buffer buf - (lsp-unconfig-buffer) - (lsp-configure-buffer)))) - buffers) - nil) - ((equal method "window/showMessageRequest") - (let ((choice (lsp--window-log-message-request params))) - `(:title ,choice))) - ((equal method "window/showDocument") - (let ((success? (lsp--window-show-document params))) - (lsp-make-show-document-result :success (or success? - :json-false)))) - ((equal method "client/unregisterCapability") - (mapc #'lsp--server-unregister-capability - (lsp:unregistration-params-unregisterations params)) - (mapc (lambda (buf) - (when (lsp-buffer-live-p buf) - (lsp-with-current-buffer buf - (lsp-unconfig-buffer) - (lsp-configure-buffer)))) - buffers) - nil) - ((equal method "workspace/applyEdit") - (list :applied (condition-case err - (prog1 t - (lsp--apply-workspace-edit (lsp:apply-workspace-edit-params-edit params) 'server-requested)) - (error - (lsp--error "Failed to apply edits with message %s" - (error-message-string err)) - :json-false)))) - ((equal method "workspace/configuration") - (with-lsp-workspace workspace - (if-let ((buf (car buffers))) - (lsp-with-current-buffer buf - (lsp--build-workspace-configuration-response params)) - (lsp--with-workspace-temp-buffer (lsp--workspace-root workspace) - (lsp--build-workspace-configuration-response params))))) - ((equal method "workspace/workspaceFolders") - (let ((folders (or (-> workspace - (lsp--workspace-client) - (lsp--client-server-id) - (gethash (lsp-session-server-id->folders (lsp-session)))) - (lsp-session-folders (lsp-session))))) - (->> folders - (-distinct) - (-map (lambda (folder) - (list :uri (lsp--path-to-uri folder)))) - (apply #'vector)))) - ((equal method "window/workDoneProgress/create") - nil ;; no specific reply, no processing required - ) - ((equal method "workspace/semanticTokens/refresh") - (when (and lsp-semantic-tokens-enable - (fboundp 'lsp--semantic-tokens-on-refresh)) - (lsp--semantic-tokens-on-refresh workspace)) - nil) - ((equal method "workspace/codeLens/refresh") - (when (and lsp-lens-enable - (fboundp 'lsp--lens-on-refresh)) - (lsp--lens-on-refresh workspace)) - nil) - ((equal method "workspace/diagnostic/refresh") - nil) - (t (lsp-warn "Unknown request method: %s" method) nil)))) - ;; Send response to the server. - (unless (eq response 'delay-response) - (lsp--send-request-response workspace recv-time request response)))) - -(lsp-defun lsp--error-string ((&JSONError :message :code)) - "Format ERR as a user friendly string." - (format "Error from the Language Server: %s (%s)" - message - (or (car (alist-get code lsp--errors)) "Unknown error"))) - -(defun lsp--get-body-length (headers) - (let ((content-length (cdr (assoc "Content-Length" headers)))) - (if content-length - (string-to-number content-length) - - ;; This usually means either the server or our parser is - ;; screwed up with a previous Content-Length - (error "No Content-Length header")))) - -(defun lsp--parse-header (s) - "Parse string S as a LSP (KEY . VAL) header." - (let ((pos (string-match "\:" s)) - key val) - (unless pos - (signal 'lsp-invalid-header-name (list s))) - (setq key (substring s 0 pos) - val (s-trim-left (substring s (+ 1 pos)))) - (when (equal key "Content-Length") - (cl-assert (cl-loop for c across val - when (or (> c ?9) (< c ?0)) return nil - finally return t) - nil (format "Invalid Content-Length value: %s" val))) - (cons key val))) - -(defmacro lsp--read-json (str) - "Read json string STR." - (if (progn - (require 'json) - (fboundp 'json-parse-string)) - `(json-parse-string ,str - :object-type (if lsp-use-plists - 'plist - 'hash-table) - :null-object nil - :false-object nil) - `(let ((json-array-type 'vector) - (json-object-type (if lsp-use-plists - 'plist - 'hash-table)) - (json-false nil)) - (json-read-from-string ,str)))) - -(defmacro lsp-json-read-buffer () - "Read json from the current buffer." - (if (progn - (require 'json) - (fboundp 'json-parse-buffer)) - `(json-parse-buffer :object-type (if lsp-use-plists - 'plist - 'hash-table) - :null-object nil - :false-object nil) - `(let ((json-array-type 'vector) - (json-object-type (if lsp-use-plists - 'plist - 'hash-table)) - (json-false nil)) - (json-read)))) - -(defun lsp--read-json-file (file-path) - "Read json file." - (-> file-path - (f-read-text) - (lsp--read-json))) - -(defun lsp--parser-on-message (json-data workspace) - "Called when the parser P read a complete MSG from the server." - (with-demoted-errors "Error processing message %S." - (with-lsp-workspace workspace - (let* ((client (lsp--workspace-client workspace)) - (id (--when-let (lsp:json-response-id json-data) - (if (stringp it) (string-to-number it) it))) - (data (lsp:json-response-result json-data))) - (pcase (lsp--get-message-type json-data) - ('response - (cl-assert id) - (-let [(callback _ method _ before-send) (gethash id (lsp--client-response-handlers client))] - (when (lsp--log-io-p method) - (lsp--log-entry-new - (lsp--make-log-entry method id data 'incoming-resp - (lsp--ms-since before-send)) - workspace)) - (when callback - (remhash id (lsp--client-response-handlers client)) - (funcall callback (lsp:json-response-result json-data))))) - ('response-error - (cl-assert id) - (-let [(_ callback method _ before-send) (gethash id (lsp--client-response-handlers client))] - (when (lsp--log-io-p method) - (lsp--log-entry-new - (lsp--make-log-entry method id (lsp:json-response-error-error json-data) - 'incoming-resp (lsp--ms-since before-send)) - workspace)) - (when callback - (remhash id (lsp--client-response-handlers client)) - (funcall callback (lsp:json-response-error-error json-data))))) - ('notification - (lsp--on-notification workspace json-data)) - ('request (lsp--on-request workspace json-data))))))) - -(defun lsp--create-filter-function (workspace) - "Make filter for the workspace." - (let ((body-received 0) - leftovers body-length body chunk) - (lambda (_proc input) - (setf chunk (if (s-blank? leftovers) - (encode-coding-string input 'utf-8-unix t) - (concat leftovers (encode-coding-string input 'utf-8-unix t)))) - - (let (messages) - (while (not (s-blank? chunk)) - (if (not body-length) - ;; Read headers - (if-let ((body-sep-pos (string-match-p "\r\n\r\n" chunk))) - ;; We've got all the headers, handle them all at once: - (setf body-length (lsp--get-body-length - (mapcar #'lsp--parse-header - (split-string - (substring-no-properties chunk - (or (string-match-p "Content-Length" chunk) - (error "Unable to find Content-Length header.")) - body-sep-pos) - "\r\n"))) - body-received 0 - leftovers nil - chunk (substring-no-properties chunk (+ body-sep-pos 4))) - - ;; Haven't found the end of the headers yet. Save everything - ;; for when the next chunk arrives and await further input. - (setf leftovers chunk - chunk nil)) - (let* ((chunk-length (string-bytes chunk)) - (left-to-receive (- body-length body-received)) - (this-body (if (< left-to-receive chunk-length) - (prog1 (substring-no-properties chunk 0 left-to-receive) - (setf chunk (substring-no-properties chunk left-to-receive))) - (prog1 chunk - (setf chunk nil)))) - (body-bytes (string-bytes this-body))) - (push this-body body) - (setf body-received (+ body-received body-bytes)) - (when (>= chunk-length left-to-receive) - (condition-case err - (with-temp-buffer - (apply #'insert - (nreverse - (prog1 body - (setf leftovers nil - body-length nil - body-received nil - body nil)))) - (decode-coding-region (point-min) - (point-max) - 'utf-8) - (goto-char (point-min)) - (push (lsp-json-read-buffer) messages)) - - (error - (lsp-warn "Failed to parse the following chunk:\n'''\n%s\n'''\nwith message %s" - (concat leftovers input) - err))))))) - (mapc (lambda (msg) - (lsp--parser-on-message msg workspace)) - (nreverse messages)))))) - -(defvar-local lsp--line-col-to-point-hash-table nil - "Hash table with keys (line . col) and values that are either point positions -or markers.") - -(defcustom lsp-imenu-detailed-outline t - "Whether `lsp-imenu' should include signatures. -This will be ignored if the server doesn't provide the necessary -information, for example if it doesn't support DocumentSymbols." - :group 'lsp-imenu - :type 'boolean) - -(defcustom lsp-imenu-hide-parent-details t - "Whether `lsp-imenu' should hide signatures of parent nodes." - :group 'lsp-imenu - :type 'boolean) - -(defface lsp-details-face '((t :height 0.8 :inherit shadow)) - "Used to display additional information throughout `lsp'. -Things like line numbers, signatures, ... are considered -additional information. Often, additional faces are defined that -inherit from this face by default, like `lsp-signature-face', and -they may be customized for finer control." - :group 'lsp-mode) - -(defface lsp-signature-face '((t :inherit lsp-details-face)) - "Used to display signatures in `imenu', ...." - :group 'lsp-mode) - -(lsp-defun lsp-render-symbol ((&DocumentSymbol :name :detail? :deprecated?) - show-detail?) - "Render INPUT0, an `&DocumentSymbol', to a string. -If SHOW-DETAIL? is set, make use of its `:detail?' field (often -the signature)." - (let ((detail (and show-detail? (s-present? detail?) - (propertize (concat " " (s-trim-left detail?)) - 'face 'lsp-signature-face))) - (name (if deprecated? - (propertize name 'face 'lsp-face-semhl-deprecated) name))) - (concat name detail))) - -(lsp-defun lsp-render-symbol-information ((&SymbolInformation :name :deprecated? :container-name?) - separator) - "Render a piece of SymbolInformation. -Handle :deprecated?. If SEPARATOR is non-nil, the -symbol's (optional) parent, SEPARATOR and the symbol itself are -concatenated." - (when (and separator container-name? (not (string-empty-p container-name?))) - (setq name (concat name separator container-name?))) - (if deprecated? (propertize name 'face 'lsp-face-semhl-deprecated) name)) - -(defun lsp--symbol-to-imenu-elem (sym) - "Convert SYM to imenu element. - -SYM is a SymbolInformation message. - -Return a cons cell (full-name . start-point)." - (let ((start-point (ht-get lsp--line-col-to-point-hash-table - (lsp--get-line-and-col sym)))) - (cons (lsp-render-symbol-information - sym (and lsp-imenu-show-container-name - lsp-imenu-container-name-separator)) - start-point))) - -(lsp-defun lsp--symbol-to-hierarchical-imenu-elem ((sym &as &DocumentSymbol :children?)) - "Convert SYM to hierarchical imenu elements. - -SYM is a DocumentSymbol message. - -Return cons cell (\"symbol-name (symbol-kind)\" . start-point) if -SYM doesn't have any children. Otherwise return a cons cell with -an alist - - (\"symbol-name\" . ((\"(symbol-kind)\" . start-point) - cons-cells-from-children))" - (let ((filtered-children (lsp--imenu-filter-symbols children?)) - (signature (lsp-render-symbol sym lsp-imenu-detailed-outline))) - (if (seq-empty-p filtered-children) - (cons signature - (ht-get lsp--line-col-to-point-hash-table - (lsp--get-line-and-col sym))) - (cons signature - (lsp--imenu-create-hierarchical-index filtered-children))))) - -(lsp-defun lsp--symbol-ignore ((&SymbolInformation :kind)) - "Determine if SYM is for the current document and is to be shown." - ;; It's a SymbolInformation or DocumentSymbol, which is always in the - ;; current buffer file. - (and lsp-imenu-index-symbol-kinds - (numberp kind) - (let ((clamped-kind (if (< 0 kind (length lsp/symbol-kind-lookup)) - kind - 0))) - (not (memql (aref lsp/symbol-kind-lookup clamped-kind) - lsp-imenu-index-symbol-kinds))))) - -(lsp-defun lsp--get-symbol-type ((&SymbolInformation :kind)) - "The string name of the kind of SYM." - (alist-get kind lsp-symbol-kinds "Other")) - -(defun lsp--get-line-and-col (sym) - "Obtain the line and column corresponding to SYM." - (-let* ((location (lsp:symbol-information-location sym)) - (name-range (or (and location (lsp:location-range location)) - (lsp:document-symbol-selection-range sym))) - ((&Range :start (&Position :line :character)) name-range)) - (cons line character))) - -(defun lsp--collect-lines-and-cols (symbols) - "Return a sorted list ((line . col) ...) of the locations of SYMBOLS." - (let ((stack (mapcar 'identity symbols)) - line-col-list) - (while stack - (let ((sym (pop stack))) - (push (lsp--get-line-and-col sym) line-col-list) - (unless (seq-empty-p (lsp:document-symbol-children? sym)) - (setf stack (nconc (lsp--imenu-filter-symbols (lsp:document-symbol-children? sym)) stack))))) - (-sort #'lsp--line-col-comparator line-col-list))) - -(defun lsp--convert-line-col-to-points-batch (line-col-list) - "Convert a sorted list of positions from line-column -representation to point representation." - (let ((line-col-to-point-map (ht-create)) - (inhibit-field-text-motion t) - (curr-line 0)) - (lsp-save-restriction-and-excursion - (goto-char (point-min)) - (cl-loop for (line . col) in line-col-list do - (forward-line (- line curr-line)) - (setq curr-line line) - (let ((line-end (line-end-position))) - (if (or (not col) (> col (- line-end (point)))) - (goto-char line-end) - (forward-char col))) - (ht-set! line-col-to-point-map (cons line col) (if imenu-use-markers - (point-marker) - (point))))) - line-col-to-point-map)) - -(cl-defun lsp--line-col-comparator ((l1 . c1) (l2 . c2)) - (or (< l1 l2) - (and (= l1 l2) - (cond ((and c1 c2) - (< c1 c2)) - (c1 t))))) - -(defun lsp-imenu-create-uncategorized-index (symbols) - "Create imenu index from document SYMBOLS. -This function, unlike `lsp-imenu-create-categorized-index', does -not categorize by type, but instead returns an `imenu' index -corresponding to the symbol hierarchy returned by the server -directly." - (let* ((lsp--line-col-to-point-hash-table (-> symbols - lsp--collect-lines-and-cols - lsp--convert-line-col-to-points-batch))) - (if (lsp--imenu-hierarchical-p symbols) - (lsp--imenu-create-hierarchical-index symbols) - (lsp--imenu-create-non-hierarchical-index symbols)))) - -(defcustom lsp-imenu-symbol-kinds - '((1 . "Files") - (2 . "Modules") - (3 . "Namespaces") - (4 . "Packages") - (5 . "Classes") - (6 . "Methods") - (7 . "Properties") - (8 . "Fields") - (9 . "Constructors") - (10 . "Enums") - (11 . "Interfaces") - (12 . "Functions") - (13 . "Variables") - (14 . "Constants") - (15 . "Strings") - (16 . "Numbers") - (17 . "Booleans") - (18 . "Arrays") - (19 . "Objects") - (20 . "Keys") - (21 . "Nulls") - (22 . "Enum Members") - (23 . "Structs") - (24 . "Events") - (25 . "Operators") - (26 . "Type Parameters")) - "`lsp-symbol-kinds', but only used by `imenu'. -A new variable is needed, as it is `imenu' convention to use -pluralized categories, which `lsp-symbol-kinds' doesn't. If the -non-pluralized names are preferred, this can be set to -`lsp-symbol-kinds'." - :type '(alist :key-type integer :value-type string)) - -(defun lsp--imenu-kind->name (kind) - (alist-get kind lsp-imenu-symbol-kinds "?")) - -(defun lsp-imenu-create-top-level-categorized-index (symbols) - "Create an `imenu' index categorizing SYMBOLS by type. -Only root symbols are categorized. - -See `lsp-symbol-kinds' to customize the category naming. SYMBOLS -shall be a list of DocumentSymbols or SymbolInformation." - (mapcan - (-lambda ((type . symbols)) - (let ((cat (lsp--imenu-kind->name type)) - (symbols (lsp-imenu-create-uncategorized-index symbols))) - ;; If there is no :kind (this is being defensive), or we couldn't look it - ;; up, just display the symbols inline, without categories. - (if cat (list (cons cat symbols)) symbols))) - (sort (seq-group-by #'lsp:document-symbol-kind symbols) - (-lambda ((kinda) (kindb)) (< kinda kindb))))) - -(lsp-defun lsp--symbol->imenu ((sym &as &DocumentSymbol :selection-range (&RangeToPoint :start))) - "Convert an `&DocumentSymbol' to an `imenu' entry." - (cons (lsp-render-symbol sym lsp-imenu-detailed-outline) start)) - -(defun lsp--imenu-create-categorized-index-1 (symbols) - "Returns an `imenu' index from SYMBOLS categorized by type. -The result looks like this: ((\"Variables\" . (...)))." - (->> - symbols - (mapcan - (-lambda ((sym &as &DocumentSymbol :kind :children?)) - (if (seq-empty-p children?) - (list (list kind (lsp--symbol->imenu sym))) - (let ((parent (lsp-render-symbol sym (and lsp-imenu-detailed-outline - (not lsp-imenu-hide-parent-details))))) - (cons - (list kind (lsp--symbol->imenu sym)) - (mapcar (-lambda ((type . imenu-items)) - (list type (cons parent (mapcan #'cdr imenu-items)))) - (-group-by #'car (lsp--imenu-create-categorized-index-1 children?)))))))) - (-group-by #'car) - (mapcar - (-lambda ((kind . syms)) - (cons kind (mapcan #'cdr syms)))))) - -(defun lsp--imenu-create-categorized-index (symbols) - (let ((syms (lsp--imenu-create-categorized-index-1 symbols))) - (dolist (sym syms) - (setcar sym (lsp--imenu-kind->name (car sym)))) - syms)) - -(lsp-defun lsp--symbol-information->imenu ((sym &as &SymbolInformation :location (&Location :range (&RangeToPoint :start)))) - (cons (lsp-render-symbol-information sym nil) start)) - -(defun lsp--imenu-create-categorized-index-flat (symbols) - "Create a kind-categorized index for SymbolInformation." - (mapcar (-lambda ((kind . syms)) - (cons (lsp--imenu-kind->name kind) - (mapcan (-lambda ((parent . children)) - (let ((children (mapcar #'lsp--symbol-information->imenu children))) - (if parent (list (cons parent children)) children))) - (-group-by #'lsp:symbol-information-container-name? syms)))) - (seq-group-by #'lsp:symbol-information-kind symbols))) - -(defun lsp-imenu-create-categorized-index (symbols) - (if (lsp--imenu-hierarchical-p symbols) - (lsp--imenu-create-categorized-index symbols) - (lsp--imenu-create-categorized-index-flat symbols))) - -(defcustom lsp-imenu-index-function #'lsp-imenu-create-uncategorized-index - "Function that should create an `imenu' index. -It will be called with a list of SymbolInformation or -DocumentSymbols, whose first level is already filtered. It shall -then return an appropriate `imenu' index (see -`imenu-create-index-function'). - -Note that this interface is not stable, and subject to change any -time." - :group 'lsp-imenu - :type '(radio - (const :tag "Categorize by type" - lsp-imenu-create-categorized-index) - (const :tag "Categorize root symbols by type" - lsp-imenu-create-top-level-categorized-index) - (const :tag "Uncategorized, inline entries" - lsp-imenu-create-uncategorized-index) - (function :tag "Custom function"))) - -(defun lsp--imenu-create-index () - "Create an `imenu' index based on the language server. -Respects `lsp-imenu-index-function'." - (let ((symbols (lsp--imenu-filter-symbols (lsp--get-document-symbols)))) - (funcall lsp-imenu-index-function symbols))) - -(defun lsp--imenu-filter-symbols (symbols) - "Filter out unsupported symbols from SYMBOLS." - (seq-remove #'lsp--symbol-ignore symbols)) - -(defun lsp--imenu-hierarchical-p (symbols) - "Determine whether any element in SYMBOLS has children." - (seq-some #'lsp-document-symbol? symbols)) - -(defun lsp--imenu-create-non-hierarchical-index (symbols) - "Create imenu index for non-hierarchical SYMBOLS. - -SYMBOLS are a list of DocumentSymbol messages. - -Return a nested alist keyed by symbol names. e.g. - - ((\"SomeClass\" (\"(Class)\" . 10) - (\"someField (Field)\" . 20) - (\"someFunction (Function)\" . 25) - (\"SomeSubClass\" (\"(Class)\" . 30) - (\"someSubField (Field)\" . 35)) - (\"someFunction (Function)\" . 40))" - (seq-map (lambda (nested-alist) - (cons (car nested-alist) - (seq-map #'lsp--symbol-to-imenu-elem (cdr nested-alist)))) - (seq-group-by #'lsp--get-symbol-type symbols))) - -(defun lsp--imenu-create-hierarchical-index (symbols) - "Create imenu index for hierarchical SYMBOLS. - -SYMBOLS are a list of DocumentSymbol messages. - -Return a nested alist keyed by symbol names. e.g. - - ((\"SomeClass\" (\"(Class)\" . 10) - (\"someField (Field)\" . 20) - (\"someFunction (Function)\" . 25) - (\"SomeSubClass\" (\"(Class)\" . 30) - (\"someSubField (Field)\" . 35)) - (\"someFunction (Function)\" . 40))" - (seq-map #'lsp--symbol-to-hierarchical-imenu-elem - (seq-sort #'lsp--imenu-symbol-lessp symbols))) - -(defun lsp--imenu-symbol-lessp (sym1 sym2) - (let* ((compare-results (mapcar (lambda (method) - (funcall (alist-get method lsp--imenu-compare-function-alist) - sym1 sym2)) - lsp-imenu-sort-methods)) - (result (seq-find (lambda (result) - (not (= result 0))) - compare-results - 0))) - (and (numberp result) (< result 0)))) - -(lsp-defun lsp--imenu-compare-kind ((&SymbolInformation :kind left) - (&SymbolInformation :kind right)) - "Compare SYM1 and SYM2 by kind." - (- left right)) - -(defun lsp--imenu-compare-line-col (sym1 sym2) - (if (lsp--line-col-comparator - (lsp--get-line-and-col sym1) - (lsp--get-line-and-col sym2)) - -1 - 1)) - -(lsp-defun lsp--imenu-compare-name ((&SymbolInformation :name name1) - (&SymbolInformation :name name2)) - "Compare SYM1 and SYM2 by name." - (let ((result (compare-strings name1 0 (length name1) name2 0 (length name2)))) - (if (numberp result) result 0))) - -(defun lsp--imenu-refresh () - "Force Imenu to refresh itself." - (imenu--menubar-select imenu--rescan-item)) - -(defun lsp-enable-imenu () - "Use lsp-imenu for the current buffer." - (imenu--cleanup) - (add-function :override (local 'imenu-create-index-function) #'lsp--imenu-create-index) - (setq-local imenu-menubar-modified-tick -1) - (setq-local imenu--index-alist nil) - (when menu-bar-mode - (lsp--imenu-refresh))) - -(defun lsp-resolve-final-command (command &optional test?) - "Resolve final function COMMAND." - (let* ((command (lsp-resolve-value command)) - (command (cl-etypecase command - (list - (cl-assert (seq-every-p (apply-partially #'stringp) command) nil - "Invalid command list") - command) - (string (list command))))) - (if (and (file-remote-p default-directory) (not test?)) - (list shell-file-name "-c" - (string-join (cons "stty raw > /dev/null;" - (mapcar #'shell-quote-argument command)) - " ")) - command))) - -(defun lsp-server-present? (final-command) - "Check whether FINAL-COMMAND is present." - (let ((binary-found? (executable-find (cl-first final-command) t))) - (if binary-found? - (lsp-log "Command \"%s\" is present on the path." (s-join " " final-command)) - (lsp-log "Command \"%s\" is not present on the path." (s-join " " final-command))) - binary-found?)) - -(defun lsp--value-to-string (value) - "Convert VALUE to a string that can be set as value in an environment -variable." - (cond - ((stringp value) value) - ((booleanp value) (if value - "1" - "0")) - ((and (sequencep value) - (seq-every-p #'stringp value)) (string-join value ":")) - (t (user-error "Only strings, booleans, and sequences of strings are supported as environment variables")))) - -(defun lsp--compute-process-environment (environment-fn) - "Append a list of KEY=VALUE from the alist ENVIRONMENT to `process-environment'. -Ignore non-boolean keys whose value is nil." - (let ((environment (if environment-fn - (funcall environment-fn) - nil))) - (-flatten (cons (cl-loop for (key . value) in environment - if (or (eval value) - (eq (get value 'custom-type) 'boolean)) - collect (concat key "=" (lsp--value-to-string - (eval value)))) - process-environment)))) - -(defun lsp--default-directory-for-connection (&optional path) - "Return path to be used for the working directory of a LSP process. - -If `lsp-use-workspace-root-for-server-default-directory' is -non-nil, uses `lsp-workspace-root' to find the directory -corresponding to PATH, else returns `default-directory'." - (if lsp-use-workspace-root-for-server-default-directory - (lsp-workspace-root path) - default-directory)) - -(defun lsp--fix-remote-cmd (program) - "Helper for `lsp-stdio-connection'. -Originally coppied from eglot." - - (if (file-remote-p default-directory) - (list shell-file-name "-c" - (string-join (cons "stty raw > /dev/null;" - (mapcar #'shell-quote-argument program)) - " ")) - program)) - -(defvar tramp-use-ssh-controlmaster-options) -(defvar tramp-ssh-controlmaster-options) - -(defun lsp-stdio-connection (command &optional test-command) - "Returns a connection property list using COMMAND. -COMMAND can be: A string, denoting the command to launch the -language server. A list of strings, denoting an executable with -its command line arguments. A function, that either returns a -string or a list of strings. In all cases, the launched language -server should send and receive messages on standard I/O. -TEST-COMMAND is a function with no arguments which returns -whether the command is present or not. When not specified -`lsp-mode' will check whether the first element of the list -returned by COMMAND is available via `executable-find'" - (cl-check-type command (or string - function - (and list - (satisfies (lambda (l) - (seq-every-p (lambda (el) - (stringp el)) - l)))))) - (list :connect (lambda (filter sentinel name environment-fn workspace) - (if (and (functionp 'json-rpc-connection) - (not (file-remote-p default-directory))) - (lsp-json-rpc-connection workspace (lsp-resolve-final-command command)) - (let ((final-command (lsp-resolve-final-command command)) - (process-name (generate-new-buffer-name name)) - (process-environment - (lsp--compute-process-environment environment-fn))) - (let* ((stderr-buf (get-buffer-create (format "*%s::stderr*" process-name))) - (default-directory (lsp--default-directory-for-connection)) - (tramp-use-ssh-controlmaster-options 'suppress) - (tramp-ssh-controlmaster-options "-o ControlMaster=no -o ControlPath=none") - (proc (make-process - :name process-name - :connection-type 'pipe - :buffer (format "*%s*" process-name) - :coding 'no-conversion - :command final-command - :filter filter - :sentinel sentinel - :stderr stderr-buf - :noquery t - :file-handler t))) - (set-process-query-on-exit-flag proc nil) - (set-process-query-on-exit-flag (get-buffer-process stderr-buf) nil) - (with-current-buffer (get-buffer stderr-buf) - ;; Make the *NAME::stderr* buffer buffer-read-only, q to bury, etc. - (special-mode)) - (cons proc proc))))) - :test? (or - test-command - (lambda () - (lsp-server-present? (lsp-resolve-final-command command t)))))) - -(defun lsp--open-network-stream (host port name) - "Open network stream to HOST:PORT. - NAME will be passed to `open-network-stream'. - RETRY-COUNT is the number of the retries. - SLEEP-INTERVAL is the sleep interval between each retry." - (let* ((retries 0) - (sleep-interval 0.01) - (number-of-retries (/ lsp-tcp-connection-timeout sleep-interval)) - connection) - (while (and (not connection) (< retries number-of-retries)) - (condition-case err - (setq connection (open-network-stream name nil host port - :type 'plain - :coding 'no-conversion)) - (file-error - (let ((inhibit-message t)) - (lsp--warn "Failed to connect to %s:%s with error message %s" - host - port - (error-message-string err)) - (sleep-for sleep-interval) - (cl-incf retries))))) - (or connection (error "Port %s was never taken. Consider increasing `lsp-tcp-connection-timeout'." port)))) - -(defun lsp--port-available (host port) - "Return non-nil if HOST and PORT are available." - (condition-case _err - (delete-process (open-network-stream "*connection-test*" nil host port :type 'plain)) - (file-error t))) - -(defun lsp--find-available-port (host starting-port) - "Find available port on HOST starting from STARTING-PORT." - (let ((port starting-port)) - (while (not (lsp--port-available host port)) - (cl-incf port)) - port)) - -(defun lsp-tcp-connection (command-fn) - "Returns a connection property list similar to `lsp-stdio-connection'. -COMMAND-FN can only be a function that takes a single argument, a -port number. It should return a command for launches a language server -process listening for TCP connections on the provided port." - (cl-check-type command-fn function) - (list - :connect (lambda (filter sentinel name environment-fn _workspace) - (let* ((host "localhost") - (port (lsp--find-available-port host (cl-incf lsp--tcp-port))) - (command (funcall command-fn port)) - (final-command (if (consp command) command (list command))) - (_ (unless (lsp-server-present? final-command) - (user-error (format "Couldn't find executable %s" (cl-first final-command))))) - (process-environment - (lsp--compute-process-environment environment-fn)) - (proc (make-process :name name :connection-type 'pipe :coding 'no-conversion - :command final-command :sentinel sentinel :stderr (format "*%s::stderr*" name) :noquery t)) - (tcp-proc (lsp--open-network-stream host port (concat name "::tcp")))) - - ;; TODO: Same :noquery issue (see above) - (set-process-query-on-exit-flag proc nil) - (set-process-query-on-exit-flag tcp-proc nil) - (set-process-filter tcp-proc filter) - (cons tcp-proc proc))) - :test? (lambda () (lsp-server-present? (funcall command-fn 0))))) - -(defalias 'lsp-tcp-server 'lsp-tcp-server-command) - -(defun lsp-tcp-server-command (command-fn) - "Create tcp server connection. -In this mode Emacs is TCP server and the language server connects -to it. COMMAND is function with one parameter(the port) and it -should return the command to start the LS server." - (cl-check-type command-fn function) - (list - :connect (lambda (filter sentinel name environment-fn _workspace) - (let* (tcp-client-connection - (tcp-server (make-network-process :name (format "*tcp-server-%s*" name) - :buffer (format "*tcp-server-%s*" name) - :family 'ipv4 - :service lsp--tcp-server-port - :sentinel (lambda (proc _string) - (lsp-log "Language server %s is connected." name) - (setf tcp-client-connection proc)) - :server 't)) - (port (process-contact tcp-server :service)) - (final-command (funcall command-fn port)) - (process-environment - (lsp--compute-process-environment environment-fn)) - (cmd-proc (make-process :name name - :connection-type 'pipe - :coding 'no-conversion - :command final-command - :stderr (format "*tcp-server-%s*::stderr" name) - :noquery t))) - (let ((retries 0)) - ;; wait for the client to connect (we sit-for 500 ms, so have to double lsp--tcp-server-wait-seconds) - (while (and (not tcp-client-connection) (< retries (* 2 lsp--tcp-server-wait-seconds))) - (lsp--info "Waiting for connection for %s, retries: %s" name retries) - (sit-for 0.500) - (cl-incf retries))) - - (unless tcp-client-connection - (condition-case nil (delete-process tcp-server) (error)) - (condition-case nil (delete-process cmd-proc) (error)) - (error "Failed to create connection to %s on port %s" name port)) - (lsp--info "Successfully connected to %s" name) - - (set-process-query-on-exit-flag cmd-proc nil) - (set-process-query-on-exit-flag tcp-client-connection nil) - (set-process-query-on-exit-flag tcp-server nil) - - (set-process-filter tcp-client-connection filter) - (set-process-sentinel tcp-client-connection sentinel) - (cons tcp-client-connection cmd-proc))) - :test? (lambda () (lsp-server-present? (funcall command-fn 0))))) - -(defalias 'lsp-tramp-connection 'lsp-stdio-connection) - -(defun lsp--auto-configure () - "Autoconfigure `company', `flycheck', `lsp-ui', etc if they are installed." - (when (functionp 'lsp-ui-mode) - (lsp-ui-mode)) - - (if lsp-headerline-breadcrumb-enable - (add-hook 'lsp-configure-hook 'lsp-headerline-breadcrumb-mode) - (remove-hook 'lsp-configure-hook 'lsp-headerline-breadcrumb-mode)) - (if lsp-modeline-code-actions-enable - (add-hook 'lsp-configure-hook 'lsp-modeline-code-actions-mode) - (remove-hook 'lsp-configure-hook 'lsp-modeline-code-actions-mode)) - (if lsp-modeline-diagnostics-enable - (add-hook 'lsp-configure-hook 'lsp-modeline-diagnostics-mode) - (remove-hook 'lsp-configure-hook 'lsp-modeline-diagnostics-mode)) - (if lsp-modeline-workspace-status-enable - (add-hook 'lsp-configure-hook 'lsp-modeline-workspace-status-mode) - (remove-hook 'lsp-configure-hook 'lsp-modeline-workspace-status-mode)) - (if lsp-lens-enable - (add-hook 'lsp-configure-hook 'lsp-lens--enable) - (remove-hook 'lsp-configure-hook 'lsp-lens--enable)) - (if lsp-semantic-tokens-enable - (add-hook 'lsp-configure-hook 'lsp-semantic-tokens--enable) - (remove-hook 'lsp-configure-hook 'lsp-semantic-tokens--enable)) - - ;; yas-snippet config - (setq-local yas-inhibit-overlay-modification-protection t)) - -(defun lsp--restart-if-needed (workspace) - "Handler restart for WORKSPACE." - (when (or (eq lsp-restart 'auto-restart) - (eq (lsp--workspace-shutdown-action workspace) 'restart) - (and (eq lsp-restart 'interactive) - (let ((query (format - "Server %s exited (check corresponding stderr buffer for details). Do you want to restart it?" - (lsp--workspace-print workspace)))) - (y-or-n-p query)))) - (--each (lsp--workspace-buffers workspace) - (when (lsp-buffer-live-p it) - (lsp-with-current-buffer it - (if lsp--buffer-deferred - (lsp-deferred) - (lsp--info "Restarting LSP in buffer %s" (buffer-name)) - (lsp))))))) - -(defun lsp--update-key (table key fn) - "Apply FN on value corresponding to KEY in TABLE." - (let ((existing-value (gethash key table))) - (if-let ((new-value (funcall fn existing-value))) - (puthash key new-value table) - (remhash key table)))) - -(defun lsp--process-sentinel (workspace process exit-str) - "Create the sentinel for WORKSPACE." - (unless (process-live-p process) - (lsp--handle-process-exit workspace exit-str))) - -(defun lsp--handle-process-exit (workspace exit-str) - (let* ((folder->workspaces (lsp-session-folder->servers (lsp-session))) - (proc (lsp--workspace-proc workspace))) - (lsp--warn "%s has exited (%s)" - (lsp-process-name proc) - (string-trim-right (or exit-str ""))) - (with-lsp-workspace workspace - ;; Clean workspace related data in each of the buffers - ;; in the workspace. - (--each (lsp--workspace-buffers workspace) - (when (lsp-buffer-live-p it) - (lsp-with-current-buffer it - (setq lsp--buffer-workspaces (delete workspace lsp--buffer-workspaces)) - (lsp--uninitialize-workspace) - (lsp--spinner-stop) - (lsp--remove-overlays 'lsp-highlight)))) - - ;; Cleanup session from references to the closed workspace. - (--each (hash-table-keys folder->workspaces) - (lsp--update-key folder->workspaces it (apply-partially 'delete workspace))) - - (lsp-process-cleanup proc)) - - (run-hook-with-args 'lsp-after-uninitialized-functions workspace) - - (if (eq (lsp--workspace-shutdown-action workspace) 'shutdown) - (lsp--info "Workspace %s shutdown." (lsp--workspace-print workspace)) - (lsp--restart-if-needed workspace)) - (lsp--cleanup-hanging-watches))) - -(defun lsp-workspace-folders (workspace) - "Return all folders associated with WORKSPACE." - (let (result) - (->> (lsp-session) - (lsp-session-folder->servers) - (maphash (lambda (folder workspaces) - (when (-contains? workspaces workspace) - (push folder result))))) - result)) - -(defun lsp--start-workspace (session client-template root &optional initialization-options) - "Create new workspace for CLIENT-TEMPLATE with project root ROOT. -INITIALIZATION-OPTIONS are passed to initialize function. -SESSION is the active session." - (lsp--spinner-start) - (-let* ((default-directory root) - (client (copy-lsp--client client-template)) - (workspace (make-lsp--workspace - :root root - :client client - :status 'starting - :buffers (list (lsp-current-buffer)) - :host-root (file-remote-p root))) - ((&lsp-cln 'server-id 'environment-fn 'new-connection 'custom-capabilities - 'multi-root 'initialized-fn) client) - ((proc . cmd-proc) (funcall - (or (plist-get new-connection :connect) - (user-error "Client %s is configured incorrectly" client)) - (lsp--create-filter-function workspace) - (apply-partially #'lsp--process-sentinel workspace) - (format "%s" server-id) - environment-fn - workspace)) - (workspace-folders (gethash server-id (lsp-session-server-id->folders session)))) - (setf (lsp--workspace-proc workspace) proc - (lsp--workspace-cmd-proc workspace) cmd-proc) - - ;; update (lsp-session-folder->servers) depending on whether we are starting - ;; multi/single folder workspace - (mapc (lambda (project-root) - (->> session - (lsp-session-folder->servers) - (gethash project-root) - (cl-pushnew workspace))) - (or workspace-folders (list root))) - - (with-lsp-workspace workspace - (run-hooks 'lsp-before-initialize-hook) - (lsp-request-async - "initialize" - (append - (list :processId (unless (file-remote-p (buffer-file-name)) - (emacs-pid)) - :rootPath (lsp-file-local-name (expand-file-name root)) - :clientInfo (list :name "emacs" - :version (emacs-version)) - :rootUri (lsp--path-to-uri root) - :capabilities (lsp--client-capabilities custom-capabilities) - :initializationOptions initialization-options - :workDoneToken "1") - (when lsp-server-trace - (list :trace lsp-server-trace)) - (when multi-root - (->> workspace-folders - (-distinct) - (-map (lambda (folder) - (list :uri (lsp--path-to-uri folder) - :name (f-filename folder)))) - (apply 'vector) - (list :workspaceFolders)))) - (-lambda ((&InitializeResult :capabilities)) - ;; we know that Rust Analyzer will send {} which will be parsed as null - ;; when using plists - (when (equal 'rust-analyzer server-id) - (-> capabilities - (lsp:server-capabilities-text-document-sync?) - (lsp:set-text-document-sync-options-save? t))) - - (setf (lsp--workspace-server-capabilities workspace) capabilities - (lsp--workspace-status workspace) 'initialized) - - (with-lsp-workspace workspace - (lsp-notify "initialized" lsp--empty-ht)) - - (when initialized-fn (funcall initialized-fn workspace)) - - (cl-callf2 -filter #'lsp-buffer-live-p (lsp--workspace-buffers workspace)) - (->> workspace - (lsp--workspace-buffers) - (mapc (lambda (buffer) - (lsp-with-current-buffer buffer - (lsp--open-in-workspace workspace))))) - - (with-lsp-workspace workspace - (run-hooks 'lsp-after-initialize-hook)) - (lsp--info "%s initialized successfully in folders: %s" - (lsp--workspace-print workspace) - (lsp-workspace-folders workspace))) - :mode 'detached)) - workspace)) - -(defun lsp--load-default-session () - "Load default session." - (setq lsp--session (or (condition-case err - (lsp--read-from-file lsp-session-file) - (error (lsp--error "Failed to parse the session %s, starting with clean one." - (error-message-string err)) - nil)) - (make-lsp-session)))) - -(defun lsp-session () - "Get the session associated with the current buffer." - (or lsp--session (setq lsp--session (lsp--load-default-session)))) - -(defun lsp--client-disabled-p (buffer-major-mode client) - (seq-some - (lambda (entry) - (pcase entry - ((pred symbolp) (eq entry client)) - (`(,mode . ,client-or-list) - (and (eq mode buffer-major-mode) - (if (listp client-or-list) - (memq client client-or-list) - (eq client client-or-list)))))) - lsp-disabled-clients)) - - -;; download server - -(defcustom lsp-server-install-dir (expand-file-name - (locate-user-emacs-file (f-join ".cache" "lsp"))) - "Directory in which the servers will be installed." - :risky t - :type 'directory - :package-version '(lsp-mode . "6.3") - :group 'lsp-mode) - -(defcustom lsp-verify-signature t - "Whether to check GPG signatures of downloaded files." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-mode) - -(defvar lsp--dependencies (ht)) - -(defun lsp-dependency (name &rest definitions) - "Used to specify a language server DEPENDENCY, the server -executable or other required file path. Typically, the -DEPENDENCY is found by locating it on the system path using -`executable-find'. - -You can explicitly call lsp-dependency in your environment to -specify the absolute path to the DEPENDENCY. For example, the -typescript-language-server requires both the server and the -typescript compiler. If you have installed them in a team shared -read-only location, you can instruct lsp-mode to use them via - - (eval-after-load `lsp-mode - `(progn - (require lsp-javascript) - (lsp-dependency typescript-language-server (:system ,tls-exe)) - (lsp-dependency typescript (:system ,ts-js)))) - -where tls-exe is the absolute path to the typescript-language-server -executable and ts-js is the absolute path to the typescript compiler -JavaScript file, tsserver.js (the *.js is required for Windows)." - (ht-set lsp--dependencies name definitions)) - -(defun lsp--server-binary-present? (client) - (unless (equal (lsp--client-server-id client) 'lsp-pwsh) - (condition-case () - (-some-> client lsp--client-new-connection (plist-get :test?) funcall) - (error nil) - (args-out-of-range nil)))) - -(define-minor-mode lsp-installation-buffer-mode - "Mode used in *lsp-installation* buffers. -It can be used to set-up keybindings, etc. Disabling this mode -detaches the installation buffer from commands like -`lsp-select-installation-buffer'." - :init-value nil - :lighter nil) - -(defface lsp-installation-finished-buffer-face '((t :foreground "orange")) - "Face used for finished installation buffers. -Used in `lsp-select-installation-buffer'." - :group 'lsp-mode) - -(defface lsp-installation-buffer-face '((t :foreground "green")) - "Face used for installation buffers still in progress. -Used in `lsp-select-installation-buffer'." - :group 'lsp-mode) - -(defun lsp--installation-buffer? (buf) - "Check whether BUF is an `lsp-async-start-process' buffer." - (buffer-local-value 'lsp-installation-buffer-mode buf)) - -(defun lsp-select-installation-buffer (&optional show-finished) - "Interactively choose an installation buffer. -If SHOW-FINISHED is set, leftover (finished) installation buffers -are still shown." - (interactive "P") - (let ((bufs (--filter (and (lsp--installation-buffer? it) - (or show-finished (get-buffer-process it))) - (buffer-list)))) - (pcase bufs - (`nil (user-error "No installation buffers")) - (`(,buf) (pop-to-buffer buf)) - (bufs (pop-to-buffer (completing-read "Select installation buffer: " - (--map (propertize (buffer-name it) 'face - (if (get-buffer-process it) - 'lsp-installation-buffer-face - 'lsp-installation-finished-buffer-face)) - bufs))))))) - -(defun lsp-cleanup-installation-buffers () - "Delete finished *lsp-installation* buffers." - (interactive) - (dolist (buf (buffer-list)) - (when (and (lsp--installation-buffer? buf) (not (get-buffer-process buf))) - (kill-buffer buf)))) - -(defun lsp--download-status () - (-some--> #'lsp--client-download-in-progress? - (lsp--filter-clients it) - (-map (-compose #'symbol-name #'lsp--client-server-id) it) - (format "%s" it) - (propertize it 'face 'success) - (format " Installing following servers: %s" it) - (propertize it - 'local-map (make-mode-line-mouse-map - 'mouse-1 #'lsp-select-installation-buffer) - 'mouse-face 'highlight))) - -(defun lsp--install-server-internal (client &optional update?) - (unless (lsp--client-download-server-fn client) - (user-error "There is no automatic installation for `%s', you have to install it manually following lsp-mode's documentation." - (lsp--client-server-id client))) - - (setf (lsp--client-download-in-progress? client) t) - (add-to-list 'global-mode-string '(t (:eval (lsp--download-status)))) - (cl-flet ((done - (success? &optional error-message) - ;; run with idle timer to make sure the lsp command is executed in - ;; the main thread, see #2739. - (run-with-timer - 0.0 - nil - (lambda () - (-let [(&lsp-cln 'server-id 'buffers) client] - (setf (lsp--client-download-in-progress? client) nil - (lsp--client-buffers client) nil) - (if success? - (lsp--info "Server %s downloaded, auto-starting in %s buffers." server-id - (length buffers)) - (lsp--error "Server %s install process failed with the following error message: %s. -Check `*lsp-install*' and `*lsp-log*' buffer." - server-id - error-message)) - (seq-do - (lambda (buffer) - (when (lsp-buffer-live-p buffer) - (lsp-with-current-buffer buffer - (cl-callf2 -remove-item '(t (:eval (lsp--download-status))) - global-mode-string) - (when success? (lsp))))) - buffers) - (unless (lsp--filter-clients #'lsp--client-download-in-progress?) - (cl-callf2 -remove-item '(t (:eval (lsp--download-status))) - global-mode-string))))))) - (lsp--info "Download %s started." (lsp--client-server-id client)) - (condition-case err - (funcall - (lsp--client-download-server-fn client) - client - (lambda () (done t)) - (lambda (msg) (done nil msg)) - update?) - (error - (done nil (error-message-string err)))))) - -(defun lsp--require-packages () - "Load `lsp-client-packages' if needed." - (when (and lsp-auto-configure (not lsp--client-packages-required)) - (seq-do (lambda (package) - ;; loading client is slow and `lsp' can be called repeatedly - (unless (featurep package) - (require package nil t))) - lsp-client-packages) - (setq lsp--client-packages-required t))) - -;;;###autoload -(defun lsp-install-server (update? &optional server-id) - "Interactively install or re-install server. -When prefix UPDATE? is t force installation even if the server is present." - (interactive "P") - (lsp--require-packages) - (let* ((chosen-client (or (gethash server-id lsp-clients) - (lsp--completing-read - "Select server to install/re-install: " - (or (->> lsp-clients - (ht-values) - (-filter (-andfn - (-not #'lsp--client-download-in-progress?) - #'lsp--client-download-server-fn))) - (user-error "There are no servers with automatic installation")) - (lambda (client) - (let ((server-name (-> client lsp--client-server-id symbol-name))) - (if (lsp--server-binary-present? client) - (concat server-name " (Already installed)") - server-name))) - nil - t))) - (update? (or update? - (and (not (lsp--client-download-in-progress? chosen-client)) - (lsp--server-binary-present? chosen-client))))) - (lsp--install-server-internal chosen-client update?))) - -;;;###autoload -(defun lsp-uninstall-server (dir) - "Delete a LSP server from `lsp-server-install-dir'." - (interactive - (list (read-directory-name "Uninstall LSP server: " (f-slash lsp-server-install-dir)))) - (unless (file-directory-p dir) - (user-error "Couldn't find %s directory" dir)) - (delete-directory dir 'recursive) - (message "Server `%s' uninstalled." (file-name-nondirectory (directory-file-name dir)))) - -;;;###autoload -(defun lsp-uninstall-servers () - "Uninstall all installed servers." - (interactive) - (let* ((dir lsp-server-install-dir) - (servers (ignore-errors - (directory-files dir t - directory-files-no-dot-files-regexp)))) - (if (or (not (file-directory-p dir)) (zerop (length servers))) - (user-error "No servers to uninstall") - (when (yes-or-no-p - (format "Servers to uninstall: %d (%s), proceed? " - (length servers) - (mapconcat (lambda (server) - (file-name-nondirectory (directory-file-name server))) - servers " "))) - (mapc #'lsp-uninstall-server servers) - (message "All servers uninstalled"))))) - -;;;###autoload -(defun lsp-update-server (&optional server-id) - "Interactively update (reinstall) a server." - (interactive) - (lsp--require-packages) - (let ((chosen-client (or (gethash server-id lsp-clients) - (lsp--completing-read - "Select server to update (if not on the list, probably you need to `lsp-install-server`): " - (or (->> lsp-clients - (ht-values) - (-filter (-andfn - (-not #'lsp--client-download-in-progress?) - #'lsp--client-download-server-fn - #'lsp--server-binary-present?))) - (user-error "There are no servers to update")) - (lambda (client) - (-> client lsp--client-server-id symbol-name)) - nil - t)))) - (lsp--install-server-internal chosen-client t))) - -;;;###autoload -(defun lsp-update-servers () - "Update (reinstall) all installed servers." - (interactive) - (lsp--require-packages) - (mapc (lambda (client) (lsp--install-server-internal client t)) - (-filter (-andfn - (-not #'lsp--client-download-in-progress?) - #'lsp--client-download-server-fn - #'lsp--server-binary-present?) (hash-table-values lsp-clients)))) - -;;;###autoload -(defun lsp-ensure-server (server-id) - "Ensure server SERVER-ID" - (lsp--require-packages) - (if-let ((client (gethash server-id lsp-clients))) - (unless (lsp--server-binary-present? client) - (lsp--info "Server `%s' is not preset, installing..." server-id) - (lsp-install-server nil server-id)) - (warn "Unable to find server registration with id %s" server-id))) - -(defun lsp-async-start-process (callback error-callback &rest command) - "Start async process COMMAND with CALLBACK and ERROR-CALLBACK." - (let ((name (cl-first command))) - (with-current-buffer (compilation-start (mapconcat #'shell-quote-argument (-filter (lambda (cmd) - (not (null cmd))) - command) - " ") t - (lambda (&rest _) - (generate-new-buffer-name (format "*lsp-install: %s*" name)))) - (lsp-installation-buffer-mode +1) - (view-mode +1) - (add-hook - 'compilation-finish-functions - (lambda (_buf status) - (if (string= "finished\n" status) - (condition-case err - (funcall callback) - (error - (funcall error-callback (error-message-string err)))) - (funcall error-callback (s-trim-right status)))) - nil t)))) - -(defun lsp-resolve-value (value) - "Resolve VALUE's value. -If it is function - call it. -If it is a variable - return it's value -Otherwise returns value itself." - (cond - ((functionp value) (funcall value)) - ((and (symbolp value) (boundp value)) (symbol-value value)) - (value))) - -(defvar lsp-deps-providers - (list :npm (list :path #'lsp--npm-dependency-path - :install #'lsp--npm-dependency-install) - :cargo (list :path #'lsp--cargo-dependency-path - :install #'lsp--cargo-dependency-install) - :system (list :path #'lsp--system-path) - :download (list :path #'lsp-download-path - :install #'lsp-download-install))) - -(defun lsp--system-path (path) - "If PATH is absolute and exists return it as is. Otherwise, -return the absolute path to the executable defined by PATH or -nil." - ;; For node.js 'sub-packages' PATH may point to a *.js file. Consider the - ;; typescript-language-server. When lsp invokes the server, lsp needs to - ;; supply the path to the typescript compiler, tsserver.js, as an argument. To - ;; make code platform independent, one must pass the absolute path to the - ;; tsserver.js file (Windows requires a *.js file - see help on the JavaScript - ;; child process spawn command that is invoked by the - ;; typescript-language-server). This is why we check for existence and not - ;; that the path is executable. - (let ((path (lsp-resolve-value path))) - (cond - ((and (f-absolute? path) - (f-exists? path)) - path) - ((executable-find path t) path)))) - -(defun lsp-package-path (dependency) - "Path to the DEPENDENCY each of the registered providers." - (let (path) - (-first (-lambda ((provider . rest)) - (setq path (-some-> lsp-deps-providers - (plist-get provider) - (plist-get :path) - (apply rest)))) - (gethash dependency lsp--dependencies)) - path)) - -(defun lsp-package-ensure (dependency callback error-callback) - "Asynchronously ensure a package." - (or (-first (-lambda ((provider . rest)) - (-some-> lsp-deps-providers - (plist-get provider) - (plist-get :install) - (apply (cl-list* callback error-callback rest)))) - (gethash dependency lsp--dependencies)) - (funcall error-callback (format "Unable to find a way to install %s" dependency)))) - - -;; npm handling - -;; https://docs.npmjs.com/files/folders#executables -(cl-defun lsp--npm-dependency-path (&key package path &allow-other-keys) - "Return npm dependency PATH for PACKAGE." - (let ((path (executable-find - (f-join lsp-server-install-dir "npm" package - (cond ((eq system-type 'windows-nt) "") - (t "bin")) - path) - t))) - (unless (and path (f-exists? path)) - (error "The package %s is not installed. Unable to find %s" package path)) - path)) - -(cl-defun lsp--npm-dependency-install (callback error-callback &key package &allow-other-keys) - (if-let ((npm-binary (executable-find "npm"))) - (progn - ;; Explicitly `make-directory' to work around NPM bug in - ;; versions 7.0.0 through 7.4.1. See - ;; https://github.com/emacs-lsp/lsp-mode/issues/2364 for - ;; discussion. - (make-directory (f-join lsp-server-install-dir "npm" package "lib") 'parents) - (lsp-async-start-process (lambda () - (if (string-empty-p - (string-trim (shell-command-to-string - (mapconcat #'shell-quote-argument `(,npm-binary "view" ,package "peerDependencies") " ")))) - (funcall callback) - (let ((default-directory (f-dirname (car (last (directory-files-recursively (f-join lsp-server-install-dir "npm" package) "package.json"))))) - (process-environment (append '("npm_config_yes=true") process-environment))) ;; Disable prompting for older versions of npx - (when (f-dir-p default-directory) - (lsp-async-start-process callback - error-callback - (executable-find "npx") - "npm-install-peers"))))) - error-callback - npm-binary - "-g" - "--prefix" - (f-join lsp-server-install-dir "npm" package) - "install" - package)) - (lsp-log "Unable to install %s via `npm' because it is not present" package) - nil)) - - -;; Cargo dependency handling -(cl-defun lsp--cargo-dependency-path (&key package path &allow-other-keys) - (let ((path (executable-find - (f-join lsp-server-install-dir - "cargo" - package - "bin" - path) - t))) - (unless (and path (f-exists? path)) - (error "The package %s is not installed. Unable to find %s" package path)) - path)) - -(cl-defun lsp--cargo-dependency-install (callback error-callback &key package git &allow-other-keys) - (if-let ((cargo-binary (executable-find "cargo"))) - (lsp-async-start-process - callback - error-callback - cargo-binary - "install" - package - (when git - "--git") - git - "--root" - (f-join lsp-server-install-dir "cargo" package)) - (lsp-log "Unable to install %s via `cargo' because it is not present" package) - nil)) - - - -;; Download URL handling -(cl-defun lsp-download-install (callback error-callback &key url asc-url pgp-key store-path decompress &allow-other-keys) - (let* ((url (lsp-resolve-value url)) - (store-path (lsp-resolve-value store-path)) - ;; (decompress (lsp-resolve-value decompress)) - (download-path - (pcase decompress - (:gzip (concat store-path ".gz")) - (:zip (concat store-path ".zip")) - (:targz (concat store-path ".tar.gz")) - (`nil store-path) - (_ (error ":decompress must be `:gzip', `:zip', `:targz' or `nil'"))))) - (make-thread - (lambda () - (condition-case err - (progn - (when (f-exists? download-path) - (f-delete download-path)) - (when (f-exists? store-path) - (f-delete store-path)) - (lsp--info "Starting to download %s to %s..." url download-path) - (mkdir (f-parent download-path) t) - (url-copy-file url download-path) - (lsp--info "Finished downloading %s..." download-path) - (when (and lsp-verify-signature asc-url pgp-key) - (if (executable-find epg-gpg-program) - (let ((asc-download-path (concat download-path ".asc")) - (context (epg-make-context)) - (fingerprint) - (signature)) - (when (f-exists? asc-download-path) - (f-delete asc-download-path)) - (lsp--info "Starting to download %s to %s..." asc-url asc-download-path) - (url-copy-file asc-url asc-download-path) - (lsp--info "Finished downloading %s..." asc-download-path) - (epg-import-keys-from-string context pgp-key) - (setq fingerprint (epg-import-status-fingerprint - (car - (epg-import-result-imports - (epg-context-result-for context 'import))))) - (lsp--info "Verifying signature %s..." asc-download-path) - (epg-verify-file context asc-download-path download-path) - (setq signature (car (epg-context-result-for context 'verify))) - (unless (and - (eq (epg-signature-status signature) 'good) - (equal (epg-signature-fingerprint signature) fingerprint)) - (error "Failed to verify GPG signature: %s" (epg-signature-to-string signature)))) - (lsp--warn "GPG is not installed, skipping the signature check."))) - (when decompress - (lsp--info "Decompressing %s..." download-path) - (pcase decompress - (:gzip - (lsp-gunzip download-path)) - (:zip (lsp-unzip download-path (f-parent store-path))) - (:targz (lsp-tar-gz-decompress download-path (f-parent store-path)))) - (lsp--info "Decompressed %s..." store-path)) - (funcall callback)) - (error (funcall error-callback err))))))) - -(cl-defun lsp-download-path (&key store-path binary-path set-executable? &allow-other-keys) - "Download URL and store it into STORE-PATH. - -SET-EXECUTABLE? when non-nil change the executable flags of -STORE-PATH to make it executable. BINARY-PATH can be specified -when the binary to start does not match the name of the -archive (e.g. when the archive has multiple files)" - (let ((store-path (or (lsp-resolve-value binary-path) - (lsp-resolve-value store-path)))) - (cond - ((executable-find store-path) store-path) - ((and set-executable? (f-exists? store-path)) - (set-file-modes store-path #o0700) - store-path) - ((f-exists? store-path) store-path)))) - -(defun lsp--find-latest-gh-release-url (url regex) - "Fetch the latest version in the releases given by URL by using REGEX." - (let ((url-request-method "GET")) - (with-current-buffer (url-retrieve-synchronously url) - (goto-char (point-min)) - (re-search-forward "\n\n" nil 'noerror) - (delete-region (point-min) (point)) - (let* ((json-result (lsp-json-read-buffer))) - (message "Latest version found: %s" (lsp-get json-result :tag_name)) - (--> json-result - (lsp-get it :assets) - (seq-find (lambda (entry) (string-match-p regex (lsp-get entry :name))) it) - (lsp-get it :browser_download_url)))))) - -;; unzip - -(defconst lsp-ext-pwsh-script "pwsh -noprofile -noninteractive \ --nologo -ex bypass -c Expand-Archive -Path '%s' -DestinationPath '%s'" - "Pwsh script to unzip file.") - -(defconst lsp-ext-powershell-script "powershell -noprofile -noninteractive \ --nologo -ex bypass -command Expand-Archive -path '%s' -dest '%s'" - "Powershell script to unzip file.") - -(defconst lsp-ext-unzip-script "bash -c 'mkdir -p %2$s && unzip -qq -o %1$s -d %2$s'" - "Unzip script to unzip file.") - -(defcustom lsp-unzip-script (lambda () - (cond ((and (eq system-type 'windows-nt) - (executable-find "pwsh")) - lsp-ext-pwsh-script) - ((and (eq system-type 'windows-nt) - (executable-find "powershell")) - lsp-ext-powershell-script) - ((executable-find "unzip") lsp-ext-unzip-script) - ((executable-find "pwsh") lsp-ext-pwsh-script) - (t nil))) - "The script to unzip." - :group 'lsp-mode - :type 'string - :package-version '(lsp-mode . "8.0.0")) - -(defun lsp-unzip (zip-file dest) - "Unzip ZIP-FILE to DEST." - (unless lsp-unzip-script - (error "Unable to find `unzip' or `powershell' on the path, please customize `lsp-unzip-script'")) - (shell-command (format (lsp-resolve-value lsp-unzip-script) zip-file dest))) - -;; gunzip - -(defconst lsp-ext-gunzip-script "gzip -d %1$s" - "Script to decompress a gzippped file with gzip.") - -(defcustom lsp-gunzip-script (lambda () - (cond ((executable-find "gzip") lsp-ext-gunzip-script) - (t nil))) - "The script to decompress a gzipped file. -Should be a format string with one argument for the file to be decompressed -in place." - :group 'lsp-mode - :type 'string - :package-version '(lsp-mode . "8.0.0")) - -(defun lsp-gunzip (gz-file) - "Decompress GZ-FILE in place." - (unless lsp-gunzip-script - (error "Unable to find `gzip' on the path, please either customize `lsp-gunzip-script' or manually decompress %s" gz-file)) - (shell-command (format (lsp-resolve-value lsp-gunzip-script) gz-file))) - -;; tar.gz decompression - -(defconst lsp-ext-tar-script "bash -c 'mkdir -p %2$s; tar xf %1$s --directory=%2$s'" - "Script to decompress a .tar.gz file.") - -(defcustom lsp-tar-script (lambda () - (cond ((executable-find "tar") lsp-ext-tar-script) - (t nil))) - "The script to decompress a .tar.gz file. -Should be a format string with one argument for the file to be decompressed -in place." - :group 'lsp-mode - :type 'string) - -(defun lsp-tar-gz-decompress (targz-file dest) - "Decompress TARGZ-FILE in DEST." - (unless lsp-tar-script - (error "Unable to find `tar' on the path, please either customize `lsp-tar-script' or manually decompress %s" targz-file)) - (shell-command (format (lsp-resolve-value lsp-tar-script) targz-file dest))) - - -;; VSCode marketplace - -(defcustom lsp-vscode-ext-url - "https://marketplace.visualstudio.com/_apis/public/gallery/publishers/%s/vsextensions/%s/%s/vspackage%s" - "Vscode extension template url." - :group 'lsp-mode - :type 'string - :package-version '(lsp-mode . "8.0.0")) - -(defun lsp-vscode-extension-url (publisher name version &optional targetPlatform) - "Return the URL to vscode extension. -PUBLISHER is the extension publisher. -NAME is the name of the extension. -VERSION is the version of the extension. -TARGETPLATFORM is the targetPlatform of the extension." - (format lsp-vscode-ext-url publisher name version (or targetPlatform ""))) - - - -;; Queueing prompts - -(defvar lsp--question-queue nil - "List of questions yet to be asked by `lsp-ask-question'.") - -(defun lsp-ask-question (question options callback) - "Prompt the user to answer the QUESTION with one of the OPTIONS from the -minibuffer. Once the user selects an option, the CALLBACK function will be -called, passing the selected option to it. - -If the user is currently being shown a question, the question will be stored in -`lsp--question-queue', and will be asked once the user has answered the current -question." - (add-to-list 'lsp--question-queue `(("question" . ,question) - ("options" . ,options) - ("callback" . ,callback)) t) - (when (eq (length lsp--question-queue) 1) - (lsp--process-question-queue))) - -(defun lsp--process-question-queue () - "Take the first question from `lsp--question-queue', process it, then process -the next question until the queue is empty." - (-let* (((&alist "question" "options" "callback") (car lsp--question-queue)) - (answer (completing-read question options nil t))) - (pop lsp--question-queue) - (funcall callback answer) - (when lsp--question-queue - (lsp--process-question-queue)))) - -(defun lsp--supports-buffer? (client) - (and - ;; both file and client remote or both local - (eq (---truthy? (file-remote-p (buffer-file-name))) - (---truthy? (lsp--client-remote? client))) - - ;; activation function or major-mode match. - (if-let ((activation-fn (lsp--client-activation-fn client))) - (funcall activation-fn (buffer-file-name) major-mode) - (-contains? (lsp--client-major-modes client) major-mode)) - - ;; check whether it is enabled if `lsp-enabled-clients' is not null - (or (null lsp-enabled-clients) - (or (member (lsp--client-server-id client) lsp-enabled-clients) - (ignore (lsp--info "Client %s is not in lsp-enabled-clients" - (lsp--client-server-id client))))) - - ;; check whether it is not disabled. - (not (lsp--client-disabled-p major-mode (lsp--client-server-id client))))) - -(defun lsp--filter-clients (pred) - (->> lsp-clients hash-table-values (-filter pred))) - -(defun lsp--find-clients () - "Find clients which can handle current buffer." - (-when-let (matching-clients (lsp--filter-clients (-andfn #'lsp--supports-buffer? - #'lsp--server-binary-present?))) - (lsp-log "Found the following clients for %s: %s" - (buffer-file-name) - (s-join ", " - (-map (lambda (client) - (format "(server-id %s, priority %s)" - (lsp--client-server-id client) - (lsp--client-priority client))) - matching-clients))) - (-let* (((add-on-clients main-clients) (-separate #'lsp--client-add-on? matching-clients)) - (selected-clients (if-let ((main-client (and main-clients - (--max-by (> (lsp--client-priority it) - (lsp--client-priority other)) - main-clients)))) - (cons main-client add-on-clients) - add-on-clients))) - (lsp-log "The following clients were selected based on priority: %s" - (s-join ", " - (-map (lambda (client) - (format "(server-id %s, priority %s)" - (lsp--client-server-id client) - (lsp--client-priority client))) - selected-clients))) - selected-clients))) - -(defun lsp-workspace-remove-all-folders() - "Delete all lsp tracked folders." - (interactive) - (--each (lsp-session-folders (lsp-session)) - (lsp-workspace-folders-remove it))) - -(defun lsp-register-client (client) - "Registers LSP client CLIENT." - (let ((client-id (lsp--client-server-id client))) - (puthash client-id client lsp-clients) - (setplist (intern (format "lsp-%s-after-open-hook" client-id)) - `( standard-value (nil) custom-type hook - custom-package-version (lsp-mode . "7.0.1") - variable-documentation ,(format "Hooks to run after `%s' server is run." client-id) - custom-requests nil))) - (when (and lsp-auto-register-remote-clients - (not (lsp--client-remote? client))) - (let ((remote-client (copy-lsp--client client))) - (setf (lsp--client-remote? remote-client) t - (lsp--client-server-id remote-client) (intern - (format "%s-tramp" - (lsp--client-server-id client))) - ;; disable automatic download - (lsp--client-download-server-fn remote-client) nil) - (lsp-register-client remote-client)))) - -(defun lsp--create-initialization-options (_session client) - "Create initialization-options from SESSION and CLIENT. -Add workspace folders depending on server being multiroot and -session workspace folder configuration for the server." - (let* ((initialization-options-or-fn (lsp--client-initialization-options client))) - (if (functionp initialization-options-or-fn) - (funcall initialization-options-or-fn) - initialization-options-or-fn))) - -(defvar lsp-client-settings (make-hash-table :test 'equal) - "For internal use, any external users please use - `lsp-register-custom-settings' function instead") - -(defun lsp-register-custom-settings (props) - "Register PROPS. -PROPS is list of triple (path value boolean?) where PATH is the path to the -property; VALUE can be a literal value, symbol to be evaluated, or either a -function or lambda function to be called without arguments; BOOLEAN? is an -optional flag that should be non-nil for boolean settings, when it is nil the -property will be ignored if the VALUE is nil. - -Example: `(lsp-register-custom-settings `((\"foo.bar.buzz.enabled\" t t)))' -\(note the double parentheses)" - (mapc - (-lambda ((path . rest)) - (puthash path rest lsp-client-settings)) - props)) - -(defun lsp-region-text (region) - "Get the text for REGION in current buffer." - (-let (((start . end) (lsp--range-to-region region))) - (buffer-substring-no-properties start end))) - -(defun lsp-ht-set (tbl paths value) - "Set nested hash table value. -TBL - a hash table, PATHS is the path to the nested VALUE." - (pcase paths - (`(,path) (ht-set! tbl path value)) - (`(,path . ,rst) (let ((nested-tbl (or (gethash path tbl) - (let ((temp-tbl (ht))) - (ht-set! tbl path temp-tbl) - temp-tbl)))) - (lsp-ht-set nested-tbl rst value))))) - -;; sections - -(defalias 'defcustom-lsp 'lsp-defcustom) - -(defmacro lsp-defcustom (symbol standard doc &rest args) - "Defines `lsp-mode' server property." - (declare (doc-string 3) (debug (name body)) - (indent defun)) - (let ((path (plist-get args :lsp-path)) - (setter (intern (concat (symbol-name symbol) "--set")))) - (cl-remf args :lsp-path) - `(progn - (lsp-register-custom-settings - (quote ((,path ,symbol ,(equal ''boolean (plist-get args :type)))))) - - (defcustom ,symbol ,standard ,doc ,@args) - - ;; Use a variable watcher instead of registering a `defcustom' - ;; setter since `hack-local-variables' is not aware of custom - ;; setters and won't invoke them. - - (defun ,setter (sym val op _where) - (when (eq op 'set) - (lsp--set-custom-property sym val ,path))) - - (add-variable-watcher ',symbol #',setter)))) - -(defun lsp--set-custom-property (sym val path) - (set sym val) - (let ((section (cl-first (s-split "\\." path)))) - (mapc (lambda (workspace) - (when (-contains? (lsp--client-synchronize-sections (lsp--workspace-client workspace)) - section) - (with-lsp-workspace workspace - (lsp--set-configuration (lsp-configuration-section section))))) - (lsp--session-workspaces (lsp-session))))) - -(defun lsp-configuration-section (section) - "Get settings for SECTION." - (let ((ret (ht-create))) - (maphash (-lambda (path (variable boolean?)) - (when (s-matches? (concat (regexp-quote section) "\\..*") path) - (let* ((symbol-value (-> variable - lsp-resolve-value - lsp-resolve-value)) - (value (if (and boolean? (not symbol-value)) - :json-false - symbol-value))) - (when (or boolean? value) - (lsp-ht-set ret (s-split "\\." path) value))))) - lsp-client-settings) - ret)) - - -(defun lsp--start-connection (session client project-root) - "Initiates connection created from CLIENT for PROJECT-ROOT. -SESSION is the active session." - (when (lsp--client-multi-root client) - (cl-pushnew project-root (gethash (lsp--client-server-id client) - (lsp-session-server-id->folders session)))) - (run-hook-with-args 'lsp-workspace-folders-changed-functions (list project-root) nil) - - (unwind-protect - (lsp--start-workspace session client project-root (lsp--create-initialization-options session client)) - (lsp--spinner-stop))) - -;; lsp-log-io-mode - -(defvar lsp-log-io-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "M-n") #'lsp-log-io-next) - (define-key map (kbd "M-p") #'lsp-log-io-prev) - (define-key map (kbd "k") #'lsp--erase-log-buffer) - (define-key map (kbd "K") #'lsp--erase-session-log-buffers) - map) - "Keymap for lsp log buffer mode.") - -(define-derived-mode lsp-log-io-mode special-mode "LspLogIo" - "Special mode for viewing IO logs.") - -(defun lsp-workspace-show-log (workspace) - "Display the log buffer of WORKSPACE." - (interactive - (list (if lsp-log-io - (if (eq (length (lsp-workspaces)) 1) - (cl-first (lsp-workspaces)) - (lsp--completing-read "Workspace: " (lsp-workspaces) - #'lsp--workspace-print nil t)) - (user-error "IO logging is disabled")))) - (pop-to-buffer (lsp--get-log-buffer-create workspace))) - -(defalias 'lsp-switch-to-io-log-buffer 'lsp-workspace-show-log) - -(defun lsp--get-log-buffer-create (workspace) - "Return the lsp log buffer of WORKSPACE, creating a new one if needed." - (let* ((server-id (-> workspace lsp--workspace-client lsp--client-server-id symbol-name)) - (pid (-> workspace lsp--workspace-cmd-proc lsp-process-id))) - (get-buffer-create (format "*lsp-log: %s:%s*" server-id pid)))) - -(defun lsp--erase-log-buffer (&optional all) - "Delete contents of current lsp log buffer. -When ALL is t, erase all log buffers of the running session." - (interactive) - (let* ((workspaces (lsp--session-workspaces (lsp-session))) - (current-log-buffer (current-buffer))) - (dolist (w workspaces) - (let ((b (lsp--get-log-buffer-create w))) - (when (or all (eq b current-log-buffer)) - (with-current-buffer b - (let ((inhibit-read-only t)) - (erase-buffer)))))))) - -(defun lsp--erase-session-log-buffers () - "Erase log buffers of the running session." - (interactive) - (lsp--erase-log-buffer t)) - -(defun lsp-log-io-next (arg) - "Move to next log entry." - (interactive "P") - (ewoc-goto-next lsp--log-io-ewoc (or arg 1))) - -(defun lsp-log-io-prev (arg) - "Move to previous log entry." - (interactive "P") - (ewoc-goto-prev lsp--log-io-ewoc (or arg 1))) - - - -(cl-defmethod lsp-process-id ((process process)) - (process-id process)) - -(cl-defmethod lsp-process-name ((process process)) (process-name process)) - -(cl-defmethod lsp-process-status ((process process)) (process-status process)) - -(cl-defmethod lsp-process-kill ((process process)) - (when (process-live-p process) - (kill-process process))) - -(cl-defmethod lsp-process-send ((process process) message) - (condition-case err - (process-send-string process (lsp--make-message message)) - (error (lsp--error "Sending to process failed with the following error: %s" - (error-message-string err))))) - -(cl-defmethod lsp-process-cleanup (process) - ;; Kill standard error buffer only if the process exited normally. - ;; Leave it intact otherwise for debugging purposes. - (let ((buffer (-> process process-name get-buffer))) - (when (and (eq (process-status process) 'exit) - (zerop (process-exit-status process)) - (buffer-live-p buffer)) - (kill-buffer buffer)))) - - -;; native JSONRPC - -(declare-function json-rpc "ext:json") -(declare-function json-rpc-connection "ext:json") -(declare-function json-rpc-send "ext:json") -(declare-function json-rpc-shutdown "ext:json") -(declare-function json-rpc-stderr "ext:json") -(declare-function json-rpc-pid "ext:json") - -(defvar lsp-json-rpc-thread nil) -(defvar lsp-json-rpc-queue nil) -(defvar lsp-json-rpc-done nil) -(defvar lsp-json-rpc-mutex (make-mutex)) -(defvar lsp-json-rpc-condition (make-condition-variable lsp-json-rpc-mutex)) - -(defun lsp-json-rpc-process-queue () - (while (not lsp-json-rpc-done) - (while lsp-json-rpc-queue - (-let (((proc . message) (pop lsp-json-rpc-queue))) - (json-rpc-send - proc message - :null-object nil - :false-object :json-false))) - (with-mutex lsp-json-rpc-mutex - (condition-wait lsp-json-rpc-condition)))) - -(cl-defmethod lsp-process-id (process) (json-rpc-pid process)) - -(cl-defmethod lsp-process-name (_process) "TBD") - -(cl-defmethod lsp-process-kill (process) (json-rpc-shutdown process)) - -(cl-defmethod lsp-process-send (proc message) - (unless lsp-json-rpc-thread - (with-current-buffer (get-buffer-create " *json-rpc*") - (setq lsp-json-rpc-thread (make-thread #'lsp-json-rpc-process-queue "*json-rpc-queue*")))) - - (with-mutex lsp-json-rpc-mutex - (setq lsp-json-rpc-queue (append lsp-json-rpc-queue - (list (cons proc message)))) - (condition-notify lsp-json-rpc-condition))) - -(cl-defmethod lsp-process-cleanup (_proc)) - -(defun lsp-json-rpc-connection (workspace command) - (let ((con (apply #'json-rpc-connection command)) - (object-type (if lsp-use-plists 'plist 'hash-table))) - (with-current-buffer (get-buffer-create " *json-rpc*") - (make-thread - (lambda () - (json-rpc - con - (lambda (result err done) - (run-with-timer - 0.0 - nil - (lambda () - (cond - (result (lsp--parser-on-message result workspace)) - (err (warn "Json parsing failed with the following error: %s" err)) - (done (lsp--handle-process-exit workspace "")))))) - :object-type object-type - :null-object nil - :false-object nil)) - "*json-rpc-connection*")) - (cons con con))) - -(defun lsp-json-rpc-stderr () - (interactive) - (--when-let (pcase (lsp-workspaces) - (`nil (user-error "There are no active servers in the current buffer")) - (`(,workspace) workspace) - (workspaces (lsp--completing-read "Select server: " - workspaces - 'lsp--workspace-print nil t))) - (let ((content (json-rpc-stderr (lsp--workspace-cmd-proc it))) - (buffer (format "*stderr-%s*" (lsp--workspace-print it)) )) - (with-current-buffer (get-buffer-create buffer) - (with-help-window buffer - (insert content)))))) - - -(defun lsp--workspace-print (workspace) - "Visual representation WORKSPACE." - (let* ((proc (lsp--workspace-cmd-proc workspace)) - (status (lsp--workspace-status workspace)) - (server-id (-> workspace lsp--workspace-client lsp--client-server-id symbol-name)) - (pid (lsp-process-id proc))) - - (if (eq 'initialized status) - (format "%s:%s" server-id pid) - (format "%s:%s/%s" server-id pid status)))) - -(defun lsp--map-tree-widget (m) - "Build `tree-widget' from a hash-table or plist M." - (when (lsp-structure-p m) - (let (nodes) - (lsp-map (lambda (k v) - (push `(tree-widget - :tag ,(if (lsp-structure-p v) - (format "%s:" k) - (format "%s: %s" k - (propertize (format "%s" v) - 'face - 'font-lock-string-face))) - :open t - ,@(lsp--map-tree-widget v)) - nodes)) - m) - nodes))) - -(defun lsp-buffer-name (buffer-id) - (if-let ((buffer-name (plist-get buffer-id :buffer-name))) - (funcall buffer-name buffer-id) - (buffer-name buffer-id))) - -(defun lsp--render-workspace (workspace) - "Tree node representation of WORKSPACE." - `(tree-widget :tag ,(lsp--workspace-print workspace) - :open t - (tree-widget :tag ,(propertize "Buffers" 'face 'font-lock-function-name-face) - :open t - ,@(->> workspace - (lsp--workspace-buffers) - (--map `(tree-widget - :tag ,(when (lsp-buffer-live-p it) - (let ((buffer-name (lsp-buffer-name it))) - (if (lsp-with-current-buffer it buffer-read-only) - (propertize buffer-name 'face 'font-lock-constant-face) - buffer-name))))))) - (tree-widget :tag ,(propertize "Capabilities" 'face 'font-lock-function-name-face) - ,@(-> workspace lsp--workspace-server-capabilities lsp--map-tree-widget)))) - -(define-derived-mode lsp-browser-mode special-mode "LspBrowser" - "Define mode for displaying lsp sessions." - (setq-local display-buffer-base-action '(nil . ((inhibit-same-window . t))))) - -(defun lsp-describe-session () - "Describes current `lsp-session'." - (interactive) - (let ((session (lsp-session)) - (buf (get-buffer-create "*lsp session*")) - (root (lsp-workspace-root))) - (with-current-buffer buf - (lsp-browser-mode) - (let ((inhibit-read-only t)) - (erase-buffer) - (--each (lsp-session-folders session) - (widget-create - `(tree-widget - :tag ,(propertize it 'face 'font-lock-keyword-face) - :open t - ,@(->> session - (lsp-session-folder->servers) - (gethash it) - (-map 'lsp--render-workspace))))))) - (pop-to-buffer buf) - (goto-char (point-min)) - (cl-loop for tag = (widget-get (widget-get (widget-at) :node) :tag) - until (or (and root (string= tag root)) (eobp)) - do (goto-char (next-overlay-change (point)))))) - -(defun lsp--session-workspaces (session) - "Get all workspaces that are part of the SESSION." - (-> session lsp-session-folder->servers hash-table-values -flatten -uniq)) - -(defun lsp--find-multiroot-workspace (session client project-root) - "Look for a multiroot connection in SESSION created from CLIENT for -PROJECT-ROOT and BUFFER-MAJOR-MODE." - (when (lsp--client-multi-root client) - (-when-let (multi-root-workspace (->> session - (lsp--session-workspaces) - (--first (eq (-> it lsp--workspace-client lsp--client-server-id) - (lsp--client-server-id client))))) - (with-lsp-workspace multi-root-workspace - (lsp-notify "workspace/didChangeWorkspaceFolders" - (lsp-make-did-change-workspace-folders-params - :event (lsp-make-workspace-folders-change-event - :added (vector (lsp-make-workspace-folder - :uri (lsp--path-to-uri project-root) - :name (f-filename project-root))) - :removed [])))) - - (->> session (lsp-session-folder->servers) (gethash project-root) (cl-pushnew multi-root-workspace)) - (->> session (lsp-session-server-id->folders) (gethash (lsp--client-server-id client)) (cl-pushnew project-root)) - - (lsp--persist-session session) - - (lsp--info "Opened folder %s in workspace %s" project-root (lsp--workspace-print multi-root-workspace)) - (lsp--open-in-workspace multi-root-workspace) - - multi-root-workspace))) - -(defun lsp--ensure-lsp-servers (session clients project-root ignore-multi-folder) - "Ensure that SESSION contain server CLIENTS created for PROJECT-ROOT. -IGNORE-MULTI-FOLDER to ignore multi folder server." - (-map (lambda (client) - (or - (lsp--find-workspace session client project-root) - (unless ignore-multi-folder - (lsp--find-multiroot-workspace session client project-root)) - (lsp--start-connection session client project-root))) - clients)) - -(defun lsp--spinner-stop () - "Stop the spinner in case all of the workspaces are started." - (when (--all? (eq (lsp--workspace-status it) 'initialized) - lsp--buffer-workspaces) - (spinner-stop))) - -(defun lsp--open-in-workspace (workspace) - "Open in existing WORKSPACE." - (if (eq 'initialized (lsp--workspace-status workspace)) - ;; when workspace is initialized just call document did open. - (progn - (with-lsp-workspace workspace - (when-let ((before-document-open-fn (-> workspace - lsp--workspace-client - lsp--client-before-file-open-fn))) - (funcall before-document-open-fn workspace)) - (lsp--text-document-did-open)) - (lsp--spinner-stop)) - ;; when it is not initialized - (lsp--spinner-start) - (cl-pushnew (lsp-current-buffer) (lsp--workspace-buffers workspace)))) - -(defun lsp--find-workspace (session client project-root) - "Find server connection created with CLIENT in SESSION for PROJECT-ROOT." - (when-let ((workspace (->> session - (lsp-session-folder->servers) - (gethash project-root) - (--first (eql (-> it lsp--workspace-client lsp--client-server-id) - (lsp--client-server-id client)))))) - (lsp--open-in-workspace workspace) - workspace)) - -(defun lsp--read-char (prompt &optional options) - "Wrapper for `read-char-from-minibuffer' if Emacs +27. -Fallback to `read-key' otherwise. -PROMPT is the message and OPTIONS the available options." - (if (fboundp 'read-char-from-minibuffer) - (read-char-from-minibuffer prompt options) - (read-key prompt))) - -(defun lsp--find-root-interactively (session) - "Find project interactively. -Returns nil if the project should not be added to the current SESSION." - (condition-case nil - (let* ((project-root-suggestion (or (lsp--suggest-project-root) default-directory)) - (action (lsp--read-char - (format - "%s is not part of any project. - -%s ==> Import project root %s -%s ==> Import project by selecting root directory interactively -%s ==> Import project at current directory %s -%s ==> Do not ask again for the current project by adding %s to lsp-session-folders-blocklist -%s ==> Do not ask again for the current project by selecting ignore path interactively -%s ==> Do nothing: ask again when opening other files from the current project - -Select action: " - (propertize (buffer-name) 'face 'bold) - (propertize "i" 'face 'success) - (propertize project-root-suggestion 'face 'bold) - (propertize "I" 'face 'success) - (propertize "." 'face 'success) - (propertize default-directory 'face 'bold) - (propertize "d" 'face 'warning) - (propertize project-root-suggestion 'face 'bold) - (propertize "D" 'face 'warning) - (propertize "n" 'face 'warning)) - '(?i ?\r ?I ?. ?d ?D ?n)))) - (cl-case action - (?i project-root-suggestion) - (?\r project-root-suggestion) - (?I (read-directory-name "Select workspace folder to add: " - (or project-root-suggestion default-directory) - nil - t)) - (?. default-directory) - (?d (push project-root-suggestion (lsp-session-folders-blocklist session)) - (lsp--persist-session session) - nil) - (?D (push (read-directory-name "Select folder to blocklist: " - (or project-root-suggestion default-directory) - nil - t) - (lsp-session-folders-blocklist session)) - (lsp--persist-session session) - nil) - (t nil))) - (quit))) - -(declare-function tramp-file-name-host "ext:tramp" (file) t) -(declare-function tramp-dissect-file-name "ext:tramp" (file &optional nodefault)) - -(defun lsp--files-same-host (f1 f2) - "Predicate on whether or not two files are on the same host." - (or (not (or (file-remote-p f1) (file-remote-p f2))) - (and (file-remote-p f1) - (file-remote-p f2) - (progn (require 'tramp) - (equal (tramp-file-name-host (tramp-dissect-file-name f1)) - (tramp-file-name-host (tramp-dissect-file-name f2))))))) - -(defun lsp-find-session-folder (session file-name) - "Look in the current SESSION for folder containing FILE-NAME." - (let ((file-name-canonical (lsp-f-canonical file-name))) - (->> session - (lsp-session-folders) - (--filter (and (lsp--files-same-host it file-name-canonical) - (or (lsp-f-same? it file-name-canonical) - (and (f-dir? it) - (lsp-f-ancestor-of? it file-name-canonical))))) - (--max-by (> (length it) - (length other)))))) - -(defun lsp-find-workspace (server-id &optional file-name) - "Find workspace for SERVER-ID for FILE-NAME." - (-when-let* ((session (lsp-session)) - (folder->servers (lsp-session-folder->servers session)) - (workspaces (if file-name - (gethash (lsp-find-session-folder session file-name) folder->servers) - (lsp--session-workspaces session)))) - - (--first (eq (lsp--client-server-id (lsp--workspace-client it)) server-id) workspaces))) - -(defun lsp--calculate-root (session file-name) - "Calculate project root for FILE-NAME in SESSION." - (and - (->> session - (lsp-session-folders-blocklist) - (--first (and (lsp--files-same-host it file-name) - (lsp-f-ancestor-of? it file-name) - (prog1 t - (lsp--info "File %s is in blocklisted directory %s" file-name it)))) - not) - (or - (when lsp-auto-guess-root - (lsp--suggest-project-root)) - (unless lsp-guess-root-without-session - (lsp-find-session-folder session file-name)) - (unless lsp-auto-guess-root - (when-let ((root-folder (lsp--find-root-interactively session))) - (if (or (not (f-equal? root-folder (expand-file-name "~/"))) - (yes-or-no-p - (concat - (propertize "[WARNING] " 'face 'warning) - "You are trying to import your home folder as project root. This may cause performance issue because some language servers (python, lua, etc) will try to scan all files under project root. To avoid that you may: - -1. Use `I' option from the interactive project import to select subfolder(e. g. `~/foo/bar' instead of `~/'). -2. If your file is under `~/' then create a subfolder and move that file in this folder. - -Type `No' to go back to project selection. -Type `Yes' to confirm `HOME' as project root. -Type `C-g' to cancel project import process and stop `lsp'"))) - root-folder - (lsp--calculate-root session file-name))))))) - -(defun lsp--try-open-in-library-workspace () - "Try opening current file as library file in any of the active workspace. -The library folders are defined by each client for each of the active workspace." - (when-let ((workspace (->> (lsp-session) - (lsp--session-workspaces) - ;; Sort the last active workspaces first as they are more likely to be - ;; the correct ones, especially when jumping to a definition. - (-sort (lambda (a _b) - (-contains? lsp--last-active-workspaces a))) - (--first - (and (-> it lsp--workspace-client lsp--supports-buffer?) - (when-let ((library-folders-fn - (-> it lsp--workspace-client lsp--client-library-folders-fn))) - (-first (lambda (library-folder) - (lsp-f-ancestor-of? library-folder (buffer-file-name))) - (funcall library-folders-fn it)))))))) - (lsp--open-in-workspace workspace) - (view-mode t) - (lsp--info "Opening read-only library file %s." (buffer-file-name)) - (list workspace))) - -(defun lsp--persist-session (session) - "Persist SESSION to `lsp-session-file'." - (lsp--persist lsp-session-file (make-lsp-session - :folders (lsp-session-folders session) - :folders-blocklist (lsp-session-folders-blocklist session) - :server-id->folders (lsp-session-server-id->folders session)))) - -(defun lsp--try-project-root-workspaces (ask-for-client ignore-multi-folder) - "Try create opening file as a project file. -When IGNORE-MULTI-FOLDER is t the lsp mode will start new -language server even if there is language server which can handle -current language. When IGNORE-MULTI-FOLDER is nil current file -will be opened in multi folder language server if there is -such." - (-let ((session (lsp-session))) - (-if-let (clients (if ask-for-client - (list (lsp--completing-read "Select server to start: " - (ht-values lsp-clients) - (-compose 'symbol-name 'lsp--client-server-id) nil t)) - (lsp--find-clients))) - (-if-let (project-root (-some-> session - (lsp--calculate-root (buffer-file-name)) - (lsp-f-canonical))) - (progn - ;; update project roots if needed and persist the lsp session - (unless (-contains? (lsp-session-folders session) project-root) - (cl-pushnew project-root (lsp-session-folders session)) - (lsp--persist-session session)) - (lsp--ensure-lsp-servers session clients project-root ignore-multi-folder)) - (lsp--warn "%s not in project or it is blocklisted." (buffer-name)) - nil) - (lsp--warn "No LSP server for %s(check *lsp-log*)." major-mode) - nil))) - -(defun lsp-shutdown-workspace () - "Shutdown language server." - (interactive) - (--when-let (pcase (lsp-workspaces) - (`nil (user-error "There are no active servers in the current buffer")) - (`(,workspace) (when (y-or-n-p (format "Are you sure you want to stop the server %s?" - (lsp--workspace-print workspace))) - workspace)) - (workspaces (lsp--completing-read "Select server: " - workspaces - 'lsp--workspace-print nil t))) - (lsp-workspace-shutdown it))) - -(make-obsolete 'lsp-shutdown-workspace 'lsp-workspace-shutdown "lsp-mode 6.1") - -(defcustom lsp-auto-select-workspace t - "Shutdown or restart a single workspace. -If set and the current buffer has only a single workspace -associated with it, `lsp-shutdown-workspace' and -`lsp-restart-workspace' will act on it without asking." - :type 'boolean - :group 'lsp-mode) - -(defun lsp--read-workspace () - "Ask the user to select a workspace. -Errors if there are none." - (pcase (lsp-workspaces) - (`nil (error "No workspaces associated with the current buffer")) - ((and `(,workspace) (guard lsp-auto-select-workspace)) workspace) - (workspaces (lsp--completing-read "Select workspace: " workspaces - #'lsp--workspace-print nil t)))) - -(defun lsp-workspace-shutdown (workspace) - "Shut the workspace WORKSPACE and the language server associated with it" - (interactive (list (lsp--read-workspace))) - (lsp--warn "Stopping %s" (lsp--workspace-print workspace)) - (with-lsp-workspace workspace (lsp--shutdown-workspace))) - -(defun lsp-disconnect () - "Disconnect the buffer from the language server." - (interactive) - (lsp--text-document-did-close t) - (lsp-managed-mode -1) - (lsp-mode -1) - (setq lsp--buffer-workspaces nil) - (lsp--info "Disconnected")) - -(defun lsp-restart-workspace () - (interactive) - (--when-let (pcase (lsp-workspaces) - (`nil (user-error "There are no active servers in the current buffer")) - (`(,workspace) workspace) - (workspaces (lsp--completing-read "Select server: " - workspaces - 'lsp--workspace-print nil t))) - (lsp-workspace-restart it))) - -(make-obsolete 'lsp-restart-workspace 'lsp-workspace-restart "lsp-mode 6.1") - -(defun lsp-workspace-restart (workspace) - "Restart the workspace WORKSPACE and the language server associated with it" - (interactive (list (lsp--read-workspace))) - (lsp--warn "Restarting %s" (lsp--workspace-print workspace)) - (with-lsp-workspace workspace (lsp--shutdown-workspace t))) - -;;;###autoload -(defun lsp (&optional arg) - "Entry point for the server startup. -When ARG is t the lsp mode will start new language server even if -there is language server which can handle current language. When -ARG is nil current file will be opened in multi folder language -server if there is such. When `lsp' is called with prefix -argument ask the user to select which language server to start." - (interactive "P") - - (lsp--require-packages) - - (when (buffer-file-name) - (let (clients - (matching-clients (lsp--filter-clients - (-andfn #'lsp--supports-buffer? - #'lsp--server-binary-present?)))) - (cond - (matching-clients - (when (setq lsp--buffer-workspaces - (or (and - ;; Don't open as library file if file is part of a project. - (not (lsp-find-session-folder (lsp-session) (buffer-file-name))) - (lsp--try-open-in-library-workspace)) - (lsp--try-project-root-workspaces (equal arg '(4)) - (and arg (not (equal arg 1)))))) - (lsp-mode 1) - (when lsp-auto-configure (lsp--auto-configure)) - (setq lsp-buffer-uri (lsp--buffer-uri)) - (lsp--info "Connected to %s." - (apply 'concat (--map (format "[%s %s]" - (lsp--workspace-print it) - (lsp--workspace-root it)) - lsp--buffer-workspaces))))) - ;; look for servers which are currently being downloaded. - ((setq clients (lsp--filter-clients (-andfn #'lsp--supports-buffer? - #'lsp--client-download-in-progress?))) - (lsp--info "There are language server(%s) installation in progress. -The server(s) will be started in the buffer when it has finished." - (-map #'lsp--client-server-id clients)) - (seq-do (lambda (client) - (cl-pushnew (current-buffer) (lsp--client-buffers client))) - clients)) - ;; look for servers to install - ((setq clients (lsp--filter-clients - (-andfn #'lsp--supports-buffer? - (-const lsp-enable-suggest-server-download) - #'lsp--client-download-server-fn - (-not #'lsp--client-download-in-progress?)))) - (let ((client (lsp--completing-read - (concat "Unable to find installed server supporting this file. " - "The following servers could be installed automatically: ") - clients - (-compose #'symbol-name #'lsp--client-server-id) - nil - t))) - (cl-pushnew (current-buffer) (lsp--client-buffers client)) - (lsp--install-server-internal client))) - ;; ignore other warnings - ((not lsp-warn-no-matched-clients) - nil) - ;; automatic installation disabled - ((setq clients (unless matching-clients - (lsp--filter-clients (-andfn #'lsp--supports-buffer? - #'lsp--client-download-server-fn - (-not (-const lsp-enable-suggest-server-download)) - (-not #'lsp--server-binary-present?))))) - (lsp--warn "The following servers support current file but automatic download is disabled: %s -\(If you have already installed the server check *lsp-log*)." - (mapconcat (lambda (client) - (symbol-name (lsp--client-server-id client))) - clients - " "))) - ;; no clients present - ((setq clients (unless matching-clients - (lsp--filter-clients (-andfn #'lsp--supports-buffer? - (-not #'lsp--server-binary-present?))))) - (lsp--warn "The following servers support current file but do not have automatic installation: %s -You may find the installation instructions at https://emacs-lsp.github.io/lsp-mode/page/languages. -\(If you have already installed the server check *lsp-log*)." - (mapconcat (lambda (client) - (symbol-name (lsp--client-server-id client))) - clients - " "))) - ;; no matches - ((-> #'lsp--supports-buffer? lsp--filter-clients not) - (lsp--error "There are no language servers supporting current mode `%s' registered with `lsp-mode'. -This issue might be caused by: -1. The language you are trying to use does not have built-in support in `lsp-mode'. You must install the required support manually. Examples of this are `lsp-java' or `lsp-metals'. -2. The language server that you expect to run is not configured to run for major mode `%s'. You may check that by checking the `:major-modes' that are passed to `lsp-register-client'. -3. `lsp-mode' doesn't have any integration for the language behind `%s'. Refer to https://emacs-lsp.github.io/lsp-mode/page/languages and https://langserver.org/ . -4. You are over `tramp'. In this case follow https://emacs-lsp.github.io/lsp-mode/page/remote/. -5. You have disabled the `lsp-mode' clients for that file. (Check `lsp-enabled-clients' and `lsp-disabled-clients'). -You can customize `lsp-warn-no-matched-clients' to disable this message." - major-mode major-mode major-mode)))))) - -(defun lsp--buffer-visible-p () - "Return non nil if current buffer is visible." - (or (buffer-modified-p) (get-buffer-window nil t))) - -(defun lsp--init-if-visible () - "Run `lsp' for the current buffer if the buffer is visible. -Returns non nil if `lsp' was run for the buffer." - (when (lsp--buffer-visible-p) - (remove-hook 'window-configuration-change-hook #'lsp--init-if-visible t) - (lsp) - t)) - -;;;###autoload -(defun lsp-deferred () - "Entry point that defers server startup until buffer is visible. -`lsp-deferred' will wait until the buffer is visible before invoking `lsp'. -This avoids overloading the server with many files when starting Emacs." - ;; Workspace may not be initialized yet. Use a buffer local variable to - ;; remember that we deferred loading of this buffer. - (setq lsp--buffer-deferred t) - (let ((buffer (current-buffer))) - ;; Avoid false positives as desktop-mode restores buffers by deferring - ;; visibility check until the stack clears. - (run-with-idle-timer 0 nil (lambda () - (when (buffer-live-p buffer) - (with-current-buffer buffer - (unless (lsp--init-if-visible) - (add-hook 'window-configuration-change-hook #'lsp--init-if-visible nil t)))))))) - - - -(defvar lsp-file-truename-cache (ht)) - -(defmacro lsp-with-cached-filetrue-name (&rest body) - "Executes BODY caching the `file-truename' calls." - `(let ((old-fn (symbol-function 'file-truename))) - (unwind-protect - (progn - (fset 'file-truename - (lambda (file-name &optional counter prev-dirs) - (or (gethash file-name lsp-file-truename-cache) - (puthash file-name (apply old-fn (list file-name counter prev-dirs)) - lsp-file-truename-cache)))) - ,@body) - (fset 'file-truename old-fn)))) - - -(defun lsp-virtual-buffer-call (key &rest args) - (when lsp--virtual-buffer - (when-let ((fn (plist-get lsp--virtual-buffer key))) - (apply fn args)))) - -(defun lsp-translate-column (column) - "Translate COLUMN taking into account virtual buffers." - (or (lsp-virtual-buffer-call :real->virtual-char column) - column)) - -(defun lsp-translate-line (line) - "Translate LINE taking into account virtual buffers." - (or (lsp-virtual-buffer-call :real->virtual-line line) - line)) - - -;; lsp internal validation. - -(defmacro lsp--doctor (&rest checks) - `(-let [buf (current-buffer)] - (with-current-buffer (get-buffer-create "*lsp-performance*") - (with-help-window (current-buffer) - ,@(-map (-lambda ((msg form)) - `(insert (format "%s: %s\n" ,msg - (let ((res (with-current-buffer buf - ,form))) - (cond - ((eq res :optional) (propertize "OPTIONAL" 'face 'warning)) - (res (propertize "OK" 'face 'success)) - (t (propertize "ERROR" 'face 'error))))))) - (-partition 2 checks)))))) - -(define-obsolete-function-alias 'lsp-diagnose - 'lsp-doctor "lsp-mode 8.0.0") - -(defun lsp-doctor () - "Validate performance settings." - (interactive) - (lsp--doctor - "Checking for Native JSON support" (functionp 'json-serialize) - "Check emacs supports `read-process-output-max'" (boundp 'read-process-output-max) - "Check `read-process-output-max' default has been changed from 4k" - (and (boundp 'read-process-output-max) - (> read-process-output-max 4096)) - "Byte compiled against Native JSON (recompile lsp-mode if failing when Native JSON available)" - (condition-case _err - (progn (lsp--make-message (list "a" "b")) - nil) - (error t)) - "`gc-cons-threshold' increased?" (> gc-cons-threshold 800000) - "Using `plist' for deserialized objects? (refer to https://emacs-lsp.github.io/lsp-mode/page/performance/#use-plists-for-deserialization)" (or lsp-use-plists :optional) - "Using emacs 28+ with native compilation?" - (or (and (fboundp 'native-comp-available-p) - (native-comp-available-p)) - :optional))) - -(declare-function package-version-join "ext:package") -(declare-function package-desc-version "ext:package") -(declare-function package--alist "ext:package") - -(defun lsp-version () - "Return string describing current version of `lsp-mode'." - (interactive) - (unless (featurep 'package) - (require 'package)) - (let ((ver (format "lsp-mode %s, Emacs %s, %s" - (package-version-join - (package-desc-version - (car (alist-get 'lsp-mode (package--alist))))) - emacs-version - system-type))) - (if (called-interactively-p 'interactive) - (lsp--info "%s" ver) - ver))) - - - -;; org-mode/virtual-buffer - -(declare-function org-babel-get-src-block-info "ext:ob-core") -(declare-function org-do-remove-indentation "ext:org-macs") -(declare-function org-src-get-lang-mode "ext:org-src") -(declare-function org-element-context "ext:org-element") - -(defun lsp--virtual-buffer-update-position () - (-if-let (virtual-buffer (-first (-lambda ((&plist :in-range)) - (funcall in-range)) - lsp--virtual-buffer-connections)) - (unless (equal virtual-buffer lsp--virtual-buffer) - (lsp-org)) - (when lsp-managed-mode - (lsp-managed-mode -1) - (lsp-mode -1) - (setq lsp--buffer-workspaces nil) - (setq lsp--virtual-buffer nil) - (setq lsp-buffer-uri nil) - - ;; force refresh of diagnostics - (run-hooks 'lsp-after-diagnostics-hook)))) - -(defun lsp-virtual-buffer-on-change (start end length) - "Adjust on change event to be executed against the proper language server." - (let ((max-point (max end - (or (plist-get lsp--before-change-vals :end) 0) - (+ start length)))) - (when-let ((virtual-buffer (-first (lambda (vb) - (let ((lsp--virtual-buffer vb)) - (and (lsp-virtual-buffer-call :in-range start) - (lsp-virtual-buffer-call :in-range max-point)))) - lsp--virtual-buffer-connections))) - (lsp-with-current-buffer virtual-buffer - (lsp-on-change start end length - (lambda (&rest _) - (list :range (lsp--range (list :character 0 :line 0) - lsp--virtual-buffer-point-max) - :text (lsp--buffer-content)))))))) - -(defun lsp-virtual-buffer-before-change (start _end) - (when-let ((virtual-buffer (-first (lambda (vb) - (lsp-with-current-buffer vb - (lsp-virtual-buffer-call :in-range start))) - lsp--virtual-buffer-connections))) - (lsp-with-current-buffer virtual-buffer - (setq lsp--virtual-buffer-point-max - (lsp--point-to-position (lsp-virtual-buffer-call :last-point)))))) - -(defun lsp-patch-on-change-event () - (remove-hook 'after-change-functions #'lsp-on-change t) - (add-hook 'after-change-functions #'lsp-virtual-buffer-on-change nil t) - (add-hook 'before-change-functions #'lsp-virtual-buffer-before-change nil t)) - -(defun lsp-kill-virtual-buffers () - (mapc #'lsp-virtual-buffer-disconnect lsp--virtual-buffer-connections)) - -(defun lsp--move-point-in-indentation (point indentation) - (save-excursion - (goto-char point) - (if (<= point (+ (line-beginning-position) indentation)) - (line-beginning-position) - point))) - -(declare-function flycheck-checker-supports-major-mode-p "ext:flycheck") -(declare-function flycheck-add-mode "ext:flycheck") -(declare-function lsp-diagnostics-lsp-checker-if-needed "lsp-diagnostics") - -(defalias 'lsp-client-download-server-fn 'lsp--client-download-server-fn) - -(defun lsp-flycheck-add-mode (mode) - "Register flycheck support for MODE." - (lsp-diagnostics-lsp-checker-if-needed) - (unless (flycheck-checker-supports-major-mode-p 'lsp mode) - (flycheck-add-mode 'lsp mode))) - -(defun lsp-progress-spinner-type () - "Retrieve the spinner type value, if value is not a symbol of `spinner-types -defaults to `progress-bar." - (or (car (assoc lsp-progress-spinner-type spinner-types)) 'progress-bar)) - -(defun lsp-org () - (interactive) - (-if-let ((virtual-buffer &as &plist :workspaces) (-first (-lambda ((&plist :in-range)) - (funcall in-range)) - lsp--virtual-buffer-connections)) - (unless (equal lsp--virtual-buffer virtual-buffer) - (setq lsp--buffer-workspaces workspaces) - (setq lsp--virtual-buffer virtual-buffer) - (setq lsp-buffer-uri nil) - (lsp-mode 1) - (lsp-managed-mode 1) - (lsp-patch-on-change-event)) - - (save-excursion - (-let* (virtual-buffer - (wcb (lambda (f) - (with-current-buffer (plist-get virtual-buffer :buffer) - (-let* (((&plist :major-mode :buffer-file-name - :goto-buffer :workspaces) virtual-buffer) - (lsp--virtual-buffer virtual-buffer) - (lsp--buffer-workspaces workspaces)) - (save-excursion - (funcall goto-buffer) - (funcall f)))))) - ((&plist :begin :end :post-blank :language) (cl-second (org-element-context))) - ((&alist :tangle file-name) (cl-third (org-babel-get-src-block-info 'light))) - - (file-name (if file-name - (f-expand file-name) - (user-error "You should specify file name in the src block header."))) - (begin-marker (progn - (goto-char begin) - (forward-line) - (set-marker (make-marker) (point)))) - (end-marker (progn - (goto-char end) - (forward-line (1- (- post-blank))) - (set-marker (make-marker) (1+ (point))))) - (buf (current-buffer)) - (src-block (buffer-substring-no-properties begin-marker - (1- end-marker))) - (indentation (with-temp-buffer - (insert src-block) - - (goto-char (point-min)) - (let ((indentation (current-indentation))) - (plist-put lsp--virtual-buffer :indentation indentation) - (org-do-remove-indentation) - (goto-char (point-min)) - (- indentation (current-indentation)))))) - (add-hook 'post-command-hook #'lsp--virtual-buffer-update-position nil t) - - (when (fboundp 'flycheck-add-mode) - (lsp-flycheck-add-mode 'org-mode)) - - (setq lsp--virtual-buffer - (list - :in-range (lambda (&optional point) - (<= begin-marker (or point (point)) (1- end-marker))) - :goto-buffer (lambda () (goto-char begin-marker)) - :buffer-string - (lambda () - (let ((src-block (buffer-substring-no-properties - begin-marker - (1- end-marker)))) - (with-temp-buffer - (insert src-block) - - (goto-char (point-min)) - (while (not (eobp)) - (delete-region (point) (if (> (+ (point) indentation) (line-end-position)) - (line-end-position) - (+ (point) indentation))) - (forward-line)) - (buffer-substring-no-properties (point-min) - (point-max))))) - :buffer buf - :begin begin-marker - :end end-marker - :indentation indentation - :last-point (lambda () (1- end-marker)) - :cur-position (lambda () - (lsp-save-restriction-and-excursion - (list :line (- (lsp--cur-line) - (lsp--cur-line begin-marker)) - :character (let ((character (- (point) - (line-beginning-position) - indentation))) - (if (< character 0) - 0 - character))))) - :line/character->point (-lambda (line character) - (-let [inhibit-field-text-motion t] - (+ indentation - (lsp-save-restriction-and-excursion - (goto-char begin-marker) - (forward-line line) - (-let [line-end (line-end-position)] - (if (> character (- line-end (point))) - line-end - (forward-char character) - (point))))))) - :major-mode (org-src-get-lang-mode language) - :buffer-file-name file-name - :buffer-uri (lsp--path-to-uri file-name) - :with-current-buffer wcb - :buffer-live? (lambda (_) (buffer-live-p buf)) - :buffer-name (lambda (_) - (propertize (format "%s(%s:%s)%s" - (buffer-name buf) - begin-marker - end-marker - language) - 'face 'italic)) - :real->virtual-line (lambda (line) - (+ line (line-number-at-pos begin-marker) -1)) - :real->virtual-char (lambda (char) (+ char indentation)) - :cleanup (lambda () - (set-marker begin-marker nil) - (set-marker end-marker nil)))) - (setf virtual-buffer lsp--virtual-buffer) - (puthash file-name virtual-buffer lsp--virtual-buffer-mappings) - (push virtual-buffer lsp--virtual-buffer-connections) - - ;; TODO: tangle only connected sections - (add-hook 'after-save-hook 'org-babel-tangle nil t) - (add-hook 'lsp-after-open-hook #'lsp-patch-on-change-event nil t) - (add-hook 'kill-buffer-hook #'lsp-kill-virtual-buffers nil t) - - (setq lsp--buffer-workspaces - (lsp-with-current-buffer virtual-buffer - (lsp) - (plist-put virtual-buffer :workspaces (lsp-workspaces)) - (lsp-workspaces))))))) - -(defun lsp-virtual-buffer-disconnect (virtual-buffer) - (interactive (list (or - lsp--virtual-buffer - (when lsp--virtual-buffer-connections - (lsp--completing-read "Select virtual buffer to disconnect: " - lsp--virtual-buffer-connections - (-lambda ((&plist :buffer-file-name)) - buffer-file-name)))))) - (-if-let ((&plist :buffer-file-name file-name :cleanup) virtual-buffer) - (progn - (lsp-with-current-buffer virtual-buffer - (lsp--text-document-did-close)) - (setq lsp--virtual-buffer-connections (-remove-item virtual-buffer lsp--virtual-buffer-connections)) - (when (eq virtual-buffer lsp--virtual-buffer) - (setf lsp--virtual-buffer nil)) - (when cleanup (funcall cleanup)) - (remhash file-name lsp--virtual-buffer-mappings) - - (lsp--virtual-buffer-update-position) - (lsp--info "Disconnected from buffer %s" file-name)) - (lsp--error "Nothing to disconnect from?"))) - - -;; inlay hints - -(defface lsp-inlay-hint-face - '((t :inherit font-lock-comment-face)) - "The face to use for the JavaScript inlays." - :group 'lsp-mode - :package-version '(lsp-mode . "9.0.0")) - -(defface lsp-inlay-hint-type-face - '((t :inherit lsp-inlay-hint-face)) - "Face for inlay type hints (e.g. inferred variable types)." - :group 'lsp-mode - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-inlay-hint-type-format "%s" - "Format string for variable inlays (part of the inlay face)." - :type '(string :tag "String") - :group 'lsp-mode - :package-version '(lsp-mode . "9.0.0")) - -(defface lsp-inlay-hint-parameter-face - '((t :inherit lsp-inlay-hint-face)) - "Face for inlay parameter hints (e.g. function parameter names at -call-site)." - :group 'lsp-mode - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-inlay-hint-param-format "%s" - "Format string for parameter inlays (part of the inlay face)." - :type '(string :tag "String") - :group 'lsp-mode - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-update-inlay-hints-on-scroll t - "If non-nil update inlay hints immediately when scrolling or -modifying window sizes." - :type 'boolean - :package-version '(lsp-mode . "9.0.0")) - -(defun lsp--format-inlay (text kind) - (cond - ((eql kind lsp/inlay-hint-kind-type-hint) (format lsp-inlay-hint-type-format text)) - ((eql kind lsp/inlay-hint-kind-parameter-hint) (format lsp-inlay-hint-param-format text)) - (t text))) - -(defun lsp--face-for-inlay (kind) - (cond - ((eql kind lsp/inlay-hint-kind-type-hint) 'lsp-inlay-hint-type-face) - ((eql kind lsp/inlay-hint-kind-parameter-hint) 'lsp-inlay-hint-parameter-face) - (t 'lsp-inlay-hint-face))) - -(defun lsp--update-inlay-hints-scroll-function (window start) - (lsp-update-inlay-hints start (window-end window t))) - -(defun lsp--update-inlay-hints () - (lsp-update-inlay-hints (window-start) (window-end nil t))) - -(defun lsp--label-from-inlay-hints-response (label) - "Returns a string label built from an array of -InlayHintLabelParts or the argument itself if it's already a -string." - (cl-typecase label - (string label) - (vector - (string-join (mapcar (lambda (part) - (-let (((&InlayHintLabelPart :value) part)) - value)) - label))))) - -(defun lsp-update-inlay-hints (start end) - (lsp-request-async - "textDocument/inlayHint" - (lsp-make-inlay-hints-params - :text-document (lsp--text-document-identifier) - :range (lsp-make-range :start - (lsp-point-to-position start) - :end - (lsp-point-to-position end))) - (lambda (res) - (lsp--remove-overlays 'lsp-inlay-hint) - (dolist (hint res) - (-let* (((&InlayHint :label :position :kind? :padding-left? :padding-right?) hint) - (kind (or kind? lsp/inlay-hint-kind-type-hint)) - (label (lsp--label-from-inlay-hints-response label)) - (pos (lsp--position-to-point position)) - (overlay (make-overlay pos pos nil 'front-advance 'end-advance))) - (when (stringp label) - (overlay-put overlay 'lsp-inlay-hint t) - (overlay-put overlay 'before-string - (format "%s%s%s" - (if padding-left? " " "") - (propertize (lsp--format-inlay label kind) - 'font-lock-face (lsp--face-for-inlay kind)) - (if padding-right? " " ""))))))) - :mode 'tick)) - -(define-minor-mode lsp-inlay-hints-mode - "Mode for displaying inlay hints." - :lighter nil - (cond - ((and lsp-inlay-hints-mode lsp--buffer-workspaces) - (add-hook 'lsp-on-idle-hook #'lsp--update-inlay-hints nil t) - (when lsp-update-inlay-hints-on-scroll - (add-to-list (make-local-variable 'window-scroll-functions) - #'lsp--update-inlay-hints-scroll-function))) - (t - (lsp--remove-overlays 'lsp-inlay-hint) - (remove-hook 'lsp-on-idle-hook #'lsp--update-inlay-hints t) - (setf window-scroll-functions - (delete #'lsp--update-inlay-hints-scroll-function window-scroll-functions))))) - - - -;;;###autoload -(defun lsp-start-plain () - "Start `lsp-mode' using minimal configuration using the latest `melpa' version -of the packages. - -In case the major-mode that you are using for " - (interactive) - (let ((start-plain (make-temp-file "plain" nil ".el"))) - (url-copy-file "https://raw.githubusercontent.com/emacs-lsp/lsp-mode/master/scripts/lsp-start-plain.el" - start-plain t) - (start-process "lsp-start-plain" - (generate-new-buffer " *lsp-start-plain*") - (expand-file-name invocation-name invocation-directory) - "-q" "-l" start-plain (or (buffer-file-name) "")))) - - - -(provide 'lsp-mode) -;;; lsp-mode.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-mode.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-mode.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-php.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-php.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-prolog.el b/emacs/elpa/lsp-mode-20241113.743/lsp-prolog.el @@ -1,55 +0,0 @@ -;;; lsp-prolog.el --- Prolog Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 James Cash - -;; Author: James Cash <james.nvc@gmail.com> -;; Keywords: languages,tools - -;; 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: - -;; lsp-prolog client - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-prolog nil - "LSP support for Prolog." - :link '(url-link "https://github.com/jamesnvc/lsp_server") - :group 'lsp-mode - :tag "Lsp Prolog") - -(defcustom lsp-prolog-server-command '("swipl" - "-g" "use_module(library(lsp_server))." - "-g" "lsp_server:main" - "-t" "halt" - "--" "stdio") - "The prolog-lsp server command." - :group 'lsp-prolog - :risky t - :type 'list) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection (lambda () lsp-prolog-server-command)) - :major-modes '(prolog-mode) - :multi-root t - :server-id 'prolog-lsp)) - -(lsp-consistency-check lsp-prolog) - -(provide 'lsp-prolog) -;;; lsp-prolog.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-prolog.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-prolog.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-protocol.el b/emacs/elpa/lsp-mode-20241113.743/lsp-protocol.el @@ -1,823 +0,0 @@ -;;; lsp-protocol.el --- Language Sever Protocol Bindings -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 Ivan Yonchovski - -;; Author: Ivan Yonchovski <yyoncho@gmail.com> -;; Keywords: convenience - -;; 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: - -;; Autogenerated bindings from lsp4j using -;; https://github.com/victools/jsonschema-generator+scripts to generate -;; scripts/generated.protocol.schema.json and then -;; scripts/lsp-generate-bindings.el - -;;; Code: - -(require 'cl-lib) -(require 'dash) -(require 'ht) -(require 's) -(require 'json) - -(eval-and-compile - (defun lsp-keyword->symbol (keyword) - "Convert a KEYWORD to symbol." - (intern (substring (symbol-name keyword) 1))) - - (defun lsp-keyword->string (keyword) - "Convert a KEYWORD to string." - (substring (symbol-name keyword) 1)) - - (defvar lsp-use-plists (getenv "LSP_USE_PLISTS"))) - -(defmacro lsp-interface (&rest interfaces) - "Generate LSP bindings from INTERFACES triplet. - -Example usage with `dash`. - -\(-let [(&ApplyWorkspaceEditResponse - :failure-reason?) (ht (\"failureReason\" \"...\"))] - failure-reason?) - -\(fn (INTERFACE-NAME-1 REQUIRED-FIELDS-1 OPTIONAL-FIELDS-1) (INTERFACE-NAME-2 REQUIRED-FIELDS-2 OPTIONAL-FIELDS-2) ...)" - (with-case-table ascii-case-table - (->> interfaces - (-map (-lambda ((interface required optional)) - (let ((params (nconc - (-map (lambda (param-name) - (cons - (intern (concat ":" (s-dashed-words (symbol-name param-name)) "?")) - param-name)) - optional) - (-map (lambda (param-name) - (cons (intern (concat ":" (s-dashed-words (symbol-name param-name)))) - param-name)) - required)))) - (cl-list* - `(defun ,(intern (format "dash-expand:&%s" interface)) (key source) - (unless (or (member key ',(-map #'cl-first params)) - (s-starts-with? ":_" (symbol-name key))) - (error "Unknown key: %s. Available keys: %s" key ',(-map #'cl-first params))) - ,(if lsp-use-plists - ``(plist-get ,source - ,(if (s-starts-with? ":_" (symbol-name key)) - key - (cl-rest (assoc key ',params)))) - ``(gethash ,(if (s-starts-with? ":_" (symbol-name key)) - (substring (symbol-name key) 1) - (substring (symbol-name - (cl-rest (assoc key ',params))) - 1)) - ,source))) - `(defun ,(intern (format "dash-expand:&%s?" interface)) (key source) - (unless (member key ',(-map #'cl-first params)) - (error "Unknown key: %s. Available keys: %s" key ',(-map #'cl-first params))) - ,(if lsp-use-plists - ``(plist-get ,source - ,(if (s-starts-with? ":_" (symbol-name key)) - key - (cl-rest (assoc key ',params)))) - ``(when (ht? ,source) - (gethash ,(substring (symbol-name - (cl-rest (assoc key ',params))) - 1) - ,source)))) - - `(defun ,(intern (format "lsp-%s?" (s-dashed-words (symbol-name interface)))) (object) - (cond - ((ht? object) - (-all? (let ((keys (ht-keys object))) - (lambda (prop) - (member prop keys))) - ',(-map (lambda (field-name) - (substring (symbol-name field-name) 1)) - required))) - ((listp object) (-all? (lambda (prop) - (plist-member object prop)) - ',required)))) - `(cl-defun ,(intern (format "lsp-make-%s" (s-dashed-words (symbol-name interface)))) - (&rest plist &key ,@(-map (-lambda ((key)) - (intern (substring (symbol-name key) 1))) params) - &allow-other-keys) - (ignore ,@(-map (-lambda ((key)) - (intern (substring (symbol-name key) 1))) params)) - ,(format "Constructs %s from `plist.' -Allowed params: %s" interface (reverse (-map #'cl-first params))) - ,(if lsp-use-plists - `(-mapcat (-lambda ((key value)) - (list (or (cl-rest (assoc key ',params)) key) value)) - (-partition 2 plist)) - `(let (($$result (ht))) - (mapc (-lambda ((key value)) - (puthash (lsp-keyword->string (or (cl-rest (assoc key ',params)) - key)) - value - $$result)) - (-partition 2 plist)) - $$result))) - `(cl-defun ,(intern (format "lsp--pcase-macroexpander-%s" interface)) (&rest property-bindings) - ,(if lsp-use-plists - ``(and - (pred listp) - ;; Check if all the types required by the - ;; interface exist in the expr-val. - ,@(-map - (lambda (key) - `(pred - (lambda (plist) - (plist-member plist ,key)))) - ',required) - ;; Recursively generate the bindings. - ,@(let ((current-list property-bindings) - (output-bindings nil)) - ;; Invariant: while current-list is - ;; non-nil, the car of current-list is - ;; always of the form :key, while the - ;; cadr of current-list is either a) - ;; nil, b) of the form :key-next or c) - ;; a pcase pattern that can - ;; recursively match an expression. - (while current-list - (-let* (((curr-binding-as-keyword next-entry . _) current-list) - (curr-binding-as-camelcased-symbol - (or (alist-get curr-binding-as-keyword ',params) - (error "Unknown key: %s. Available keys: %s" - (symbol-name curr-binding-as-keyword) - ',(-map #'cl-first params)))) - (bound-name (lsp-keyword->symbol curr-binding-as-keyword)) - (next-entry-is-key-or-nil - (and (symbolp next-entry) - (or (null next-entry) - (s-starts-with? ":" (symbol-name next-entry)))))) - (cond - ;; If the next-entry is either a - ;; plist-key or nil, then bind to - ;; bound-name the value corresponding - ;; to the camelcased symbol. Pop - ;; current-list once. - (next-entry-is-key-or-nil - (push `(app (lambda (plist) - (plist-get plist ,curr-binding-as-camelcased-symbol)) - ,bound-name) - output-bindings) - (setf current-list (cdr current-list))) - ;; Otherwise, next-entry is a pcase - ;; pattern we recursively match to the - ;; expression. This can in general - ;; create additional bindings that we - ;; persist in the top level of - ;; bindings. We pop current-list - ;; twice. - (t - (push `(app (lambda (plist) - (plist-get plist ,curr-binding-as-camelcased-symbol)) - ,next-entry) - output-bindings) - (setf current-list (cddr current-list)))))) - output-bindings)) - ``(and - (pred ht?) - ,@(-map - (lambda (key) - `(pred - (lambda (hash-table) - (ht-contains? hash-table ,(lsp-keyword->string key))))) - ',required) - ,@(let ((current-list property-bindings) - (output-bindings nil)) - (while current-list - (-let* (((curr-binding-as-keyword next-entry . _) current-list) - (curr-binding-as-camelcased-string - (lsp-keyword->string (or (alist-get curr-binding-as-keyword ',params) - (error "Unknown key: %s. Available keys: %s" - (symbol-name curr-binding-as-keyword) - ',(-map #'cl-first params))))) - (bound-name (lsp-keyword->symbol curr-binding-as-keyword)) - (next-entry-is-key-or-nil - (and (symbolp next-entry) - (or (null next-entry) - (s-starts-with? ":" (symbol-name next-entry)))))) - (cond - (next-entry-is-key-or-nil - (push `(app (lambda (hash-table) - (ht-get hash-table ,curr-binding-as-camelcased-string)) - ,bound-name) - output-bindings) - (setf current-list (cdr current-list))) - (t - (push `(app (lambda (hash-table) - (ht-get hash-table ,curr-binding-as-camelcased-string)) - ,next-entry) - output-bindings) - (setf current-list (cddr current-list)))))) - output-bindings)))) - (-mapcat (-lambda ((label . name)) - (list - `(defun ,(intern (format "lsp:%s-%s" - (s-dashed-words (symbol-name interface)) - (substring (symbol-name label) 1))) - (object) - ,(if lsp-use-plists - `(plist-get object ,name) - `(when (ht? object) (gethash ,(lsp-keyword->string name) object)))) - `(defun ,(intern (format "lsp:set-%s-%s" - (s-dashed-words (symbol-name interface)) - (substring (symbol-name label) 1))) - (object value) - ,@(if lsp-use-plists - `((plist-put object ,name value)) - `((puthash ,(lsp-keyword->string name) value object) - object))))) - params))))) - (apply #'append) - (cl-list* 'progn)))) - -(pcase-defmacro lsp-interface (interface &rest property-bindings) - "If EXPVAL is an instance of INTERFACE, destructure it by matching its -properties. EXPVAL should be a plist or hash table depending on the variable -`lsp-use-plists'. - -INTERFACE should be an LSP interface defined with `lsp-interface'. This form -will not match if any of INTERFACE's required fields are missing in EXPVAL. - -Each :PROPERTY keyword matches a field in EXPVAL. The keyword may be followed by -an optional PATTERN, which is a `pcase' pattern to apply to the field's value. -Otherwise, PROPERTY is let-bound to the field's value. - -\(fn INTERFACE [:PROPERTY [PATTERN]]...)" - (cl-check-type interface symbol) - (let ((lsp-pcase-macroexpander - (intern (format "lsp--pcase-macroexpander-%s" interface)))) - (cl-assert (fboundp lsp-pcase-macroexpander) "not a known LSP interface: %s" interface) - (apply lsp-pcase-macroexpander property-bindings))) - -(if lsp-use-plists - (progn - (defun lsp-get (from key) - (plist-get from key)) - (defun lsp-put (where key value) - (plist-put where key value)) - (defun lsp-map (fn value) - (-map (-lambda ((k v)) - (funcall fn (lsp-keyword->string k) v)) - (-partition 2 value ))) - (defalias 'lsp-merge 'append) - (defalias 'lsp-empty? 'null) - (defalias 'lsp-copy 'copy-sequence) - (defun lsp-member? (from key) - (when (listp from) - (plist-member from key))) - (defalias 'lsp-structure-p 'json-plist-p) - (defun lsp-delete (from key) - (cl-remf from key) - from)) - (defun lsp-get (from key) - (when from - (gethash (lsp-keyword->string key) from))) - (defun lsp-put (where key value) - (prog1 where - (puthash (lsp-keyword->string key) value where))) - (defun lsp-map (fn value) - (when value - (maphash fn value))) - (defalias 'lsp-merge 'ht-merge) - (defalias 'lsp-empty? 'ht-empty?) - (defalias 'lsp-copy 'ht-copy) - (defun lsp-member? (from key) - (when (hash-table-p from) - (not (eq (gethash (lsp-keyword->string key) from :__lsp_default) - :__lsp_default)))) - (defalias 'lsp-structure-p 'hash-table-p) - (defun lsp-delete (from key) - (ht-remove from (lsp-keyword->string key)) - from)) - -(defmacro lsp-defun (name match-form &rest body) - "Define a function named NAME. -The function destructures its input as MATCH-FORM then executes BODY. - -Note that you have to enclose the MATCH-FORM in a pair of parens, -such that: - - (-defun (x) body) - (-defun (x y ...) body) - -has the usual semantics of `defun'. Furthermore, these get -translated into a normal `defun', so there is no performance -penalty. - -See `-let' for a description of the destructuring mechanism." - (declare (doc-string 3) (indent defun) - (debug (&define name sexp - [&optional stringp] - [&optional ("declare" &rest sexp)] - [&optional ("interactive" interactive)] - def-body))) - (cond - ((nlistp match-form) - (signal 'wrong-type-argument (list #'listp match-form))) - ;; no destructuring, so just return regular defun to make things faster - ((-all? #'symbolp match-form) - `(defun ,name ,match-form ,@body)) - (t - (-let* ((inputs (--map-indexed (list it (make-symbol (format "input%d" it-index))) match-form)) - ((body docs) (cond - ;; only docs - ((and (stringp (car body)) - (not (cdr body))) - (list body (car body))) - ;; docs + body - ((stringp (car body)) - (list (cdr body) (car body))) - ;; no docs - (t (list body)))) - ((body interactive-form) (cond - ;; interactive form - ((and (listp (car body)) - (eq (caar body) 'interactive)) - (list (cdr body) (car body))) - ;; no interactive form - (t (list body))))) - ;; TODO: because inputs to the defun are evaluated only once, - ;; -let* need not to create the extra bindings to ensure that. - ;; We should find a way to optimize that. Not critical however. - `(defun ,name ,(-map #'cadr inputs) - ,@(when docs (list docs)) - ,@(when interactive-form (list interactive-form)) - (-let* ,inputs ,@body)))))) - - - - -;; manually defined interfaces -(defconst lsp/markup-kind-plain-text "plaintext") -(defconst lsp/markup-kind-markdown "markdown") - -(lsp-interface (JSONResponse (:params :id :method :result) nil) - (JSONResponseError (:error) nil) - (JSONMessage nil (:params :id :method :result :error)) - (JSONResult nil (:params :id :method)) - (JSONNotification (:params :method) nil) - (JSONRequest (:params :method) nil) - (JSONError (:message :code) (:data)) - (ProgressParams (:token :value) nil) - (Edit (:kind) nil) - (WorkDoneProgress (:kind) nil) - (WorkDoneProgressBegin (:kind :title) (:cancellable :message :percentage)) - (WorkDoneProgressReport (:kind) (:cancellable :message :percentage)) - (WorkDoneProgressEnd (:kind) (:message)) - (WorkDoneProgressOptions nil (:workDoneProgress)) - (SemanticTokensOptions (:legend) (:rangeProvider :documentProvider)) - (SemanticTokensLegend (:tokenTypes :tokenModifiers)) - (SemanticTokensResult (:resultId) (:data)) - (SemanticTokensPartialResult nil (:data)) - (SemanticTokensEdit (:start :deleteCount) (:data)) - (SemanticTokensDelta (:resultId) (:edits)) - (SemanticTokensDeltaPartialResult nil (:edits))) - -(lsp-interface (v1:ProgressParams (:id :title) (:message :percentage :done))) - -(defun dash-expand:&RangeToPoint (key source) - "Convert the position KEY from SOURCE into a point." - `(lsp--position-to-point - (lsp-get ,source ,key))) - -(lsp-interface (eslint:StatusParams (:state) nil) - (eslint:OpenESLintDocParams (:url) nil) - (eslint:ConfirmExecutionParams (:scope :file :libraryPath) nil)) - -(lsp-interface (haxe:ProcessStartNotification (:title) nil)) - -(lsp-interface (pwsh:ScriptRegion (:StartLineNumber :EndLineNumber :StartColumnNumber :EndColumnNumber :Text) nil)) - -(lsp-interface (omnisharp:ErrorMessage (:Text :FileName :Line :Column)) - (omnisharp:ProjectInformationRequest (:FileName)) - (omnisharp:MsBuildProject (:IsUnitProject :IsExe :Platform :Configuration :IntermediateOutputPath :OutputPath :TargetFrameworks :SourceFiles :TargetFramework :TargetPath :AssemblyName :Path :ProjectGuid)) - (omnisharp:ProjectInformation (:ScriptProject :MsBuildProject)) - (omnisharp:CodeStructureRequest (:FileName)) - (omnisharp:CodeStructureResponse (:Elements)) - (omnisharp:CodeElement (:Kind :Name :DisplayName :Children :Ranges :Properties)) - (omnisharp:CodeElementProperties () (:static :accessibility :testMethodName :testFramework)) - (omnisharp:Range (:Start :End)) - (omnisharp:RangeList () (:attributes :full :name)) - (omnisharp:Point (:Line :Column)) - (omnisharp:RunTestsInClassRequest (:MethodNames :RunSettings :TestFrameworkname :TargetFrameworkVersion :NoBuild :Line :Column :Buffer :FileName)) - (omnisharp:RunTestResponse (:Results :Pass :Failure :ContextHadNoTests)) - (omnisharp:TestMessageEvent (:MessageLevel :Message)) - (omnisharp:DotNetTestResult (:MethodName :Outcome :ErrorMessage :ErrorStackTrace :StandardOutput :StandardError)) - (omnisharp:MetadataRequest (:AssemblyName :TypeName :ProjectName :VersionNumber :Language)) - (omnisharp:MetadataResponse (:SourceName :Source))) - -(lsp-interface (csharp-ls:CSharpMetadata (:textDocument)) - (csharp-ls:CSharpMetadataResponse (:source :projectName :assemblyName :symbolName))) - -(lsp-interface (rls:Cmd (:args :binary :env :cwd) nil)) - -(lsp-interface (rust-analyzer:AnalyzerStatusParams (:textDocument)) - (rust-analyzer:SyntaxTreeParams (:textDocument) (:range)) - (rust-analyzer:ViewHir (:textDocument :position)) - (rust-analyzer:ViewItemTree (:textDocument)) - (rust-analyzer:ExpandMacroParams (:textDocument :position) nil) - (rust-analyzer:ExpandedMacro (:name :expansion) nil) - (rust-analyzer:MatchingBraceParams (:textDocument :positions) nil) - (rust-analyzer:OpenCargoTomlParams (:textDocument) nil) - (rust-analyzer:OpenExternalDocsParams (:textDocument :position) nil) - (rust-analyzer:ResovedCodeActionParams (:id :codeActionParams) nil) - (rust-analyzer:JoinLinesParams (:textDocument :ranges) nil) - (rust-analyzer:MoveItemParams (:textDocument :range :direction) nil) - (rust-analyzer:RunnablesParams (:textDocument) (:position)) - (rust-analyzer:Runnable (:label :kind :args) (:location)) - (rust-analyzer:RunnableArgs (:cargoArgs :executableArgs) (:workspaceRoot :expectTest)) - (rust-analyzer:RelatedTestsParams (:textDocument :position) nil) - (rust-analyzer:RelatedTests (:runnable) nil) - (rust-analyzer:SsrParams (:query :parseOnly) nil) - (rust-analyzer:CommandLink (:title :command) (:arguments :tooltip)) - (rust-analyzer:CommandLinkGroup (:commands) (:title))) - -(lsp-interface (clojure-lsp:TestTreeParams (:uri :tree) nil) - (clojure-lsp:TestTreeNode (:name :range :nameRange :kind) (:children)) - (clojure-lsp:ProjectTreeNode (:name :type) (:nodes :final :id :uri :detail :range))) - -(lsp-interface (terraform-ls:ModuleCalls (:v :module_calls) nil)) -(lsp-interface (terraform-ls:Module (:name :docs_link :version :source_type :dependent_modules) nil)) -(lsp-interface (terraform-ls:Providers (:v :provider_requirements :installed_providers) nil)) -(lsp-interface (terraform-ls:module.terraform (:v :required_version :discovered_version))) - - -;; begin autogenerated code - -(defvar lsp/completion-item-kind-lookup - [nil Text Method Function Constructor Field Variable Class Interface Module Property Unit Value Enum Keyword Snippet Color File Reference Folder EnumMember Constant Struct Event Operator TypeParameter]) -(defconst lsp/completion-item-kind-text 1) -(defconst lsp/completion-item-kind-method 2) -(defconst lsp/completion-item-kind-function 3) -(defconst lsp/completion-item-kind-constructor 4) -(defconst lsp/completion-item-kind-field 5) -(defconst lsp/completion-item-kind-variable 6) -(defconst lsp/completion-item-kind-class 7) -(defconst lsp/completion-item-kind-interface 8) -(defconst lsp/completion-item-kind-module 9) -(defconst lsp/completion-item-kind-property 10) -(defconst lsp/completion-item-kind-unit 11) -(defconst lsp/completion-item-kind-value 12) -(defconst lsp/completion-item-kind-enum 13) -(defconst lsp/completion-item-kind-keyword 14) -(defconst lsp/completion-item-kind-snippet 15) -(defconst lsp/completion-item-kind-color 16) -(defconst lsp/completion-item-kind-file 17) -(defconst lsp/completion-item-kind-reference 18) -(defconst lsp/completion-item-kind-folder 19) -(defconst lsp/completion-item-kind-enum-member 20) -(defconst lsp/completion-item-kind-constant 21) -(defconst lsp/completion-item-kind-struct 22) -(defconst lsp/completion-item-kind-event 23) -(defconst lsp/completion-item-kind-operator 24) -(defconst lsp/completion-item-kind-type-parameter 25) -(defvar lsp/completion-trigger-kind-lookup - [nil Invoked TriggerCharacter TriggerForIncompleteCompletions]) -(defconst lsp/completion-trigger-kind-invoked 1) -(defconst lsp/completion-trigger-kind-trigger-character 2) -(defconst lsp/completion-trigger-kind-trigger-for-incomplete-completions 3) -(defvar lsp/diagnostic-severity-lookup - [nil Error Warning Information Hint Max]) -(defconst lsp/diagnostic-severity-error 1) -(defconst lsp/diagnostic-severity-warning 2) -(defconst lsp/diagnostic-severity-information 3) -(defconst lsp/diagnostic-severity-hint 4) -(defconst lsp/diagnostic-severity-max 5) -(defvar lsp/diagnostic-tag-lookup - [nil Unnecessary Deprecated]) -(defconst lsp/diagnostic-tag-unnecessary 1) -(defconst lsp/diagnostic-tag-deprecated 2) -(defvar lsp/completion-item-tag-lookup - [nil Deprecated]) -(defconst lsp/completion-item-tag-deprecated 1) -(defvar lsp/document-highlight-kind-lookup - [nil Text Read Write]) -(defconst lsp/document-highlight-kind-text 1) -(defconst lsp/document-highlight-kind-read 2) -(defconst lsp/document-highlight-kind-write 3) -(defvar lsp/file-change-type-lookup - [nil Created Changed Deleted]) -(defconst lsp/file-change-type-created 1) -(defconst lsp/file-change-type-changed 2) -(defconst lsp/file-change-type-deleted 3) -(defvar lsp/insert-text-format-lookup - [nil PlainText Snippet]) -(defconst lsp/insert-text-format-plain-text 1) -(defconst lsp/insert-text-format-snippet 2) -(defvar lsp/insert-text-mode-lookup - [nil AsIs AdjustIndentation]) -(defconst lsp/insert-text-mode-as-it 1) -(defconst lsp/insert-text-mode-adjust-indentation 2) -(defvar lsp/message-type-lookup - [nil Error Warning Info Log]) -(defconst lsp/message-type-error 1) -(defconst lsp/message-type-warning 2) -(defconst lsp/message-type-info 3) -(defconst lsp/message-type-log 4) -(defvar lsp/signature-help-trigger-kind-lookup - [nil Invoked TriggerCharacter ContentChange]) -(defconst lsp/signature-help-trigger-kind-invoked 1) -(defconst lsp/signature-help-trigger-kind-trigger-character 2) -(defconst lsp/signature-help-trigger-kind-content-change 3) -(defvar lsp/symbol-kind-lookup - [nil File Module Namespace Package Class Method Property Field Constructor Enum Interface Function Variable Constant String Number Boolean Array Object Key Null EnumMember Struct Event Operator TypeParameter]) -(defconst lsp/symbol-kind-file 1) -(defconst lsp/symbol-kind-module 2) -(defconst lsp/symbol-kind-namespace 3) -(defconst lsp/symbol-kind-package 4) -(defconst lsp/symbol-kind-class 5) -(defconst lsp/symbol-kind-method 6) -(defconst lsp/symbol-kind-property 7) -(defconst lsp/symbol-kind-field 8) -(defconst lsp/symbol-kind-constructor 9) -(defconst lsp/symbol-kind-enum 10) -(defconst lsp/symbol-kind-interface 11) -(defconst lsp/symbol-kind-function 12) -(defconst lsp/symbol-kind-variable 13) -(defconst lsp/symbol-kind-constant 14) -(defconst lsp/symbol-kind-string 15) -(defconst lsp/symbol-kind-number 16) -(defconst lsp/symbol-kind-boolean 17) -(defconst lsp/symbol-kind-array 18) -(defconst lsp/symbol-kind-object 19) -(defconst lsp/symbol-kind-key 20) -(defconst lsp/symbol-kind-null 21) -(defconst lsp/symbol-kind-enum-member 22) -(defconst lsp/symbol-kind-struct 23) -(defconst lsp/symbol-kind-event 24) -(defconst lsp/symbol-kind-operator 25) -(defconst lsp/symbol-kind-type-parameter 26) -(defvar lsp/text-document-save-reason-lookup - [nil Manual AfterDelay FocusOut]) -(defconst lsp/text-document-save-reason-manual 1) -(defconst lsp/text-document-save-reason-after-delay 2) -(defconst lsp/text-document-save-reason-focus-out 3) -(defvar lsp/text-document-sync-kind-lookup - [None Full Incremental]) -(defconst lsp/text-document-sync-kind-none 0) -(defconst lsp/text-document-sync-kind-full 1) -(defconst lsp/text-document-sync-kind-incremental 2) -(defvar lsp/type-hierarchy-direction-lookup - [nil Children Parents Both]) -(defconst lsp/type-hierarchy-direction-children 1) -(defconst lsp/type-hierarchy-direction-parents 2) -(defconst lsp/type-hierarchy-direction-both 3) -(defvar lsp/call-hierarchy-direction-lookup - [nil CallsFrom CallsTo]) -(defconst lsp/call-hierarchy-direction-calls-from 1) -(defconst lsp/call-hierarchy-direction-calls-to 2) -(defvar lsp/response-error-code-lookup - [nil ParseError InvalidRequest MethodNotFound InvalidParams InternalError serverErrorStart serverErrorEnd]) -(defconst lsp/response-error-code-parse-error 1) -(defconst lsp/response-error-code-invalid-request 2) -(defconst lsp/response-error-code-method-not-found 3) -(defconst lsp/response-error-code-invalid-params 4) -(defconst lsp/response-error-code-internal-error 5) -(defconst lsp/response-error-code-server-error-start 6) -(defconst lsp/response-error-code-server-error-end 7) - -(lsp-interface - (CallHierarchyCapabilities nil (:dynamicRegistration)) - (CallHierarchyItem (:kind :name :range :selectionRange :uri) (:detail :tags)) - (ClientCapabilities nil (:experimental :textDocument :workspace)) - (ClientInfo (:name) (:version)) - (CodeActionCapabilities nil (:codeActionLiteralSupport :dynamicRegistration :isPreferredSupport :dataSupport :resolveSupport)) - (CodeActionContext (:diagnostics) (:only)) - (CodeActionKindCapabilities (:valueSet) nil) - (CodeActionLiteralSupportCapabilities nil (:codeActionKind)) - (CodeActionOptions nil (:codeActionKinds :resolveProvider)) - (CodeLensCapabilities nil (:dynamicRegistration)) - (CodeLensOptions (:resolveProvider) nil) - (Color (:red :green :blue :alpha) nil) - (ColorProviderCapabilities nil (:dynamicRegistration)) - (ColorProviderOptions nil (:documentSelector :id)) - (ColoringInformation (:range :styles) nil) - (Command (:title :command) (:arguments)) - (CompletionCapabilities nil (:completionItem :completionItemKind :contextSupport :dynamicRegistration)) - (CompletionContext (:triggerKind) (:triggerCharacter)) - (CompletionItem (:label) (:additionalTextEdits :command :commitCharacters :data :deprecated :detail :documentation :filterText :insertText :insertTextFormat :insertTextMode :kind :preselect :sortText :tags :textEdit :score :labelDetails)) - (CompletionItemCapabilities nil (:commitCharactersSupport :deprecatedSupport :documentationFormat :preselectSupport :snippetSupport :tagSupport :insertReplaceSupport :resolveSupport)) - (CompletionItemKindCapabilities nil (:valueSet)) - (CompletionItemTagSupportCapabilities (:valueSet) nil) - (CompletionOptions nil (:resolveProvider :triggerCharacters :allCommitCharacters)) - (ConfigurationItem nil (:scopeUri :section)) - (CreateFileOptions nil (:ignoreIfExists :overwrite)) - (DeclarationCapabilities nil (:dynamicRegistration :linkSupport)) - (DefinitionCapabilities nil (:dynamicRegistration :linkSupport)) - (DeleteFileOptions nil (:ignoreIfNotExists :recursive)) - (Diagnostic (:range :message) (:code :relatedInformation :severity :source :tags)) - (DiagnosticClientCapabilities nil (:dynamicRegistration :relatedDocumentSupport)) - (DiagnosticOptions (:interFileDependencies :workspaceDiagnostics) (:identifier)) - (DiagnosticRelatedInformation (:location :message) nil) - (DiagnosticServerCancellationData (:retriggerRequest) nil) - (DiagnosticsTagSupport (:valueSet) nil) - (DidChangeConfigurationCapabilities nil (:dynamicRegistration)) - (DidChangeWatchedFilesCapabilities nil (:dynamicRegistration)) - (DocumentDiagnosticParams (:textDocument) (:identifier :previousResultId)) - (DocumentDiagnosticReport (:kind) (:resultId :items :relatedDocuments)) - (DocumentFilter nil (:language :pattern :scheme)) - (DocumentHighlightCapabilities nil (:dynamicRegistration)) - (DocumentLinkCapabilities nil (:dynamicRegistration :tooltipSupport)) - (DocumentLinkOptions nil (:resolveProvider)) - (DocumentOnTypeFormattingOptions (:firstTriggerCharacter) (:moreTriggerCharacter)) - (DocumentSymbol (:kind :name :range :selectionRange) (:children :deprecated :detail)) - (DocumentSymbolCapabilities nil (:dynamicRegistration :hierarchicalDocumentSymbolSupport :symbolKind)) - (ExecuteCommandCapabilities nil (:dynamicRegistration)) - (ExecuteCommandOptions (:commands) nil) - (FileEvent (:type :uri) nil) - (FileSystemWatcher (:globPattern) (:kind)) - (FileOperationFilter (:pattern) (:scheme)) - (FileOperationPattern (:glob) (:matches :options)) - (FileOperationPatternOptions nil (:ignoreCase)) - (FileOperationRegistrationOptions (:filters) nil) - (FoldingRangeCapabilities nil (:dynamicRegistration :lineFoldingOnly :rangeLimit)) - (FoldingRangeProviderOptions nil (:documentSelector :id)) - (FormattingCapabilities nil (:dynamicRegistration)) - (FormattingOptions (:tabSize :insertSpaces) (:trimTrailingWhitespace :insertFinalNewline :trimFinalNewlines)) - (HoverCapabilities nil (:contentFormat :dynamicRegistration)) - (ImplementationCapabilities nil (:dynamicRegistration :linkSupport)) - (LabelDetails (:detail :description) nil) - (LinkedEditingRanges (:ranges) (:wordPattern)) - (Location (:range :uri) nil) - (MarkedString (:language :value) nil) - (MarkupContent (:kind :value) nil) - (MessageActionItem (:title) nil) - (OnTypeFormattingCapabilities nil (:dynamicRegistration)) - (ParameterInformation (:label) (:documentation)) - (ParameterInformationCapabilities nil (:labelOffsetSupport)) - (Position (:character :line) nil) - (PublishDiagnosticsCapabilities nil (:relatedInformation :tagSupport :versionSupport)) - (Range (:start :end) nil) - (RangeFormattingCapabilities nil (:dynamicRegistration)) - (ReferenceContext (:includeDeclaration) nil) - (ReferencesCapabilities nil (:dynamicRegistration)) - (Registration (:method :id) (:registerOptions)) - (RenameCapabilities nil (:dynamicRegistration :prepareSupport)) - (RenameFileOptions nil (:ignoreIfExists :overwrite)) - (RenameOptions nil (:documentSelector :id :prepareProvider)) - (ResourceChange nil (:current :newUri)) - (ResourceOperation (:kind) nil) - (SaveOptions nil (:includeText)) - (SelectionRange (:range) (:parent)) - (SelectionRangeCapabilities nil (:dynamicRegistration)) - (SemanticHighlightingCapabilities nil (:semanticHighlighting)) - (SemanticHighlightingInformation (:line) (:tokens)) - (SemanticHighlightingServerCapabilities nil (:scopes)) - (ServerCapabilities nil (:callHierarchyProvider :codeActionProvider :codeLensProvider :colorProvider :completionProvider :declarationProvider :definitionProvider :documentFormattingProvider :documentHighlightProvider :documentLinkProvider :documentOnTypeFormattingProvider :documentRangeFormattingProvider :documentSymbolProvider :executeCommandProvider :experimental :foldingRangeProvider :hoverProvider :implementationProvider :referencesProvider :renameProvider :selectionRangeProvider :semanticHighlighting :signatureHelpProvider :textDocumentSync :typeDefinitionProvider :typeHierarchyProvider :workspace :workspaceSymbolProvider :semanticTokensProvider)) - (ServerInfo (:name) (:version)) - (SignatureHelp (:signatures) (:activeParameter :activeSignature)) - (SignatureHelpCapabilities nil (:contextSupport :dynamicRegistration :signatureInformation)) - (SignatureHelpContext (:triggerKind :isRetrigger) (:activeSignatureHelp :triggerCharacter)) - (SignatureHelpOptions nil (:retriggerCharacters :triggerCharacters)) - (SignatureInformation (:label) (:documentation :parameters)) - (SignatureInformationCapabilities nil (:documentationFormat :parameterInformation)) - (StaticRegistrationOptions nil (:documentSelector :id)) - (SymbolCapabilities nil (:dynamicRegistration :symbolKind)) - (SymbolKindCapabilities nil (:valueSet)) - (SynchronizationCapabilities nil (:didSave :dynamicRegistration :willSave :willSaveWaitUntil)) - (TextDocumentClientCapabilities nil (:callHierarchy :codeAction :codeLens :colorProvider :completion :declaration :definition :documentHighlight :documentLink :documentSymbol :foldingRange :formatting :hover :implementation :onTypeFormatting :publishDiagnostics :rangeFormatting :references :rename :selectionRange :semanticHighlightingCapabilities :signatureHelp :synchronization :typeDefinition :typeHierarchyCapabilities)) - (TextDocumentContentChangeEvent (:text) (:range :rangeLength)) - (TextDocumentEdit (:textDocument :edits) nil) - (TextDocumentIdentifier (:uri) nil) - (TextDocumentItem (:languageId :text :uri :version) nil) - (TextDocumentSyncOptions nil (:change :openClose :save :willSave :willSaveWaitUntil)) - (TextEdit (:newText :range) nil) - (InsertReplaceEdit (:newText :insert :replace) nil) - (SnippetTextEdit (:newText :range) (:insertTextFormat)) - (TypeDefinitionCapabilities nil (:dynamicRegistration :linkSupport)) - (TypeHierarchyCapabilities nil (:dynamicRegistration)) - (TypeHierarchyItem (:kind :name :range :selectionRange :uri) (:children :data :deprecated :detail :parents)) - (Unregistration (:method :id) nil) - (VersionedTextDocumentIdentifier (:uri) (:version)) - (WorkspaceClientCapabilities nil (:applyEdit :configuration :didChangeConfiguration :didChangeWatchedFiles :executeCommand :symbol :workspaceEdit :workspaceFolders)) - (WorkspaceEdit nil (:changes :documentChanges :resourceChanges)) - (WorkspaceEditCapabilities nil (:documentChanges :failureHandling :resourceChanges :resourceOperations)) - (WorkspaceFolder (:uri :name) nil) - (WorkspaceFoldersChangeEvent (:removed :added) nil) - (WorkspaceFoldersOptions nil (:changeNotifications :supported)) - (WorkspaceServerCapabilities nil (:workspaceFolders :fileOperations)) - (WorkspaceFileOperations nil (:didCreate :willCreate :didRename :willRename :didDelete :willDelete)) - (ApplyWorkspaceEditParams (:edit) (:label)) - (ApplyWorkspaceEditResponse (:applied) nil) - (CallHierarchyIncomingCall (:from :fromRanges) nil) - (CallHierarchyIncomingCallsParams (:item) nil) - (CallHierarchyOutgoingCall (:to :fromRanges) nil) - (CallHierarchyOutgoingCallsParams (:item) nil) - (CallHierarchyPrepareParams (:textDocument :position) (:uri)) - (CodeAction (:title) (:command :diagnostics :edit :isPreferred :kind :data)) - (CodeActionKind nil nil) - (CodeActionParams (:textDocument :context :range) nil) - (CodeLens (:range) (:command :data)) - (CodeLensParams (:textDocument) nil) - (CodeLensRegistrationOptions nil (:documentSelector :resolveProvider)) - (ColorInformation (:color :range) nil) - (ColorPresentation (:label) (:additionalTextEdits :textEdit)) - (ColorPresentationParams (:color :textDocument :range) nil) - (ColoringParams (:uri :infos) nil) - (ColoringStyle nil nil) - (CompletionList (:items :isIncomplete) nil) - (CompletionParams (:textDocument :position) (:context :uri)) - (CompletionRegistrationOptions nil (:documentSelector :resolveProvider :triggerCharacters)) - (ConfigurationParams (:items) nil) - (CreateFile (:kind :uri) (:options)) - (DeclarationParams (:textDocument :position) (:uri)) - (DefinitionParams (:textDocument :position) (:uri)) - (DeleteFile (:kind :uri) (:options)) - (DidChangeConfigurationParams (:settings) nil) - (DidChangeTextDocumentParams (:contentChanges :textDocument) (:uri)) - (DidChangeWatchedFilesParams (:changes) nil) - (DidChangeWatchedFilesRegistrationOptions (:watchers) nil) - (DidChangeWorkspaceFoldersParams (:event) nil) - (DidCloseTextDocumentParams (:textDocument) nil) - (DidOpenTextDocumentParams (:textDocument) (:text)) - (DidSaveTextDocumentParams (:textDocument) (:text)) - (DocumentColorParams (:textDocument) nil) - (DocumentFormattingParams (:textDocument :options) nil) - (DocumentHighlight (:range) (:kind)) - (DocumentHighlightParams (:textDocument :position) (:uri)) - (DocumentLink (:range) (:data :target :tooltip)) - (DocumentLinkParams (:textDocument) nil) - (DocumentLinkRegistrationOptions nil (:documentSelector :resolveProvider)) - (DocumentOnTypeFormattingParams (:ch :textDocument :options :position) nil) - (DocumentOnTypeFormattingRegistrationOptions (:firstTriggerCharacter) (:documentSelector :moreTriggerCharacter)) - (DocumentRangeFormattingParams (:textDocument :options :range) nil) - (DocumentSymbolParams (:textDocument) nil) - (DynamicRegistrationCapabilities nil (:dynamicRegistration)) - (ExecuteCommandParams (:command) (:arguments)) - (ExecuteCommandRegistrationOptions (:commands) nil) - (FailureHandlingKind nil nil) - (FileRename (:oldUri :newUri) nil) - (FoldingRange (:endLine :startLine) (:endCharacter :kind :startCharacter)) - (FoldingRangeKind nil nil) - (FoldingRangeRequestParams (:textDocument) nil) - (Hover (:contents) (:range)) - (HoverParams (:textDocument :position) (:uri)) - (ImplementationParams (:textDocument :position) (:uri)) - (InitializeError (:retry) nil) - (InitializeErrorCode nil nil) - (InitializeParams nil (:capabilities :clientInfo :clientName :initializationOptions :processId :rootPath :rootUri :trace :workspaceFolders)) - (InitializeResult (:capabilities) (:serverInfo)) - (InitializedParams nil nil) - (LocationLink (:targetSelectionRange :targetUri :targetRange) (:originSelectionRange)) - (MarkupKind nil nil) - (MessageParams (:type :message) nil) - (PrepareRenameParams (:textDocument :position) (:uri)) - (PrepareRenameResult (:range :placeholder) nil) - (PublishDiagnosticsParams (:diagnostics :uri) (:version)) - (QuickPickItem (:label :picked :userData) nil) - (ReferenceParams (:textDocument :context :position) (:uri)) - (RegistrationParams (:registrations) nil) - (RenameFile (:kind :newUri :oldUri) (:options)) - (RenameFilesParams (:files) nil) - (RenameParams (:newName :textDocument :position) (:uri)) - (ResolveTypeHierarchyItemParams (:item :resolve :direction) nil) - (ResourceOperationKind nil nil) - (SelectionRangeParams (:textDocument :positions) nil) - (SemanticHighlightingParams (:textDocument :lines) nil) - (ShowDocumentParams (:uri) (:external :takeFocus :selection)) - (ShowDocumentResult (:success) nil) - (ShowInputBoxParams (:prompt) (:value)) - (ShowMessageRequestParams (:type :message) (:actions)) - (ShowQuickPickParams (:placeHolder :canPickMany :items) nil) - (SignatureHelpParams (:textDocument :position) (:context :uri)) - (SignatureHelpRegistrationOptions nil (:documentSelector :triggerCharacters)) - (SymbolInformation (:kind :name :location) (:containerName :deprecated)) - (TextDocumentChangeRegistrationOptions (:syncKind) (:documentSelector)) - (TextDocumentPositionParams (:textDocument :position) (:uri)) - (TextDocumentRegistrationOptions nil (:documentSelector)) - (TextDocumentSaveRegistrationOptions nil (:documentSelector :includeText)) - (TypeDefinitionParams (:textDocument :position) (:uri)) - (TypeHierarchyParams (:resolve :textDocument :position) (:direction :uri)) - (UnregistrationParams (:unregisterations) nil) - (WatchKind nil nil) - (WillSaveTextDocumentParams (:reason :textDocument) nil) - (WorkspaceSymbolParams (:query) nil) - ;; 3.17 - (InlayHint (:label :position) (:kind :paddingLeft :paddingRight)) - (InlayHintLabelPart (:value) (:tooltip :location :command)) - (InlayHintsParams (:textDocument) (:range))) - -;; 3.17 -(defconst lsp/inlay-hint-kind-type-hint 1) -(defconst lsp/inlay-hint-kind-parameter-hint 2) - - -(provide 'lsp-protocol) - -;;; lsp-protocol.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-protocol.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-protocol.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-rf.el b/emacs/elpa/lsp-mode-20241113.743/lsp-rf.el @@ -1,147 +0,0 @@ -;;; lsp-rf.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, rf, robot - -;; 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: - -;; LSP Clients for the Robot Framework. - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-rf nil - "Settings for Robot Framework Language Server." - :group 'lsp-mode - :link '(url-link "https://github.com/tomi/vscode-rf-language-server")) - -(defcustom lsp-rf-language-server-start-command '("~/.nvm/versions/node/v9.11.2/bin/node" "~/.vscode/extensions/tomiturtiainen.rf-intellisense-2.8.0/server/server.js") - "Path to the server.js file of the rf-intellisense server. -Accepts a list of strings (path/to/interpreter path/to/server.js)" - :type 'list - :group 'lsp-rf) - -(defcustom lsp-rf-language-server-include-paths [] - "An array of files that should be included by the parser. -Glob patterns as strings are accepted (eg. *.robot between double quotes)" - :type 'lsp-string-vector - :group 'lsp-rf) - -(defcustom lsp-rf-language-server-exclude-paths [] - "An array of files that should be ignored by the parser. -Glob patterns as strings are accepted (eg. *bad.robot between double quotes)" - :type 'lsp-string-vector - :group 'lsp-rf) - -(defcustom lsp-rf-language-server-dir "~/.vscode/extensions/tomiturtiainen.rf-intellisense-2.8.0/server/library-docs/" - "Libraries directory for libraries in `lsp-rf-language-server-libraries'" - :type 'string - :group 'lsp-rf) - -(defcustom lsp-rf-language-server-libraries ["BuiltIn-3.1.1" "Collections-3.0.4"] - "Libraries whose keywords are suggested with `auto-complete'." - :type '(repeat string) - ;; :type 'lsp-string-vector - :group 'lsp-rf) - -(defcustom lsp-rf-language-server-log-level "debug" - "What language server log messages are printed." - :type 'string - ;; :type '(choice (:tag "off" "errors" "info" "debug")) - :group 'lsp-rf) - -(defcustom lsp-rf-language-server-trace-server "verbose" - "Traces the communication between VSCode and the rfLanguageServer service." - :type 'string - ;; :type '(choice (:tag "off" "messages" "verbose")) - :group 'lsp-rf) - -(defun parse-rf-language-server-library-dirs (dirs) - (vconcat (mapcar - (lambda (x) - (concat - (expand-file-name - lsp-rf-language-server-dir) - x - ".json")) - dirs))) - -(defun expand-start-command () - (mapcar 'expand-file-name lsp-rf-language-server-start-command)) - -(defun parse-rf-language-server-globs-to-regex (vector) - "Convert a VECTOR of globs to a regex." - (--> (mapcan #'lsp-glob-to-regexps vector) - (s-join "\\|" it) - (concat "\\(?:" it "\\)"))) - -(defun parse-rf-language-server-include-path-regex (vector) - "Creates regexp to select files from workspace directory." - (let ((globs (if (eq vector []) - ["*.robot" "*.resource"] - vector))) - (parse-rf-language-server-globs-to-regex globs))) - -(defun parse-rf-language-server-exclude-paths (seq) - "Creates regexp to select files from workspace directory." - (if (eq lsp-rf-language-server-exclude-paths []) - seq - (cl-delete-if (lambda (x) (string-match-p - (parse-rf-language-server-globs-to-regex - lsp-rf-language-server-exclude-paths) - x)) - seq))) - -(lsp-register-custom-settings - '( - ("rfLanguageServer.trace.server" lsp-rf-language-server-trace-server) - ("rfLanguageServer.logLevel" lsp-rf-language-server-log-level) - ("rfLanguageServer.libraries" lsp-rf-language-server-libraries) - ("rfLanguageServer.excludePaths" lsp-rf-language-server-exclude-paths) - ("rfLanguageServer.includePaths" lsp-rf-language-server-include-paths))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection - (expand-start-command)) - :major-modes '(robot-mode) - :server-id 'rf-intellisense - ;; :library-folders-fn (lambda (_workspace) - ;; lsp-rf-language-server-libraries) - :library-folders-fn (lambda (_workspace) - (parse-rf-language-server-library-dirs - lsp-rf-language-server-libraries)) - :initialized-fn (lambda (workspace) - (with-lsp-workspace workspace - (lsp--set-configuration - (lsp-configuration-section "rfLanguageServer")) - (lsp-request "buildFromFiles" - (list :files - (vconcat - (parse-rf-language-server-exclude-paths - (directory-files-recursively - (lsp--workspace-root workspace) - (parse-rf-language-server-include-path-regex - lsp-rf-language-server-include-paths)))))))))) - - - -(lsp-consistency-check lsp-rf) - -(provide 'lsp-rf) -;;; lsp-rf.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-rf.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-rf.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-roslyn.el b/emacs/elpa/lsp-mode-20241113.743/lsp-roslyn.el @@ -1,360 +0,0 @@ -;;; lsp-roslyn.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2023 Ruin0x11 - -;; Author: Ruin0x11 <ipickering2@gmail.com> -;; Keywords: - -;; 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: - -;; C# client using the Roslyn language server - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-roslyn nil - "LSP support for the C# programming language, using the Roslyn language server." - :link '(url-link "https://github.com/dotnet/roslyn/tree/main/src/LanguageServer") - :group 'lsp-mode - :package-version '(lsp-mode . "8.0.0")) - -(defconst lsp-roslyn--stdpipe-path (expand-file-name - "lsp-roslyn-stdpipe.ps1" - (file-name-directory (locate-library "lsp-roslyn"))) - "Path to the `stdpipe' script. -On Windows, this script is used as a proxy for the language server's named pipe. -Unused on other platforms.") - -(defcustom lsp-roslyn-install-path (expand-file-name "roslyn" lsp-server-install-dir) - "The path to install the Roslyn server to." - :type 'string - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-roslyn) - -(defcustom lsp-roslyn-server-dll-override-path nil - "Custom path to Microsoft.CodeAnalysis.LanguageServer.dll." - :type '(choice (const nil) string) - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-roslyn) - -(defcustom lsp-roslyn-server-timeout-seconds 60 - "Amount of time to wait for Roslyn server startup, in seconds." - :type 'integer - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-roslyn) - -(defcustom lsp-roslyn-server-log-level "Information" - "Log level for the Roslyn language server." - :type '(choice (:tag "None" "Trace" "Debug" "Information" "Warning" "Error" "Critical")) - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-roslyn) - -(defcustom lsp-roslyn-server-log-directory (concat (temporary-file-directory) (file-name-as-directory "lsp-roslyn")) - "Log directory for the Roslyn language server." - :type 'string - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-roslyn) - -(defcustom lsp-roslyn-server-extra-args '() - "Extra arguments for the Roslyn language server." - :type '(repeat string) - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-roslyn) - -(defcustom lsp-roslyn-dotnet-executable "dotnet" - "Dotnet executable to use with the Roslyn language server." - :type 'string - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-roslyn) - -(defcustom lsp-roslyn-package-version "4.12.0-3.24470.11" - "Version of the Roslyn package to install. -Gotten from https://dev.azure.com/azure-public/vside/_artifacts/feed/vs-impl/NuGet/Microsoft.CodeAnalysis.LanguageServer.win-x64" - :type 'string - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-roslyn) - -(defvar lsp-roslyn--pipe-name nil) - -(defun lsp-roslyn--parse-pipe-name (pipe) - (if (eq system-type 'windows-nt) - (progn - (string-match "\\([a-z0-9]+\\)$" pipe) - (match-string 1 pipe)) - pipe)) - -(defun lsp-roslyn--parent-process-filter (_process output) - "Parses the named pipe's name that the Roslyn server process prints on stdout." - (let* ((data (json-parse-string output :object-type 'plist)) - (pipe (plist-get data :pipeName))) - (when pipe - (setq lsp-roslyn--pipe-name (lsp-roslyn--parse-pipe-name pipe))))) - -(defun lsp-roslyn--make-named-pipe-process (filter sentinel environment-fn process-name stderr-buf) - "Creates the process that will handle the JSON-RPC communication." - (let* ((process-environment - (lsp--compute-process-environment environment-fn)) - (default-directory (lsp--default-directory-for-connection))) - (cond - ((eq system-type 'windows-nt) - (make-process - :name process-name - :connection-type 'pipe - :buffer (format "*%s*" process-name) - :coding 'no-conversion - :filter filter - :sentinel sentinel - :stderr stderr-buf - :noquery t - :command (lsp-resolve-final-command - `("PowerShell" "-NoProfile" "-ExecutionPolicy" "Bypass" "-Command" - ,lsp-roslyn--stdpipe-path "." - ,lsp-roslyn--pipe-name)))) - (t (make-network-process - :name process-name - :remote lsp-roslyn--pipe-name - :sentinel sentinel - :filter filter - :noquery t))))) - -(defun lsp-roslyn--connect (filter sentinel name environment-fn _workspace) - "Creates a connection to the Roslyn language server's named pipe. - -First creates an instance of the language server process, then -creates another process connecting to the named pipe it specifies." - (setq lsp-roslyn--pipe-name nil) - (let* ((parent-process-name name) - (parent-stderr-buf (format "*%s::stderr*" parent-process-name)) - (command-process (make-process - :name parent-process-name - :buffer (generate-new-buffer-name parent-process-name) - :coding 'no-conversion - :filter 'lsp-roslyn--parent-process-filter - :sentinel sentinel - :stderr parent-stderr-buf - :command `(,lsp-roslyn-dotnet-executable - ,(lsp-roslyn--get-server-dll-path) - ,(format "--logLevel=%s" lsp-roslyn-server-log-level) - ,(format "--extensionLogDirectory=%s" lsp-roslyn-server-log-directory) - ,@lsp-roslyn-server-extra-args) - :noquery t))) - (accept-process-output command-process lsp-roslyn-server-timeout-seconds) ; wait for JSON with pipe name to print on stdout, like {"pipeName":"\\\\.\\pipe\\d1b72351"} - (when (not lsp-roslyn--pipe-name) - (error "Failed to receieve pipe name from Roslyn server process")) - (let* ((process-name (generate-new-buffer-name (format "%s-pipe" name))) - (stderr-buf (format "*%s::stderr*" process-name)) - (communication-process - (lsp-roslyn--make-named-pipe-process filter sentinel environment-fn process-name stderr-buf))) - (with-current-buffer (get-buffer parent-stderr-buf) - (special-mode)) - (when-let ((stderr-buffer (get-buffer stderr-buf))) - (with-current-buffer stderr-buffer - ;; Make the *NAME::stderr* buffer buffer-read-only, q to bury, etc. - (special-mode)) - (set-process-query-on-exit-flag (get-buffer-process stderr-buffer) nil)) - (set-process-query-on-exit-flag command-process nil) - (set-process-query-on-exit-flag communication-process nil) - (cons communication-process communication-process)))) - -(defun lsp-roslyn--uri-to-path (uri) - "Convert a URI to a file path, without unhexifying." - (let* ((url (url-generic-parse-url uri)) - (type (url-type url)) - (target (url-target url)) - (file - (concat (decode-coding-string (url-filename url) - (or locale-coding-system 'utf-8)) - (when (and target - (not (s-match - (rx "#" (group (1+ num)) (or "," "#") - (group (1+ num)) - string-end) - uri))) - (concat "#" target)))) - (file-name (if (and type (not (string= type "file"))) - (if-let ((handler (lsp--get-uri-handler type))) - (funcall handler uri) - uri) - ;; `url-generic-parse-url' is buggy on windows: - ;; https://github.com/emacs-lsp/lsp-mode/pull/265 - (or (and (eq system-type 'windows-nt) - (eq (elt file 0) ?\/) - (substring file 1)) - file)))) - (->> file-name - (concat (-some #'lsp--workspace-host-root (lsp-workspaces))) - (lsp-remap-path-if-needed)))) - -(defun lsp-roslyn--path-to-uri (path) - "Convert PATH to a URI, without hexifying." - (url-unhex-string (lsp--path-to-uri-1 path))) - -(lsp-defun lsp-roslyn--log-message (_workspace params) - (let ((type (gethash "type" params)) - (mes (gethash "message" params))) - (cl-case type - (1 (lsp--error "%s" mes)) ; Error - (2 (lsp--warn "%s" mes)) ; Warning - (3 (lsp--info "%s" mes)) ; Info - (t (lsp--info "%s" mes))))) ; Log - -(lsp-defun lsp-roslyn--on-project-initialization-complete (workspace _params) - (lsp--info "%s: Project initialized successfully." - (lsp--workspace-print workspace))) - -(defun lsp-roslyn--find-files-in-parent-directories (directory regex &optional result) - "Search DIRECTORY for files matching REGEX and return their full paths if found." - (let* ((parent-dir (file-truename (concat (file-name-directory directory) "../"))) - (found (directory-files directory 't regex)) - (result (append (or result '()) found))) - (if (and (not (string= (file-truename directory) parent-dir)) - (< (length parent-dir) (length (file-truename directory)))) - (lsp-roslyn--find-files-in-parent-directories parent-dir regex result) - result))) - -(defun lsp-roslyn--pick-solution-file-interactively (solution-files) - (completing-read "Solution file for this workspace: " solution-files nil t)) - -(defun lsp-roslyn--find-solution-file () - (let ((solutions (lsp-roslyn--find-files-in-parent-directories - (file-name-directory (buffer-file-name)) - (rx (* any) ".sln" eos)))) - (cond - ((not solutions) nil) - ((eq (length solutions) 1) (cl-first solutions)) - (t (lsp-roslyn--pick-solution-file-interactively solutions))))) - -(defun lsp-roslyn-open-solution-file () - "Chooses the solution file to associate with the Roslyn language server." - (interactive) - (let ((solution-file (lsp-roslyn--find-solution-file))) - (if solution-file - (lsp-notify "solution/open" (list :solution (lsp--path-to-uri solution-file))) - (lsp--error "No solution file was found for this workspace.")))) - -(defun lsp-roslyn--on-initialized (_workspace) - "Handler for Roslyn server initialization." - (lsp-roslyn-open-solution-file)) - -(defun lsp-roslyn--get-package-name () - "Gets the package name of the Roslyn language server." - (format "microsoft.codeanalysis.languageserver.%s" (lsp-roslyn--get-rid))) - -(defun lsp-roslyn--get-server-dll-path () - "Gets the path to the language server DLL. -Assumes it was installed with the server install function." - (if lsp-roslyn-server-dll-override-path - lsp-roslyn-server-dll-override-path - (f-join lsp-roslyn-install-path "out" - (lsp-roslyn--get-package-name) - lsp-roslyn-package-version - "content" "LanguageServer" - (lsp-roslyn--get-rid) - "Microsoft.CodeAnalysis.LanguageServer.dll"))) - -(defun lsp-roslyn--get-rid () - "Retrieves the .NET Runtime Identifier (RID) for the current system." - (let* ((is-x64 (string-match-p (rx (or "x86_64" "aarch64")) system-configuration)) - (is-x86 (and (string-match-p "x86" system-configuration) (not is-x64))) - (is-arm (string-match-p (rx (or "arm" "aarch")) system-configuration))) - (if-let ((platform-name (cond - ((eq system-type 'gnu/linux) "linux") - ((eq system-type 'darwin) "osx") - ((eq system-type 'windows-nt) "win"))) - (arch-name (cond - (is-x64 "x64") - (is-x86 "x86") - (is-arm "arm64")))) - (format "%s-%s" platform-name arch-name) - (error "Unsupported platform: %s (%s)" system-type system-configuration)))) - -;; Adapted from roslyn.nvim's version -(defconst lsp-roslyn--temp-project-nuget-config - "<?xml version=\"1.0\" encoding=\"utf-8\"?> -<configuration> - <packageSources> - <add key=\"vs-impl\" value=\"https://pkgs.dev.azure.com/azure-public/vside/_packaging/vs-impl/nuget/v3/index.json\" /> - </packageSources> -</configuration>" - "The nuget.config to use when downloading Roslyn.") - -;; Adapted from roslyn.nvim's version -(defun lsp-roslyn--temp-project-csproj (pkg-name pkg-version) - "Generates a temporary .csproj to use for downloading the language server." - (format - "<Project Sdk=\"Microsoft.Build.NoTargets/1.0.80\"> - <PropertyGroup> - <!-- Changes the global packages folder --> - <RestorePackagesPath>out</RestorePackagesPath> - <!-- This is not super relevant, as long as your SDK version supports it. --> - <TargetFramework>net7.0</TargetFramework> - <!-- If a package is resolved to a fallback folder, it may not be downloaded --> - <DisableImplicitNuGetFallbackFolder>true</DisableImplicitNuGetFallbackFolder> - <!-- We don't want to build this project, so we do not need the reference assemblies for the framework we chose --> - <AutomaticallyUseReferenceAssemblyPackages>false</AutomaticallyUseReferenceAssemblyPackages> - </PropertyGroup> - <ItemGroup> - <PackageDownload Include=\"%s\" version=\"[%s]\" /> - </ItemGroup> -</Project>" - pkg-name pkg-version)) - -(defun lsp-roslyn--download-server (_client callback error-callback update?) - "Downloads the Roslyn language server to `lsp-roslyn-install-path'. -CALLBACK is called when the download finish successfully otherwise -ERROR-CALLBACK is called. -UPDATE is non-nil if it is already downloaded. -FORCED if specified with prefix argument." - - (let ((pkg-name (lsp-roslyn--get-package-name))) - (when update? - (ignore-errors (delete-directory lsp-roslyn-install-path t))) - (unless (f-exists? lsp-roslyn-install-path) - (mkdir lsp-roslyn-install-path 'create-parent)) - (f-write-text lsp-roslyn--temp-project-nuget-config - 'utf-8 (expand-file-name "nuget.config" lsp-roslyn-install-path)) - (f-write-text (lsp-roslyn--temp-project-csproj pkg-name lsp-roslyn-package-version) - 'utf-8 (expand-file-name "DownloadRoslyn.csproj" lsp-roslyn-install-path)) - (lsp-async-start-process - callback - error-callback - lsp-roslyn-dotnet-executable "restore" "--interactive" lsp-roslyn-install-path - (format "/p:PackageName=%s" pkg-name) - (format "/p:PackageVersion=%s" lsp-roslyn-package-version)))) - -(defun lsp-roslyn--make-connection () - (list :connect (lambda (f s n e w) (lsp-roslyn--connect f s n e w)) - :test? (lambda () (f-exists? (lsp-roslyn--get-server-dll-path))))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-roslyn--make-connection) - :priority 0 - :server-id 'csharp-roslyn - :activation-fn (lsp-activate-on "csharp") - :notification-handlers (ht ("window/logMessage" 'lsp-roslyn--log-message) - ("workspace/projectInitializationComplete" 'lsp-roslyn--on-project-initialization-complete)) - - ;; These two functions are the same as lsp-mode's except they do not - ;; (un)hexify URIs. - :path->uri-fn 'lsp-roslyn--path-to-uri - :uri->path-fn 'lsp-roslyn--uri-to-path - - :initialized-fn #'lsp-roslyn--on-initialized - :download-server-fn #'lsp-roslyn--download-server)) - -(provide 'lsp-roslyn) -;;; lsp-roslyn.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-roslyn.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-roslyn.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-rust.el b/emacs/elpa/lsp-mode-20241113.743/lsp-rust.el @@ -1,1809 +0,0 @@ -;;; lsp-rust.el --- Rust Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Ivan Yonchovski - -;; Author: Ivan Yonchovski <yyoncho@gmail.com> -;; Keywords: - -;; 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: - -;; lsp-rust client - -;;; Code: - -(require 'lsp-mode) -(require 'ht) -(require 'dash) -(require 'lsp-semantic-tokens) -(require 's) - -(defgroup lsp-rust nil - "LSP support for Rust, using Rust Language Server or rust-analyzer." - :group 'lsp-mode - :link '(url-link "https://github.com/rust-lang/rls") - :package-version '(lsp-mode . "6.1")) - -(defgroup lsp-rust-rls nil - "LSP support for Rust, using Rust Language Server." - :group 'lsp-mode - :link '(url-link "https://github.com/rust-lang/rls") - :package-version '(lsp-mode . "8.0.0")) - -(defgroup lsp-rust-analyzer nil - "LSP support for Rust, using rust-analyzer." - :group 'lsp-mode - :link '(url-link "https://github.com/rust-lang/rust-analyzer") - :package-version '(lsp-mode . "8.0.0")) - -(defgroup lsp-rust-analyzer-semantic-tokens nil - "LSP semantic tokens support for rust-analyzer." - :group 'lsp-rust-analyzer - :link '(url-link "https://github.com/rust-lang/rust-analyzer") - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-server 'rust-analyzer - "Choose LSP server." - :type '(choice (const :tag "rls" rls) - (const :tag "rust-analyzer" rust-analyzer)) - :group 'lsp-rust - :package-version '(lsp-mode . "6.2")) - -;; RLS - -(defcustom lsp-rust-rls-server-command '("rls") - "Command to start RLS." - :type '(repeat string) - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-library-directories - '("~/.cargo/registry/src" "~/.rustup/toolchains") - "List of directories which will be considered to be libraries." - :risky t - :type '(repeat string) - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-sysroot nil - "If non-nil, use the given path as the sysroot for all rustc invocations -instead of trying to detect the sysroot automatically." - :type '(choice - (const :tag "None" nil) - (string :tag "Sysroot")) - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-target nil - "If non-nil, use the given target triple for all rustc invocations." - :type '(choice - (const :tag "None" nil) - (string :tag "Target")) - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-rustflags nil - "Flags added to RUSTFLAGS." - :type '(choice - (const :tag "None" nil) - (string :tag "Flags")) - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-clear-env-rust-log t - "Clear the RUST_LOG environment variable before running rustc or cargo." - :type 'boolean - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-build-lib nil - "If non-nil, checks the project as if you passed the `--lib' argument to -cargo. - -Mutually exclusive with, and preferred over, `lsp-rust-build-bin'. (Unstable)" - :type 'boolean - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-build-bin nil - "If non-nil, checks the project as if you passed `-- bin <build_bin>' -argument to cargo. - -Mutually exclusive with `lsp-rust-build-lib'. (Unstable)" - :type '(choice - (const :tag "None" nil) - (string :tag "Binary")) - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-cfg-test nil - "If non-nil, checks the project as if you were running `cargo test' rather -than cargo build. - -I.e., compiles (but does not run) test code." - :type 'boolean - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-unstable-features nil - "Enable unstable features." - :type 'boolean - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-wait-to-build nil - "Time in milliseconds between receiving a change notification -and starting build. If not specified, automatically inferred by -the latest build duration." - :type '(choice - (const :tag "Auto" nil) - (number :tag "Time")) - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-show-warnings t - "Show warnings." - :type 'boolean - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-crate-blocklist [ - "cocoa" - "gleam" - "glium" - "idna" - "libc" - "openssl" - "rustc_serialize" - "serde" - "serde_json" - "typenum" - "unicode_normalization" - "unicode_segmentation" - "winapi" - ] - "A list of Cargo crates to blocklist." - :type 'lsp-string-vector - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-build-on-save nil - "Only index the project when a file is saved and not on change." - :type 'boolean - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-features [] - "List of features to activate. -Corresponds to the `rust-analyzer` setting `rust-analyzer.cargo.features`. -Set this to `\"all\"` to pass `--all-features` to cargo." - :type 'lsp-string-vector - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-all-features nil - "Enable all Cargo features." - :type 'boolean - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-no-default-features nil - "Do not enable default Cargo features." - :type 'boolean - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-racer-completion t - "Enables code completion using racer." - :type 'boolean - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-clippy-preference "opt-in" - "Controls eagerness of clippy diagnostics when available. -Valid values are (case-insensitive): - - \"off\": Disable clippy lints. - - \"opt-in\": Clippy lints are shown when crates specify `#![warn(clippy)]'. - - \"on\": Clippy lints enabled for all crates in workspace. - -You need to install clippy via rustup if you haven't already." - :type '(choice - (const "on") - (const "opt-in") - (const "off")) - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-jobs nil - "Number of Cargo jobs to be run in parallel." - :type '(choice - (const :tag "Auto" nil) - (number :tag "Jobs")) - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-all-targets t - "Checks the project as if you were running cargo check --all-targets. -I.e., check all targets and integration tests too." - :type 'boolean - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-target-dir nil - "When specified, it places the generated analysis files at the -specified target directory. By default it is placed target/rls -directory." - :type '(choice - (const :tag "Default" nil) - (string :tag "Directory")) - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-rustfmt-path nil - "When specified, RLS will use the Rustfmt pointed at the path -instead of the bundled one" - :type '(choice - (const :tag "Bundled" nil) - (string :tag "Path")) - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-build-command nil - "EXPERIMENTAL (requires `rust.unstable_features') -If set, executes a given program responsible for rebuilding save-analysis to be -loaded by the RLS. The program given should output a list of resulting .json -files on stdout. - -Implies `rust.build_on_save': true." - :type '(choice - (const :tag "None" nil) - (string :tag "Command")) - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-full-docs nil - "Instructs cargo to enable full documentation extraction during -save-analysis while building the crate." - :type 'boolean - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-rust-show-hover-context t - "Show additional context in hover tooltips when available. This -is often the type local variable declaration." - :type 'boolean - :group 'lsp-rust-rls - :package-version '(lsp-mode . "6.1")) - -(lsp-register-custom-settings - '(("rust.show_hover_context" lsp-rust-show-hover-context t) - ("rust.full_docs" lsp-rust-full-docs t) - ("rust.build_command" lsp-rust-build-command) - ("rust.rustfmt_path" lsp-rust-rustfmt-path) - ("rust.target_dir" lsp-rust-target-dir) - ("rust.all_targets" lsp-rust-all-targets t) - ("rust.jobs" lsp-rust-jobs) - ("rust.clippy_preference" lsp-rust-clippy-preference) - ("rust.racer_completion" lsp-rust-racer-completion t) - ("rust.no_default_features" lsp-rust-no-default-features t) - ("rust.all_features" lsp-rust-all-features t) - ("rust.features" lsp-rust-features) - ("rust.build_on_save" lsp-rust-build-on-save t) - ("rust.crate_blocklist" lsp-rust-crate-blocklist) - ("rust.show_warnings" lsp-rust-show-warnings t) - ("rust.wait_to_build" lsp-rust-wait-to-build) - ("rust.unstable_features" lsp-rust-unstable-features t) - ("rust.cfg_test" lsp-rust-cfg-test t) - ("rust.build_bin" lsp-rust-build-bin) - ("rust.build_lib" lsp-rust-build-lib t) - ("rust.clear_env_rust_log" lsp-rust-clear-env-rust-log t) - ("rust.rustflags" lsp-rust-rustflags) - ("rust.target" lsp-rust-target) - ("rust.sysroot" lsp-rust-sysroot))) - -(defun lsp-clients--rust-window-progress (workspace params) - "Progress report handling. -PARAMS progress report notification data." - (-let [(&v1:ProgressParams :done? :message? :title) params] - (if (or done? (s-blank-str? message?)) - (lsp-workspace-status nil workspace) - (lsp-workspace-status (format "%s - %s" title (or message? "")) workspace)))) - -(lsp-defun lsp-rust--rls-run ((&Command :arguments? params)) - (-let* (((&rls:Cmd :env :binary :args :cwd) (lsp-seq-first params)) - (default-directory (or cwd (lsp-workspace-root) default-directory) )) - (compile - (format "%s %s %s" - (s-join " " (ht-amap (format "%s=%s" key value) env)) - binary - (s-join " " args))))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection (lambda () lsp-rust-rls-server-command)) - :activation-fn (lsp-activate-on "rust") - :priority (if (eq lsp-rust-server 'rls) 1 -1) - :initialization-options '((omitInitBuild . t) - (cmdRun . t)) - :notification-handlers (ht ("window/progress" 'lsp-clients--rust-window-progress)) - :action-handlers (ht ("rls.run" 'lsp-rust--rls-run)) - :library-folders-fn (lambda (_workspace) lsp-rust-library-directories) - :initialized-fn (lambda (workspace) - (with-lsp-workspace workspace - (lsp--set-configuration - (lsp-configuration-section "rust")))) - :server-id 'rls)) - - -;; rust-analyzer -(defcustom lsp-rust-analyzer-server-command '("rust-analyzer") - "Command to start rust-analyzer." - :type '(repeat string) - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-rust-analyzer-library-directories - '("~/.cargo/registry/src" "~/.rustup/toolchains") - "List of directories which will be considered to be libraries." - :risky t - :type '(repeat string) - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-server-format-inlay-hints t - "Whether to ask rust-analyzer to format inlay hints itself. If -active, the various inlay format settings are not used." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-hide-closure-initialization nil - "Whether to hide inlay type hints for `let` statements that initialize -to a closure. Only applies to closures with blocks, same as -`#rust-analyzer.inlayHints.closureReturnTypeHints.enable#`." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-highlight-breakpoints t - "Enables highlighting of related references while the cursor is on -`break`, `loop`, `while`, or `for` keywords." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-highlight-closure-captures t - "Enables highlighting of all captures of a closure while the -cursor is on the `|` or move keyword of a closure." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-highlight-exit-points t - "Enables highlighting of all exit points while the cursor is on -any `return`, `?`, `fn`, or return type arrow (`->`)." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-highlight-references t - "Enables highlighting of related references while the cursor is on -any identifier." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-highlight-yield-points t - "Enables highlighting of all break points for a loop or block -context while the cursor is on any `async` or `await` keywords." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-closure-return-type-hints "never" - "Whether to show inlay type hints for return types of closures." - :type '(choice - (const "never") - (const "always") - (const "with_block")) - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-discriminants-hints "never" - "Whether to show enum variant discriminant hints." - :type '(choice - (const "never") - (const "always") - (const "fieldless")) - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-expression-adjustment-hints "never" - "Whether to show inlay hints for type adjustments.." - :type '(choice - (const "never") - (const "always") - (const "reborrow")) - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-expression-adjustment-hints-mode "prefix" - "Whether to show inlay hints as postfix ops (`.*` instead of `*`, etc)." - :type '(choice - (const "prefix") - (const "postfix") - (const "prefer_prefix") - (const "prefer_postfix")) - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-expression-adjustment-hide-unsafe nil - "Whether to hide inlay hints for type adjustments outside of -`unsafe` blocks." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-implicit-drops nil - "Whether to show implicit drop hints." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - - -(defcustom lsp-rust-analyzer-closure-capture-hints nil - "Whether to show inlay hints for closure captures." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-closure-style "impl_fn" - "Closure notation in type and chaining inlay hints." - :type 'string - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-hide-named-constructor nil - "Whether to hide inlay type hints for constructors." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-max-inlay-hint-length nil - "Max inlay hint length." - :type 'integer - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.2.2")) - -(defcustom lsp-rust-analyzer-display-chaining-hints nil - "Whether to show inlay type hints for method chains. These -hints will be formatted with the type hint formatting options, if -the mode is not configured to ask the server to format them." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.2.2")) - -(defcustom lsp-rust-analyzer-display-lifetime-elision-hints-enable "never" - "Whether to show elided lifetime inlay hints." - :type '(choice - (const "never") - (const "always") - (const "skip_trivial")) - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-display-lifetime-elision-hints-use-parameter-names nil - "When showing elided lifetime inlay hints, whether to use -parameter names or numeric placeholder names for the lifetimes." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-display-closure-return-type-hints nil - "Whether to show closure return type inlay hints for closures -with block bodies." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-display-parameter-hints nil - "Whether to show function parameter name inlay hints at the call site." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.2.2")) - -(defcustom lsp-rust-analyzer-display-reborrow-hints "never" - "Whether to show inlay type hints for compiler inserted reborrows." - :type '(choice - (const "always") - (const "never") - (const "mutable")) - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-binding-mode-hints nil - "Whether to show inlay type hints for binding modes." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-closing-brace-hints t - "Whether to show inlay hints after a closing `}` to indicate what item it -belongs to." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-closing-brace-hints-min-lines 25 - "Minimum number of lines required before the `}` until the hint is shown -\(set to 0 or 1 to always show them)." - :type 'integer - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-lru-capacity nil - "Number of syntax trees rust-analyzer keeps in memory." - :type 'integer - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.2.2")) - -(defcustom lsp-rust-analyzer-cargo-target nil - "Compilation target (target triple)." - :type '(choice - (string :tag "Target") - (const :tag "None" nil)) - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-cargo-watch-enable t - "Enable Cargo watch." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.2.2")) - -(defcustom lsp-rust-analyzer-cargo-watch-command "check" - "Cargo watch command." - :type 'string - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.2.2")) - -(defcustom lsp-rust-analyzer-cargo-watch-args [] - "Extra arguments for `cargo check`." - :type 'lsp-string-vector - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.2.2")) - -(defcustom lsp-rust-analyzer-cargo-override-command [] - "Advanced option, fully override the command rust-analyzer uses for checking. -The command should include `--message=format=json` or similar option." - :type 'lsp-string-vector - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.2.2")) - -(defcustom lsp-rust-analyzer-check-all-targets t - "Enables --all-targets for `cargo check`." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.2")) - -(defcustom lsp-rust-analyzer-checkonsave-features nil - "List of features to activate. -Corresponds to the `rust-analyzer` setting `rust-analyzer.check.features`. -When set to `nil` (default), the value of `lsp-rust-features' is inherited. -Set this to `\"all\"` to pass `--all-features` to cargo. -Note: setting this to `nil` means \"unset\", whereas setting this -to `[]` (empty vector) means \"set to empty list of features\", -which overrides any value that would otherwise be inherited from -`lsp-rust-features'." - :type 'lsp-string-vector - :group 'lsp-rust-rust-analyzer - :package-version '(lsp-mode . "8.0.2")) - -(defcustom lsp-rust-analyzer-cargo-unset-test [] - "force rust-analyzer to unset `#[cfg(test)]` for the specified crates." - :type 'lsp-string-vector - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-use-client-watching t - "Use client watching" - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.2.2")) - -(defcustom lsp-rust-analyzer-exclude-globs [] - "Exclude globs" - :type 'lsp-string-vector - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.2.2")) - -(defcustom lsp-rust-analyzer-exclude-dirs [] - "These directories will be ignored by rust-analyzer." - :type 'lsp-string-vector - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-macro-expansion-method 'lsp-rust-analyzer-macro-expansion-default - "Use a different function if you want formatted macro expansion results and -syntax highlighting." - :type 'function - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.2.2")) - -(defcustom lsp-rust-analyzer-diagnostics-enable t - "Whether to show native rust-analyzer diagnostics." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.3.2")) - -(defcustom lsp-rust-analyzer-diagnostics-enable-experimental nil - "Whether to show native rust-analyzer diagnostics that are still experimental -\(might have more false positives than usual)." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-diagnostics-disabled [] - "List of native rust-analyzer diagnostics to disable." - :type 'lsp-string-vector - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-diagnostics-warnings-as-hint [] - "List of warnings that should be displayed with hint severity." - :type 'lsp-string-vector - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-diagnostics-warnings-as-info [] - "List of warnings that should be displayed with info severity." - :type 'lsp-string-vector - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(define-obsolete-variable-alias - 'lsp-rust-analyzer-cargo-load-out-dirs-from-check - 'lsp-rust-analyzer-cargo-run-build-scripts - "8.0.0") - -(defcustom lsp-rust-analyzer-cargo-run-build-scripts t - "Whether to run build scripts (`build.rs`) for more precise code analysis." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-rustfmt-extra-args [] - "Additional arguments to rustfmt." - :type 'lsp-string-vector - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.3.2")) - -(defcustom lsp-rust-analyzer-rustfmt-override-command [] - "Advanced option, fully override the command rust-analyzer uses -for formatting." - :type 'lsp-string-vector - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.3.2")) - -(defcustom lsp-rust-analyzer-rustfmt-rangeformatting-enable nil - "Enables the use of rustfmt's unstable range formatting command for the -`textDocument/rangeFormatting` request. The rustfmt option is unstable and only -available on a nightly build." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-completion-add-call-parenthesis t - "Whether to add parenthesis when completing functions." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.3.2")) - -(defcustom lsp-rust-analyzer-completion-add-call-argument-snippets t - "Whether to add argument snippets when completing functions." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.3.2")) - -(defcustom lsp-rust-analyzer-completion-postfix-enable t - "Whether to show postfix snippets like `dbg`, `if`, `not`, etc." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.3.2")) - -(defcustom lsp-rust-analyzer-call-info-full t - "Whether to show function name and docs in parameter hints." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.3.2")) - -(defcustom lsp-rust-analyzer-proc-macro-enable t - "Enable Proc macro support. -Implies `lsp-rust-analyzer-cargo-run-build-scripts'" - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.3.2")) - -(defcustom lsp-rust-analyzer-import-prefix "plain" - "The path structure for newly inserted paths to use. -Valid values are: - - \"plain\": Insert import paths relative to the current module, using up to -one `super' prefix if the parent module contains the requested item. - - \"by_self\": Prefix all import paths with `self' if they don't begin with -`self', `super', `crate' or a crate name. - - \"by_crate\": Force import paths to be absolute by always starting -them with `crate' or the crate name they refer to." - :type '(choice - (const "plain") - (const "by_self") - (const "by_crate")) - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-import-granularity "crate" - "How imports should be grouped into use statements." - :type '(choice - (const "crate" :doc "Merge imports from the same crate into a single use statement. This kind of nesting is only supported in Rust versions later than 1.24.") - (const "module" :doc "Merge imports from the same module into a single use statement.") - (const "item" :doc "Don’t merge imports at all, creating one import per item.") - (const "preserve" :doc "Do not change the granularity of any imports. For auto-import this has the same effect as `\"item\"'")) - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-cargo-auto-reload t - "Automatically refresh project info via `cargo metadata' on `Cargo.toml' changes." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-use-rustc-wrapper-for-build-scripts t - "Use `RUSTC_WRAPPER=rust-analyzer' when running build scripts to avoid -compiling unnecessary things." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-completion-auto-import-enable t - "Toggles the additional completions that automatically add imports when -completed. `lsp-completion-enable-additional-text-edit' must be non-nil - for this feature to be fully enabled." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-completion-auto-self-enable t - "Toggles the additional completions that automatically show method calls -and field accesses with self prefixed to them when inside a method." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-import-enforce-granularity nil - "Whether to enforce the import granularity setting for all files. - If set to nil rust-analyzer will try to keep import styles consistent per file." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-imports-merge-glob t - "Whether to allow import insertion to merge new imports into single path -glob imports like `use std::fmt::*;`." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-import-group t - "Group inserted imports by the following order: -https://rust-analyzer.github.io/manual.html#auto-import. - Groups are separated by newlines." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-highlighting-strings t - "Use semantic tokens for strings." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-rustc-source nil - "Path to the Cargo.toml of the rust compiler workspace." - :type '(choice - (file :tag "Path") - (const :tag "None" nil)) - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-linked-projects [] - "Disable project auto-discovery in favor of explicitly specified set of -projects. Elements must be paths pointing to `Cargo.toml`, `rust-project.json`, -or JSON objects in `rust-project.json` format." - :type 'lsp-string-vector - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-experimental-proc-attr-macros t - "Whether to enable experimental support for expanding proc macro attributes." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-cargo-extra-args [] - "Extra arguments that are passed to every cargo invocation." - :type 'lsp-string-vector - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-cargo-extra-env [] - "Extra environment variables that will be set when running cargo, rustc or -other commands within the workspace. Useful for setting RUSTFLAGS." - :type 'lsp-string-vector - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "9.0.0")) - -(defconst lsp-rust-notification-handlers - '(("rust-analyzer/publishDecorations" . (lambda (_w _p))))) - -(defconst lsp-rust-action-handlers - '()) - -(define-derived-mode lsp-rust-analyzer-syntax-tree-mode special-mode "Rust-Analyzer-Syntax-Tree" - "Mode for the rust-analyzer syntax tree buffer.") - -(defun lsp-rust-analyzer-syntax-tree () - "Display syntax tree for current buffer." - (interactive) - (-let* ((root (lsp-workspace-root default-directory)) - (params (lsp-make-rust-analyzer-syntax-tree-params - :text-document (lsp--text-document-identifier) - :range? (if (use-region-p) - (lsp--region-to-range (region-beginning) (region-end)) - (lsp--region-to-range (point-min) (point-max))))) - (results (lsp-send-request (lsp-make-request - "rust-analyzer/syntaxTree" - params)))) - (let ((buf (get-buffer-create (format "*rust-analyzer syntax tree %s*" root))) - (inhibit-read-only t)) - (with-current-buffer buf - (lsp-rust-analyzer-syntax-tree-mode) - (erase-buffer) - (insert results) - (goto-char (point-min))) - (pop-to-buffer buf)))) - -(define-derived-mode lsp-rust-analyzer-status-mode special-mode "Rust-Analyzer-Status" - "Mode for the rust-analyzer status buffer.") - -(defun lsp-rust-analyzer-status () - "Displays status information for rust-analyzer." - (interactive) - (-let* ((root (lsp-workspace-root default-directory)) - (params (lsp-make-rust-analyzer-analyzer-status-params - :text-document (lsp--text-document-identifier))) - (results (lsp-send-request (lsp-make-request - "rust-analyzer/analyzerStatus" - params)))) - (let ((buf (get-buffer-create (format "*rust-analyzer status %s*" root))) - (inhibit-read-only t)) - (with-current-buffer buf - (lsp-rust-analyzer-status-mode) - (erase-buffer) - (insert results) - (pop-to-buffer buf))))) - -(defun lsp-rust-analyzer-view-item-tree () - "Show item tree of rust file." - (interactive) - (-let* ((params (lsp-make-rust-analyzer-view-item-tree - :text-document (lsp--text-document-identifier))) - (results (lsp-send-request (lsp-make-request - "rust-analyzer/viewItemTree" - params)))) - (let ((buf (get-buffer-create "*rust-analyzer item tree*")) - (inhibit-read-only t)) - (with-current-buffer buf - (special-mode) - (erase-buffer) - (insert (lsp--render-string results "rust")) - (pop-to-buffer buf))))) - -(defun lsp-rust-analyzer-view-hir () - "View Hir of function at point." - (interactive) - (-let* ((params (lsp-make-rust-analyzer-expand-macro-params - :text-document (lsp--text-document-identifier) - :position (lsp--cur-position))) - (results (lsp-send-request (lsp-make-request - "rust-analyzer/viewHir" - params)))) - (let ((buf (get-buffer-create "*rust-analyzer hir*")) - (inhibit-read-only t)) - (with-current-buffer buf - (special-mode) - (erase-buffer) - (insert results) - (pop-to-buffer buf))))) - -(defun lsp-rust-analyzer-join-lines () - "Join selected lines into one, smartly fixing up whitespace and trailing commas." - (interactive) - (let* ((params (lsp-make-rust-analyzer-join-lines-params - :text-document (lsp--text-document-identifier) - :ranges (vector (if (use-region-p) - (lsp--region-to-range (region-beginning) (region-end)) - (lsp--region-to-range (point) (point)))))) - (result (lsp-send-request (lsp-make-request "experimental/joinLines" params)))) - (lsp--apply-text-edits result 'code-action))) - -(defun lsp-rust-analyzer-reload-workspace () - "Reload workspace, picking up changes from Cargo.toml" - (interactive) - (lsp--cur-workspace-check) - (lsp-send-request (lsp-make-request "rust-analyzer/reloadWorkspace"))) - -(defcustom lsp-rust-analyzer-download-url - (let* ((x86 (string-prefix-p "x86_64" system-configuration)) - (arch (if x86 "x86_64" "aarch64"))) - (format "https://github.com/rust-lang/rust-analyzer/releases/latest/download/%s" - (pcase system-type - ('gnu/linux (format "rust-analyzer-%s-unknown-linux-gnu.gz" arch)) - ('darwin (format "rust-analyzer-%s-apple-darwin.gz" arch)) - ('windows-nt (format "rust-analyzer-%s-pc-windows-msvc.zip" arch))))) - "Automatic download url for Rust Analyzer" - :type 'string - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-store-path (f-join lsp-server-install-dir "rust" - (pcase system-type - ('windows-nt "rust-analyzer.exe") - (_ "rust-analyzer"))) - "The path to the file in which `rust-analyzer' will be stored." - :type 'file - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(lsp-dependency - 'rust-analyzer - `(:download :url lsp-rust-analyzer-download-url - :decompress ,(pcase system-type ('windows-nt :zip) (_ :gzip)) - :store-path lsp-rust-analyzer-store-path - :set-executable? t) - `(:system ,(file-name-nondirectory lsp-rust-analyzer-store-path))) - -(lsp-defun lsp-rust--analyzer-run-single ((&Command :arguments?)) - (lsp-rust-analyzer-run (lsp-seq-first arguments?))) - -(lsp-defun lsp-rust--analyzer-show-references - ((&Command :title :arguments? [_uri _filepos references])) - (lsp-show-xrefs (lsp--locations-to-xref-items references) nil - (s-contains-p "reference" title))) - -(declare-function dap-debug "ext:dap-mode" (template) t) - -(lsp-defun lsp-rust--analyzer-debug-lens ((&Command :arguments? [args])) - (lsp-rust-analyzer-debug args)) - -;; Semantic tokens - -;; Modifier faces -(defface lsp-rust-analyzer-documentation-modifier-face - '((t nil)) - "The face modification to use for documentation items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-declaration-modifier-face - '((t nil)) - "The face modification to use for declaration items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-definition-modifier-face - '((t nil)) - "The face modification to use for definition items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-static-modifier-face - '((t nil)) - "The face modification to use for static items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-abstract-modifier-face - '((t nil)) - "The face modification to use for abstract items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-deprecated-modifier-face - '((t nil)) - "The face modification to use for deprecated items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-readonly-modifier-face - '((t nil)) - "The face modification to use for readonly items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-default-library-modifier-face - '((t nil)) - "The face modification to use for default-library items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-async-modifier-face - '((t nil)) - "The face modification to use for async items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-attribute-modifier-face - '((t nil)) - "The face modification to use for attribute items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-callable-modifier-face - '((t nil)) - "The face modification to use for callable items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-constant-modifier-face - '((t nil)) - "The face modification to use for constant items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-consuming-modifier-face - '((t nil)) - "The face modification to use for consuming items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-control-flow-modifier-face - '((t nil)) - "The face modification to use for control-flow items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-crate-root-modifier-face - '((t nil)) - "The face modification to use for crate-root items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-injected-modifier-face - '((t nil)) - "The face modification to use for injected items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-intra-doc-link-modifier-face - '((t nil)) - "The face modification to use for intra-doc-link items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-library-modifier-face - '((t nil)) - "The face modification to use for library items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-mutable-modifier-face - '((t :underline t)) - "The face modification to use for mutable items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-public-modifier-face - '((t nil)) - "The face modification to use for public items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-reference-modifier-face - '((t :bold t)) - "The face modification to use for reference items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-trait-modifier-face - '((t nil)) - "The face modification to use for trait items." - :group 'lsp-rust-analyzer-semantic-tokens) - -(defface lsp-rust-analyzer-unsafe-modifier-face - '((t nil)) - "The face modification to use for unsafe items." - :group 'lsp-rust-analyzer-semantic-tokens) - - -;; --------------------------------------------------------------------- -;; Semantic token modifier face customization - -(defcustom lsp-rust-analyzer-documentation-modifier 'lsp-rust-analyzer-documentation-modifier-face - "Face for semantic token modifier for `documentation' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-declaration-modifier 'lsp-rust-analyzer-declaration-modifier-face - "Face for semantic token modifier for `declaration' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-definition-modifier 'lsp-rust-analyzer-definition-modifier-face - "Face for semantic token modifier for `definition' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-static-modifier 'lsp-rust-analyzer-static-modifier-face - "Face for semantic token modifier for `static' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-abstract-modifier 'lsp-rust-analyzer-abstract-modifier-face - "Face for semantic token modifier for `abstract' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-deprecated-modifier 'lsp-rust-analyzer-deprecated-modifier-face - "Face for semantic token modifier for `deprecated' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-readonly-modifier 'lsp-rust-analyzer-readonly-modifier-face - "Face for semantic token modifier for `readonly' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-default-library-modifier 'lsp-rust-analyzer-default-library-modifier-face - "Face for semantic token modifier for `default' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-async-modifier 'lsp-rust-analyzer-async-modifier-face - "Face for semantic token modifier for `async' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-attribute-modifier 'lsp-rust-analyzer-attribute-modifier-face - "Face for semantic token modifier for `attribute' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-callable-modifier 'lsp-rust-analyzer-callable-modifier-face - "Face for semantic token modifier for `callable' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-constant-modifier 'lsp-rust-analyzer-constant-modifier-face - "Face for semantic token modifier for `constant' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-consuming-modifier 'lsp-rust-analyzer-consuming-modifier-face - "Face for semantic token modifier for `consuming' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-control-flow-modifier 'lsp-rust-analyzer-control-flow-modifier-face - "Face for semantic token modifier for `control_flow' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-crate-root-modifier 'lsp-rust-analyzer-crate-root-modifier-face - "Face for semantic token modifier for `crate_root' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-injected-modifier 'lsp-rust-analyzer-injected-modifier-face - "Face for semantic token modifier for `injected' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-intra-doc-link-modifier 'lsp-rust-analyzer-intra-doc-link-modifier-face - "Face for semantic token modifier for `intra_doc_link' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-library-modifier 'lsp-rust-analyzer-library-modifier-face - "Face for semantic token modifier for `library' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-mutable-modifier 'lsp-rust-analyzer-mutable-modifier-face - "Face for semantic token modifier for `mutable' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-public-modifier 'lsp-rust-analyzer-public-modifier-face - "Face for semantic token modifier for `public' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-reference-modifier 'lsp-rust-analyzer-reference-modifier-face - "Face for semantic token modifier for `reference' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-trait-modifier 'lsp-rust-analyzer-trait-modifier-face - "Face for semantic token modifier for `trait' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-unsafe-modifier 'lsp-rust-analyzer-unsafe-modifier-face - "Face for semantic token modifier for `unsafe' attribute." - :type 'face - :group 'lsp-rust-analyzer-semantic-tokens - :package-version '(lsp-mode . "9.0.0")) - -;; --------------------------------------------------------------------- - -(defun lsp-rust-analyzer--semantic-modifiers () - "Mapping between rust-analyzer keywords and fonts to apply. -The keywords are sent in the initialize response, in the semantic -tokens legend." - `(("documentation" . ,lsp-rust-analyzer-documentation-modifier) - ("declaration" . ,lsp-rust-analyzer-declaration-modifier) - ("definition" . ,lsp-rust-analyzer-definition-modifier) - ("static" . ,lsp-rust-analyzer-static-modifier) - ("abstract" . ,lsp-rust-analyzer-abstract-modifier) - ("deprecated" . ,lsp-rust-analyzer-deprecated-modifier) - ("readonly" . ,lsp-rust-analyzer-readonly-modifier) - ("default_library" . ,lsp-rust-analyzer-default-library-modifier) - ("async" . ,lsp-rust-analyzer-async-modifier) - ("attribute" . ,lsp-rust-analyzer-attribute-modifier) - ("callable" . ,lsp-rust-analyzer-callable-modifier) - ("constant" . ,lsp-rust-analyzer-constant-modifier) - ("consuming" . ,lsp-rust-analyzer-consuming-modifier) - ("control_flow" . ,lsp-rust-analyzer-control-flow-modifier) - ("crate_root" . ,lsp-rust-analyzer-crate-root-modifier) - ("injected" . ,lsp-rust-analyzer-injected-modifier) - ("intra_doc_link" . ,lsp-rust-analyzer-intra-doc-link-modifier) - ("library" . ,lsp-rust-analyzer-library-modifier) - ("mutable" . ,lsp-rust-analyzer-mutable-modifier) - ("public" . ,lsp-rust-analyzer-public-modifier) - ("reference" . ,lsp-rust-analyzer-reference-modifier) - ("trait" . ,lsp-rust-analyzer-trait-modifier) - ("unsafe" . ,lsp-rust-analyzer-unsafe-modifier))) - -(defun lsp-rust-switch-server (&optional lsp-server) - "Switch priorities of lsp servers, unless LSP-SERVER is already active." - (interactive) - (let ((current-server (if (> (lsp--client-priority (gethash 'rls lsp-clients)) 0) - 'rls - 'rust-analyzer))) - (unless (eq lsp-server current-server) - (dolist (server '(rls rust-analyzer)) - (when (natnump (setf (lsp--client-priority (gethash server lsp-clients)) - (* (lsp--client-priority (gethash server lsp-clients)) -1))) - (message (format "Switched to server %s." server))))))) - -;; -;;; Inlay hints - -(defcustom lsp-rust-analyzer-debug-lens-extra-dap-args - '(:MIMode "gdb" :miDebuggerPath "gdb" :stopAtEntry t :externalConsole :json-false) - "Extra arguments to pass to DAP template when debugging a test from code lens. - -As a rule of the thumb, do not add extra keys to this plist unless you exactly -what you are doing, it might break the \"Debug test\" lens otherwise. - -See dap-mode documentation and cpptools documentation for the extra variables -meaning." - :type 'plist - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -;; -;;; Lenses - -(defgroup lsp-rust-analyzer-lens nil - "LSP lens support for Rust when using rust-analyzer. - -Lenses are (depending on your configuration) clickable links to -the right of function definitions and the like. These display -some useful information in their own right and/or perform a -shortcut action when clicked such as displaying uses of that -function or running an individual test. -" - :prefix "lsp-rust-analyzer-lens-" - :group 'lsp-rust-analyzer - :link '(url-link "https://emacs-lsp.github.io/lsp-mode/") - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-lens-debug-enable t - "Enable or disable the Debug lens." - :type 'boolean - :group 'lsp-rust-analyzer-lens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-lens-enable t - "Master-enable of lenses in Rust files." - :type 'boolean - :group 'lsp-rust-analyzer-lens - :package-version '(lsp-mode . "9.0.0")) - -;; This customisation "works" in that it works as described, but the default is fine and changing it -;; from the default will either stop lenses working or do nothing. -;; -;; If this is ever uncommented to re-enable the option, don't forget to also uncomment it in defun -;; lsp-rust-analyzer--make-init-options too or it'll not do anything. - -;; (defcustom lsp-rust-analyzer-lens-force-custom-commands t -;; "Internal config: use custom client-side commands even when the -;; client doesn't set the corresponding capability." -;; :type 'boolean -;; :group 'lsp-rust-analyzer-lens -;; :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-lens-implementations-enable t - "Enable or disable the Implementations lens. - -The Implementations lens shows `NN implementations' to the right -of the first line of an enum, struct, or union declaration. This -is the count of impl blocks, including derived traits. Clicking -on it gives a list of the impls of that type. -" - :type 'boolean - :group 'lsp-rust-analyzer-lens - :package-version '(lsp-mode . "9.0.0")) - -;; The valid range of values for this is documented in the rust-lang/rust-analyzer repository at the -;; path "editors/code/package.json"; the TL:DR is that it's "above_name" or "above_whole_item". -;; However, setting it to "above_whole_item" causes lenses to disappear in Emacs. I suspect this -;; feature has only ever been tested in some other IDE and it's broken in Emacs. So I've disabled it -;; for now. -;; -;; If this is ever uncommented to re-enable the option, don't forget to also uncomment it in defun -;; lsp-rust-analyzer--make-init-options too or it'll not do anything. - -;; (defcustom lsp-rust-analyzer-lens-location "above_name" -;; "Where to render annotations." -;; :type '(choice -;; (const :tag "Above name" "above_name") -;; (const :tag "Above whole item" "above_whole_item") -;; :group 'lsp-rust-analyzer-lens -;; :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-lens-references-adt-enable nil - "Enable or disable the References lens on enums, structs, and traits. - -The References lens shows `NN references` to the right of the -first line of each enum, struct, or union declaration. This is -the count of uses of that type. Clicking on it gives a list of -where that type is used." - :type 'boolean - :group 'lsp-rust-analyzer-lens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-lens-references-enum-variant-enable nil - "Enable or disable the References lens on enum variants. - -The References lens shows `NN references` to the right of the -first (or only) line of each enum variant. This is the count of -uses of that enum variant. Clicking on it gives a list of where -that enum variant is used." - :type 'boolean - :group 'lsp-rust-analyzer-lens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-lens-references-method-enable nil - "Enable or disable the References lens on functions. - -The References lens shows `NN references` to the right of the -first line of each function declaration. This is the count of -uses of that function. Clicking on it gives a list of where that -function is used." - - :type 'boolean - :group 'lsp-rust-analyzer-lens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-lens-references-trait-enable nil - "Enable or disable the References lens on traits. - -The References lens shows `NN references` to the right of the -first line of each trait declaration. This is a count of uses of -that trait. Clicking on it gives a list of where that trait is -used. - -There is some overlap with the Implementations lens which slows -all of the trait's impl blocks, but this also shows other uses -such as imports and dyn traits." - :type 'boolean - :group 'lsp-rust-analyzer-lens - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-rust-analyzer-lens-run-enable t - "Enable or disable the Run lens." - :type 'boolean - :group 'lsp-rust-analyzer-lens - :package-version '(lsp-mode . "9.0.0")) - -(defun lsp-rust-analyzer-initialized? () - (when-let ((workspace (lsp-find-workspace 'rust-analyzer (buffer-file-name)))) - (eq 'initialized (lsp--workspace-status workspace)))) - -(defun lsp-rust-analyzer-expand-macro () - "Expands the macro call at point recursively." - (interactive) - (-if-let* ((params (lsp-make-rust-analyzer-expand-macro-params - :text-document (lsp--text-document-identifier) - :position (lsp--cur-position))) - (response (lsp-request - "rust-analyzer/expandMacro" - params)) - ((&rust-analyzer:ExpandedMacro :expansion) response)) - (funcall lsp-rust-analyzer-macro-expansion-method expansion) - (lsp--error "No macro found at point, or it could not be expanded."))) - -(defun lsp-rust-analyzer-macro-expansion-default (result) - "Default method for displaying macro expansion." - (let* ((root (lsp-workspace-root default-directory)) - (buf (get-buffer-create (get-buffer-create (format "*rust-analyzer macro expansion %s*" root))))) - (with-current-buffer buf - (let ((inhibit-read-only t)) - (erase-buffer) - (insert (lsp--render-string result "rust")) - (special-mode))) - (pop-to-buffer buf))) - -;; -;;; Runnables - -(defvar lsp-rust-analyzer--last-runnable nil - "Record the last runnable.") - -(defun lsp-rust-analyzer--runnables () - "Return list of runnables." - (lsp-send-request (lsp-make-request - "experimental/runnables" - (lsp-make-rust-analyzer-runnables-params - :text-document (lsp--text-document-identifier) - :position? (lsp--cur-position))))) - -(defun lsp-rust-analyzer--select-runnable () - "Select runnable." - (lsp--completing-read - "Select runnable:" - (if lsp-rust-analyzer--last-runnable - (cons lsp-rust-analyzer--last-runnable - (-remove (-lambda ((&rust-analyzer:Runnable :label)) - (equal label (lsp-get lsp-rust-analyzer--last-runnable :label))) - (lsp-rust-analyzer--runnables))) - (lsp-rust-analyzer--runnables)) - (-lambda ((&rust-analyzer:Runnable :label)) label))) - -(defun lsp-rust-analyzer--common-runner (runnable) - "Execute a given RUNNABLE. - -Extract the arguments, prepare the minor mode (cargo-process-mode if possible) -and run a compilation" - (-let* (((&rust-analyzer:Runnable :kind :label :args) runnable) - ((&rust-analyzer:RunnableArgs :cargo-args :executable-args :workspace-root? :expect-test?) args) - (default-directory (or workspace-root? default-directory))) - (if (not (string-equal kind "cargo")) - (lsp--error "'%s' runnable is not supported" kind) - (compilation-start - (string-join (append (when expect-test? '("env" "UPDATE_EXPECT=1")) - (list "cargo") cargo-args - (when executable-args '("--")) executable-args '()) " ") - - ;; cargo-process-mode is nice, but try to work without it... - (if (functionp 'cargo-process-mode) 'cargo-process-mode nil) - (lambda (_) (concat "*" label "*")))))) - -(defun lsp-rust-analyzer-run (runnable) - "Select and run a RUNNABLE action." - (interactive (list (lsp-rust-analyzer--select-runnable))) - (when (lsp-rust-analyzer--common-runner runnable) - (setq lsp-rust-analyzer--last-runnable runnable))) - -(defun lsp-rust-analyzer-debug (runnable) - "Select and debug a RUNNABLE action." - (interactive (list (lsp-rust-analyzer--select-runnable))) - (unless (or (featurep 'dap-cpptools) (featurep 'dap-gdb)) - (user-error "You must require `dap-cpptools' or 'dap-gdb'")) - (-let (((&rust-analyzer:Runnable - :args (&rust-analyzer:RunnableArgs :cargo-args :workspace-root? :executable-args) - :label) runnable)) - (pcase (aref cargo-args 0) - ("run" (aset cargo-args 0 "build")) - ("test" (when (-contains? (append cargo-args ()) "--no-run") - (cl-callf append cargo-args (list "--no-run"))))) - (->> (append (list (executable-find "cargo")) - cargo-args - (list "--message-format=json")) - (s-join " ") - (shell-command-to-string) - (s-lines) - (-keep (lambda (s) - (condition-case nil - (-let* ((json-object-type 'plist) - ((msg &as &plist :reason :executable) (json-read-from-string s))) - (when (and executable (string= "compiler-artifact" reason)) - executable)) - (error)))) - (funcall - (lambda (artifact-spec) - (pcase artifact-spec - (`() (user-error "No compilation artifacts or obtaining the runnable artifacts failed")) - (`(,spec) spec) - (_ (user-error "Multiple compilation artifacts are not supported"))))) - (list :type (if (featurep 'dap-gdb) "gdb" "cppdbg") - :request "launch" - :name label - :args executable-args - :cwd workspace-root? - :sourceLanguages ["rust"] - :program) - (append lsp-rust-analyzer-debug-lens-extra-dap-args) - (dap-debug)))) - -(defun lsp-rust-analyzer-rerun (&optional runnable) - (interactive (list (or lsp-rust-analyzer--last-runnable - (lsp-rust-analyzer--select-runnable)))) - (lsp-rust-analyzer-run (or runnable lsp-rust-analyzer--last-runnable))) - -;; goto parent module -(cl-defun lsp-rust-find-parent-module (&key display-action) - "Find parent module of current module." - (interactive) - (lsp-find-locations "experimental/parentModule" nil :display-action display-action)) - -(defun lsp-rust-analyzer-open-cargo-toml (&optional new-window) - "Open the closest Cargo.toml from the current file. - -Rust-Analyzer LSP protocol documented here and added in November 2020 -https://github.com/rust-lang/rust-analyzer/blob/master/docs/dev/lsp-extensions.md#open-cargotoml - -If NEW-WINDOW (interactively the prefix argument) is non-nil, -open in a new window." - (interactive "P") - (-if-let (workspace (lsp-find-workspace 'rust-analyzer (buffer-file-name))) - (-if-let* ((response (with-lsp-workspace workspace - (lsp-send-request (lsp-make-request - "experimental/openCargoToml" - (lsp-make-rust-analyzer-open-cargo-toml-params - :text-document (lsp--text-document-identifier)))))) - ((&Location :uri :range) response)) - (funcall (if new-window #'find-file-other-window #'find-file) - (lsp--uri-to-path uri)) - (lsp--warn "Couldn't find a Cargo.toml file or your version of rust-analyzer doesn't support this extension")) - (lsp--error "OpenCargoToml is an extension available only with rust-analyzer"))) - -(defun lsp-rust-analyzer-open-external-docs () - "Open a URL for documentation related to the current TextDocumentPosition. - -Rust-Analyzer LSP protocol documented here -https://github.com/rust-lang/rust-analyzer/blob/master/docs/dev/lsp-extensions.md#open-external-documentation" - (interactive) - (-if-let* ((params (lsp-make-rust-analyzer-open-external-docs-params - :text-document (lsp--text-document-identifier) - :position (lsp--cur-position))) - (url (lsp-request "experimental/externalDocs" params))) - (browse-url url) - (lsp--warn "Couldn't find documentation URL or your version of rust-analyzer doesn't support this extension"))) - -(defun lsp-rust-analyzer--related-tests () - "Get runnable test items related to the current TextDocumentPosition. -Calls a rust-analyzer LSP extension endpoint that returns a wrapper over -Runnable[]." - (lsp-send-request (lsp-make-request - "rust-analyzer/relatedTests" - (lsp--text-document-position-params)))) - -(defun lsp-rust-analyzer--select-related-test () - "Call the endpoint and ask for user selection. - -Cannot reuse `lsp-rust-analyzer--select-runnable' because the runnables endpoint -responds with Runnable[], while relatedTests responds with TestInfo[], -which is a wrapper over runnable. Also, this method doesn't set -the `lsp-rust-analyzer--last-runnable' variable." - (-if-let* ((resp (lsp-rust-analyzer--related-tests)) - (runnables (seq-map - #'lsp:rust-analyzer-related-tests-runnable - resp))) - (lsp--completing-read - "Select test: " - runnables - #'lsp:rust-analyzer-runnable-label))) - -(defun lsp-rust-analyzer-related-tests (runnable) - "Execute a RUNNABLE test related to the current document position. - -Rust-Analyzer LSP protocol extension -https://github.com/rust-lang/rust-analyzer/blob/master/docs/dev/lsp-extensions.md#related-tests" - (interactive (list (lsp-rust-analyzer--select-related-test))) - (if runnable - (lsp-rust-analyzer--common-runner runnable) - (lsp--info "There are no tests related to the symbol at point"))) - -(defun lsp-rust-analyzer-move-item (direction) - "Move item under cursor or selection in some DIRECTION" - (let* ((params (lsp-make-rust-analyzer-move-item-params - :text-document (lsp--text-document-identifier) - :range (if (use-region-p) - (lsp--region-to-range (region-beginning) (region-end)) - (lsp--region-to-range (point) (point))) - :direction direction)) - (edits (lsp-request "experimental/moveItem" params))) - (lsp--apply-text-edits edits 'code-action))) - -(defun lsp-rust-analyzer-move-item-up () - "Move item under cursor or selection up" - (interactive) - (lsp-rust-analyzer-move-item "Up")) - -(defun lsp-rust-analyzer-move-item-down () - "Move item under cursor or selection down" - (interactive) - (lsp-rust-analyzer-move-item "Down")) - -(defun lsp-rust-analyzer--make-init-options () - "Init options for rust-analyzer" - `(:diagnostics - ( :enable ,(lsp-json-bool lsp-rust-analyzer-diagnostics-enable) - :enableExperimental ,(lsp-json-bool lsp-rust-analyzer-diagnostics-enable-experimental) - :disabled ,lsp-rust-analyzer-diagnostics-disabled - :warningsAsHint ,lsp-rust-analyzer-diagnostics-warnings-as-hint - :warningsAsInfo ,lsp-rust-analyzer-diagnostics-warnings-as-info) - :imports ( :granularity ( :enforce ,(lsp-json-bool lsp-rust-analyzer-import-enforce-granularity) - :group ,lsp-rust-analyzer-import-granularity) - :group ,(lsp-json-bool lsp-rust-analyzer-import-group) - :merge (:glob ,(lsp-json-bool lsp-rust-analyzer-imports-merge-glob)) - :prefix ,lsp-rust-analyzer-import-prefix) - :lruCapacity ,lsp-rust-analyzer-lru-capacity - ;; This `checkOnSave` is called `check` in the `rust-analyzer` docs, not - ;; `checkOnSave`, but the `rust-analyzer` source code shows that both names - ;; work. The `checkOnSave` name has been supported by `rust-analyzer` for a - ;; long time, whereas the `check` name was introduced here in 2023: - ;; https://github.com/rust-lang/rust-analyzer/commit/d2bb62b6a81d26f1e41712e04d4ac760f860d3b3 - :checkOnSave ( :enable ,(lsp-json-bool lsp-rust-analyzer-cargo-watch-enable) - :command ,lsp-rust-analyzer-cargo-watch-command - :extraArgs ,lsp-rust-analyzer-cargo-watch-args - :allTargets ,(lsp-json-bool lsp-rust-analyzer-check-all-targets) - ;; We need to distinguish between setting this to the empty - ;; vector, and not setting it at all, which `rust-analyzer` - ;; interprets as "inherit from - ;; `rust-analyzer.cargo.features`". We use `nil` to mean - ;; "unset". - ,@(when (vectorp lsp-rust-analyzer-checkonsave-features) - `(:features ,lsp-rust-analyzer-checkonsave-features)) - :overrideCommand ,lsp-rust-analyzer-cargo-override-command) - :highlightRelated ( :breakPoints (:enable ,(lsp-json-bool lsp-rust-analyzer-highlight-breakpoints)) - :closureCaptures (:enable ,(lsp-json-bool lsp-rust-analyzer-highlight-closure-captures)) - :exitPoints (:enable ,(lsp-json-bool lsp-rust-analyzer-highlight-exit-points)) - :references (:enable ,(lsp-json-bool lsp-rust-analyzer-highlight-references)) - :yieldPoints (:enable ,(lsp-json-bool lsp-rust-analyzer-highlight-yield-points))) - :files ( :exclude ,lsp-rust-analyzer-exclude-globs - :watcher ,(if lsp-rust-analyzer-use-client-watching "client" "notify") - :excludeDirs ,lsp-rust-analyzer-exclude-dirs) - :cargo ( :allFeatures ,(lsp-json-bool lsp-rust-all-features) - :noDefaultFeatures ,(lsp-json-bool lsp-rust-no-default-features) - :features ,lsp-rust-features - :extraArgs ,lsp-rust-analyzer-cargo-extra-args - :extraEnv ,lsp-rust-analyzer-cargo-extra-env - :target ,lsp-rust-analyzer-cargo-target - :runBuildScripts ,(lsp-json-bool lsp-rust-analyzer-cargo-run-build-scripts) - ;; Obsolete, but used by old Rust-Analyzer versions - :loadOutDirsFromCheck ,(lsp-json-bool lsp-rust-analyzer-cargo-run-build-scripts) - :autoreload ,(lsp-json-bool lsp-rust-analyzer-cargo-auto-reload) - :useRustcWrapperForBuildScripts ,(lsp-json-bool lsp-rust-analyzer-use-rustc-wrapper-for-build-scripts) - :unsetTest ,lsp-rust-analyzer-cargo-unset-test) - :rustfmt ( :extraArgs ,lsp-rust-analyzer-rustfmt-extra-args - :overrideCommand ,lsp-rust-analyzer-rustfmt-override-command - :rangeFormatting (:enable ,(lsp-json-bool lsp-rust-analyzer-rustfmt-rangeformatting-enable))) - :lens ( :debug (:enable ,(lsp-json-bool lsp-rust-analyzer-lens-debug-enable)) - :enable ,(lsp-json-bool lsp-rust-analyzer-lens-enable) - ;; :forceCustomCommands ,(lsp-json-bool lsp-rust-analyzer-lens-force-custom-commands) - :implementations (:enable ,(lsp-json-bool lsp-rust-analyzer-lens-implementations-enable)) - ;; :location ,lsp-rust-analyzer-lens-location - :references ( :adt (:enable ,(lsp-json-bool lsp-rust-analyzer-lens-references-adt-enable)) - :enumVariant (:enable ,(lsp-json-bool lsp-rust-analyzer-lens-references-enum-variant-enable)) - :method (:enable ,(lsp-json-bool lsp-rust-analyzer-lens-references-method-enable)) - :trait (:enable ,(lsp-json-bool lsp-rust-analyzer-lens-references-trait-enable))) - :run (:enable ,(lsp-json-bool lsp-rust-analyzer-lens-run-enable))) - - :inlayHints ( :bindingModeHints (:enable ,(lsp-json-bool lsp-rust-analyzer-binding-mode-hints)) - :chainingHints (:enable ,(lsp-json-bool lsp-rust-analyzer-display-chaining-hints)) - :closingBraceHints ( :enable ,(lsp-json-bool lsp-rust-analyzer-closing-brace-hints) - :minLines ,lsp-rust-analyzer-closing-brace-hints-min-lines) - :closureCaptureHints (:enable ,(lsp-json-bool lsp-rust-analyzer-closure-capture-hints)) - :closureReturnTypeHints (:enable ,lsp-rust-analyzer-closure-return-type-hints) - :closureStyle ,lsp-rust-analyzer-closure-style - :discriminantHints (:enable ,lsp-rust-analyzer-discriminants-hints) - - :expressionAdjustmentHints ( :enable ,lsp-rust-analyzer-expression-adjustment-hints - :hideOutsideUnsafe ,(lsp-json-bool lsp-rust-analyzer-expression-adjustment-hide-unsafe) - :mode ,lsp-rust-analyzer-expression-adjustment-hints-mode) - :implicitDrops (:enable ,(lsp-json-bool lsp-rust-analyzer-implicit-drops)) - :lifetimeElisionHints ( :enable ,lsp-rust-analyzer-display-lifetime-elision-hints-enable - :useParameterNames ,(lsp-json-bool lsp-rust-analyzer-display-lifetime-elision-hints-use-parameter-names)) - :maxLength ,lsp-rust-analyzer-max-inlay-hint-length - :parameterHints (:enable ,(lsp-json-bool lsp-rust-analyzer-display-parameter-hints)) - :reborrowHints (:enable ,lsp-rust-analyzer-display-reborrow-hints) - :renderColons ,(lsp-json-bool lsp-rust-analyzer-server-format-inlay-hints) - :typeHints ( :enable ,(lsp-json-bool lsp-inlay-hint-enable) - :hideClosureInitialization ,(lsp-json-bool lsp-rust-analyzer-hide-closure-initialization) - :hideNamedConstructor ,(lsp-json-bool lsp-rust-analyzer-hide-named-constructor))) - :completion ( :addCallParenthesis ,(lsp-json-bool lsp-rust-analyzer-completion-add-call-parenthesis) - :addCallArgumentSnippets ,(lsp-json-bool lsp-rust-analyzer-completion-add-call-argument-snippets) - :postfix (:enable ,(lsp-json-bool lsp-rust-analyzer-completion-postfix-enable)) - :autoimport (:enable ,(lsp-json-bool lsp-rust-analyzer-completion-auto-import-enable)) - :autoself (:enable ,(lsp-json-bool lsp-rust-analyzer-completion-auto-self-enable))) - :callInfo (:full ,(lsp-json-bool lsp-rust-analyzer-call-info-full)) - :procMacro (:enable ,(lsp-json-bool lsp-rust-analyzer-proc-macro-enable)) - :rustcSource ,lsp-rust-analyzer-rustc-source - :linkedProjects ,lsp-rust-analyzer-linked-projects - :highlighting (:strings ,(lsp-json-bool lsp-rust-analyzer-highlighting-strings)) - :experimental (:procAttrMacros ,(lsp-json-bool lsp-rust-analyzer-experimental-proc-attr-macros)))) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection - (lambda () - `(,(or (executable-find - (cl-first lsp-rust-analyzer-server-command)) - (lsp-package-path 'rust-analyzer) - "rust-analyzer") - ,@(cl-rest lsp-rust-analyzer-server-command)))) - :activation-fn (lsp-activate-on "rust") - :priority (if (eq lsp-rust-server 'rust-analyzer) 1 -1) - :initialization-options 'lsp-rust-analyzer--make-init-options - :notification-handlers (ht<-alist lsp-rust-notification-handlers) - :action-handlers (ht ("rust-analyzer.runSingle" #'lsp-rust--analyzer-run-single) - ("rust-analyzer.debugSingle" #'lsp-rust--analyzer-debug-lens) - ("rust-analyzer.showReferences" #'lsp-rust--analyzer-show-references) - ("rust-analyzer.triggerParameterHints" #'lsp--action-trigger-parameter-hints)) - :library-folders-fn (lambda (_workspace) lsp-rust-analyzer-library-directories) - :semantic-tokens-faces-overrides `( :discard-default-modifiers t - :modifiers ,(lsp-rust-analyzer--semantic-modifiers)) - :server-id 'rust-analyzer - :custom-capabilities `((experimental . - ((snippetTextEdit . ,(and lsp-enable-snippet (fboundp 'yas-minor-mode))) - (commands . ((commands . - [ - "rust-analyzer.runSingle" - "rust-analyzer.debugSingle" - "rust-analyzer.showReferences" - ;; "rust-analyzer.gotoLocation" - "rust-analyzer.triggerParameterHints" - ;; "rust-analyzer.rename" - ])))))) - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'rust-analyzer callback error-callback)))) - -(cl-defmethod lsp-clients-extract-signature-on-hover (contents (_server-id (eql rust-analyzer))) - "Extract first non-comment line from rust-analyzer's hover CONTENTS. -The first line of the hover contents is usally about memory layout or notable -traits starting with //, with the actual signature follows." - (let* ((lines (s-lines (s-trim (lsp--render-element contents)))) - (non-comment-lines (--filter (not (s-prefix? "//" it)) lines))) - (if non-comment-lines - (car non-comment-lines) - (car lines)))) - -(lsp-consistency-check lsp-rust) - -(provide 'lsp-rust) -;;; lsp-rust.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-rust.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-rust.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-semantic-tokens.el b/emacs/elpa/lsp-mode-20241113.743/lsp-semantic-tokens.el @@ -1,920 +0,0 @@ -;;; lsp-semantic-tokens.el --- Semantic tokens -*- lexical-binding: t; -*- -;; -;; Copyright (C) 2020 emacs-lsp maintainers -;; -;; 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: -;; -;; Semantic tokens -;; https://microsoft.github.io/language-server-protocol/specifications/specification-current/#textDocument_semanticTokens -;; -;;; Code: - -(require 'lsp-mode) -(require 'dash) - -(defgroup lsp-semantic-tokens nil - "LSP support for semantic-tokens." - :prefix "lsp-semantic-tokens-" - :group 'lsp-mode - :tag "LSP Semantic tokens") - -(define-obsolete-variable-alias 'lsp-semantic-highlighting-warn-on-missing-face 'lsp-semantic-tokens-warn-on-missing-face "lsp-mode 8.0.0") - -(defcustom lsp-semantic-tokens-warn-on-missing-face nil - "Warning on missing face for token type/modifier. -When non-nil, this option will emit a warning any time a token -or modifier type returned by a language server has no face associated with it." - :group 'lsp-semantic-tokens - :type 'boolean) - -(defcustom lsp-semantic-tokens-apply-modifiers t - "Whether semantic tokens should take token modifiers into account." - :group 'lsp-semantic-tokens - :type 'boolean) - -(defcustom lsp-semantic-tokens-allow-ranged-requests t - "Whether to use ranged semantic token requests when available. - -Note that even when this is set to t, delta requests will -be preferred whenever possible, unless -`lsp-semantic-tokens-allow-delta-requests' is false." - :group 'lsp-semantic-tokens - :type 'boolean) - -(defcustom lsp-semantic-tokens-allow-delta-requests t - "Whether to use semantic token delta requests when available. - -When supported by the language server, delta requests are always -preferred over both full and ranged token requests." - :group 'lsp-semantic-tokens - :type 'boolean) - -(defcustom lsp-semantic-tokens-honor-refresh-requests nil - "Whether to honor semanticTokens/refresh requests. - -When set to nil, refresh requests will be silently discarded. -When set to t, semantic tokens will be re-requested for all buffers -associated with the requesting language server." - :group 'lsp-semantic-tokens - :type 'boolean) - -(defcustom lsp-semantic-tokens-enable-multiline-token-support t - "When set to nil, tokens will be truncated after end-of-line." - :group 'lsp-semantic-tokens - :type 'boolean) - -(defface lsp-face-semhl-constant - '((t :inherit font-lock-constant-face)) - "Face used for semantic highlighting scopes matching constant scopes." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-variable - '((t :inherit font-lock-variable-name-face)) - "Face used for semantic highlighting scopes matching variable.*. -Unless overridden by a more specific face association." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-function - '((t :inherit font-lock-function-name-face)) - "Face used for semantic highlighting scopes matching entity.name.function.*. -Unless overridden by a more specific face association." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-method - '((t :inherit lsp-face-semhl-function)) - "Face used for semantic highlighting scopes matching entity.name.method.*. -Unless overridden by a more specific face association." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-namespace - '((t :inherit font-lock-type-face :weight bold)) - "Face used for semantic highlighting scopes matching entity.name.namespace.*. -Unless overridden by a more specific face association." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-comment - '((t (:inherit font-lock-comment-face))) - "Face used for comments." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-keyword - '((t (:inherit font-lock-keyword-face))) - "Face used for keywords." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-string - '((t (:inherit font-lock-string-face))) - "Face used for keywords." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-number - '((t (:inherit font-lock-constant-face))) - "Face used for numbers." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-regexp - '((t (:inherit font-lock-string-face :slant italic))) - "Face used for regexps." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-operator - '((t (:inherit font-lock-function-name-face))) - "Face used for operators." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-namespace - '((t (:inherit font-lock-keyword-face))) - "Face used for namespaces." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-type - '((t (:inherit font-lock-type-face))) - "Face used for types." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-struct - '((t (:inherit font-lock-type-face))) - "Face used for structs." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-class - '((t (:inherit font-lock-type-face))) - "Face used for classes." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-interface - '((t (:inherit font-lock-type-face))) - "Face used for interfaces." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-enum - '((t (:inherit font-lock-type-face))) - "Face used for enums." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-type-parameter - '((t (:inherit font-lock-type-face))) - "Face used for type parameters." - :group 'lsp-semantic-tokens) - -;; function face already defined, move here when support -;; for theia highlighting gets removed -(defface lsp-face-semhl-member - '((t (:inherit font-lock-variable-name-face))) - "Face used for members." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-property - '((t (:inherit font-lock-variable-name-face))) - "Face used for properties." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-event - '((t (:inherit font-lock-variable-name-face))) - "Face used for event properties." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-macro - '((t (:inherit font-lock-preprocessor-face))) - "Face used for macros." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-variable - '((t (:inherit font-lock-variable-name-face))) - "Face used for variables." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-parameter - '((t (:inherit font-lock-variable-name-face))) - "Face used for parameters." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-label - '((t (:inherit font-lock-comment-face))) - "Face used for labels." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-deprecated - '((t :strike-through t)) - "Face used for semantic highlighting scopes matching constant scopes." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-definition - '((t :inherit font-lock-function-name-face :weight bold)) - "Face used for definition modifier." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-implementation - '((t :inherit font-lock-function-name-face :weight bold)) - "Face used for implementation modifier." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-default-library - '((t :inherit font-lock-builtin-face)) - "Face used for defaultLibrary modifier." - :group 'lsp-semantic-tokens) - -(defface lsp-face-semhl-static - '((t :inherit font-lock-keyword-face)) - "Face used for static modifier." - :group 'lsp-semantic-tokens) - -(defvar-local lsp-semantic-token-faces - '(("comment" . lsp-face-semhl-comment) - ("keyword" . lsp-face-semhl-keyword) - ("string" . lsp-face-semhl-string) - ("number" . lsp-face-semhl-number) - ("regexp" . lsp-face-semhl-regexp) - ("operator" . lsp-face-semhl-operator) - ("namespace" . lsp-face-semhl-namespace) - ("type" . lsp-face-semhl-type) - ("struct" . lsp-face-semhl-struct) - ("class" . lsp-face-semhl-class) - ("interface" . lsp-face-semhl-interface) - ("enum" . lsp-face-semhl-enum) - ("typeParameter" . lsp-face-semhl-type-parameter) - ("function" . lsp-face-semhl-function) - ("method" . lsp-face-semhl-method) - ("member" . lsp-face-semhl-member) - ("property" . lsp-face-semhl-property) - ("event" . lsp-face-semhl-event) - ("macro" . lsp-face-semhl-macro) - ("variable" . lsp-face-semhl-variable) - ("parameter" . lsp-face-semhl-parameter) - ("label" . lsp-face-semhl-label) - ("enumConstant" . lsp-face-semhl-constant) - ("enumMember" . lsp-face-semhl-constant) - ("dependent" . lsp-face-semhl-type) - ("concept" . lsp-face-semhl-interface)) - "Faces to use for semantic tokens.") - -(defvar-local lsp-semantic-token-modifier-faces - '(("declaration" . lsp-face-semhl-interface) - ("definition" . lsp-face-semhl-definition) - ("implementation" . lsp-face-semhl-implementation) - ("readonly" . lsp-face-semhl-constant) - ("static" . lsp-face-semhl-static) - ("deprecated" . lsp-face-semhl-deprecated) - ("abstract" . lsp-face-semhl-keyword) - ("async" . lsp-face-semhl-macro) - ("modification" . lsp-face-semhl-operator) - ("documentation" . lsp-face-semhl-comment) - ("defaultLibrary" . lsp-face-semhl-default-library)) - "Semantic tokens modifier faces. -Faces to use for semantic token modifiers if -`lsp-semantic-tokens-apply-modifiers' is non-nil.") - -(defun lsp--semantic-tokens-capabilities () - `((semanticTokens - . ((dynamicRegistration . t) - (requests . ((range . t) (full . t))) - (tokenModifiers . ,(if lsp-semantic-tokens-apply-modifiers - (apply 'vector (mapcar #'car (lsp-semantic-tokens--modifier-faces-for (lsp--workspace-client lsp--cur-workspace)))) - [])) - (overlappingTokenSupport . t) - (multilineTokenSupport . ,(if lsp-semantic-tokens-enable-multiline-token-support t json-false)) - (tokenTypes . ,(apply 'vector (mapcar #'car (lsp-semantic-tokens--type-faces-for (lsp--workspace-client lsp--cur-workspace))))) - (formats . ["relative"]))))) - -(defvar lsp--semantic-tokens-pending-full-token-requests '() - "Buffers which should have their semantic tokens refreshed on idle. - -This is an alist of the form ((buffer_i . fontify_immediately_i) ...); entries -with fontify_immediately set to t will immediately refontify once their -token request is answered.") - -;; NOTE: doesn't keep track of outstanding requests, so might still produce large latency outliers -;; if the language server doesn't process all outstanding token requests within one lsp-idle-delay -(defcustom lsp-semantic-tokens-max-concurrent-idle-requests 1 - "Maximum number of on-idle token requests to be dispatched simultaneously." - :group 'lsp-semantic-tokens - :type 'integer) - -(defvar lsp--semantic-tokens-idle-timer nil) - -(defun lsp--semantic-tokens-process-pending-requests () - (let ((fuel lsp-semantic-tokens-max-concurrent-idle-requests)) - (while (and lsp--semantic-tokens-pending-full-token-requests (> fuel 0)) - (-let (((buffer . fontify-immediately) (pop lsp--semantic-tokens-pending-full-token-requests))) - (when (buffer-live-p buffer) - (setq fuel (1- fuel)) - (with-current-buffer buffer - (lsp--semantic-tokens-request nil fontify-immediately)))))) - (unless lsp--semantic-tokens-pending-full-token-requests - (cancel-timer lsp--semantic-tokens-idle-timer) - (setq lsp--semantic-tokens-idle-timer nil))) - -(defun lsp--semantic-tokens-sort-pending-requests (pending-requests) - ;; service currently visible buffers first, otherwise prefer immediate-fontification requests - (-sort (lambda (entry-a entry-b) - (let ((a-hidden (eq nil (get-buffer-window (car entry-a)))) - (b-hidden (eq nil (get-buffer-window (car entry-b))))) - (cond ((and b-hidden (not a-hidden)) t) ; sort a before b - ((and a-hidden (not b-hidden)) nil) ; sort b before a - ((and (not (cdr entry-a)) (cdr entry-b)) nil) ; otherwise sort b before a only if b is immediate and a is not - (t t)))) - (--filter (buffer-live-p (car it)) pending-requests))) - -(defun lsp--semantic-tokens-request-full-token-set-when-idle (buffer fontify-immediately) - "Request full token set after an idle timeout of `lsp-idle-delay'. - -If FONTIFY-IMMEDIATELY is non-nil, fontification will be performed immediately - once the corresponding response is received." - (let ((do-fontify-immediately (or fontify-immediately - (cdr (assoc buffer lsp--semantic-tokens-pending-full-token-requests))))) - (setq lsp--semantic-tokens-pending-full-token-requests - (lsp--semantic-tokens-sort-pending-requests - (cons (cons buffer do-fontify-immediately) - (--remove (eq buffer (car it)) lsp--semantic-tokens-pending-full-token-requests))))) - (unless lsp--semantic-tokens-idle-timer - (setq lsp--semantic-tokens-idle-timer - (run-with-idle-timer lsp-idle-delay t #'lsp--semantic-tokens-process-pending-requests)))) - -(defun lsp--semantic-tokens-refresh-if-enabled (buffer) - (when (buffer-local-value 'lsp-semantic-tokens-mode buffer) - (lsp--semantic-tokens-request-full-token-set-when-idle buffer t))) - -(defvar-local lsp--semantic-tokens-cache nil - "Previously returned token set. - -When non-nil, `lsp--semantic-tokens-cache' should adhere to the -following lsp-interface: -`(_SemanticTokensCache - (:_documentVersion) - (:response :_region :_truncated))'.") - -(defsubst lsp--semantic-tokens-putcache (k v) - "Set key K of `lsp--semantic-tokens-cache' to V." - (setq lsp--semantic-tokens-cache - (plist-put lsp--semantic-tokens-cache k v))) - -(defvar-local lsp--semantic-tokens-teardown nil) - -(defun lsp--semantic-tokens-ingest-range-response (response) - "Handle RESPONSE to semanticTokens/range request." - (lsp--semantic-tokens-putcache :response response) - (cl-assert (plist-get lsp--semantic-tokens-cache :_region)) - (lsp--semantic-tokens-request-full-token-set-when-idle (current-buffer) nil)) - -(defun lsp--semantic-tokens-ingest-full-response (response) - "Handle RESPONSE to semanticTokens/full request." - (lsp--semantic-tokens-putcache :response response) - (cl-assert (not (plist-get lsp--semantic-tokens-cache :_region)))) - -(defsubst lsp--semantic-tokens-apply-delta-edits (old-data edits) - "Apply EDITS obtained from full/delta request to OLD-DATA." - (let* ((old-token-count (length old-data)) - (old-token-index 0) - (substrings)) - (cl-loop - for edit across edits - do - (when (< old-token-index (lsp-get edit :start)) - (push (substring old-data old-token-index (lsp-get edit :start)) substrings)) - (push (lsp-get edit :data) substrings) - (setq old-token-index (+ (lsp-get edit :start) (lsp-get edit :deleteCount))) - finally do (push (substring old-data old-token-index old-token-count) substrings)) - (apply #'vconcat (nreverse substrings)))) - -(defun lsp--semantic-tokens-ingest-full/delta-response (response) - "Handle RESPONSE to semanticTokens/full/delta request." - (if (lsp-get response :edits) - (let ((old-data (--> lsp--semantic-tokens-cache (plist-get it :response) (lsp-get it :data)))) - (cl-assert (not (plist-get lsp--semantic-tokens-cache :_region))) - (when old-data - (lsp--semantic-tokens-putcache - :response (lsp-put response - :data (lsp--semantic-tokens-apply-delta-edits - old-data (lsp-get response :edits)))))) - ;; server decided to send full response instead - (lsp--semantic-tokens-ingest-full-response response))) - - -(defun lsp--semantic-tokens-request (region fontify-immediately) - "Send semantic tokens request to the language server. - -A full/delta request will be sent if delta requests are supported by -the language server, allowed via `lsp-semantic-tokens-allow-delta-requests', -and if a full set of tokens had previously been received. -Otherwise, a ranged request will be dispatched if REGION is non-nil, -ranged requests are supported by the language server, and allowed via -`lsp-semantic-tokens-allow-delta-requests'. In all other cases, a full -tokens request will be dispatched. - -If FONTIFY-IMMEDIATELY is non-nil, fontification will be performed immediately - upon receiving the response." - (let ((request-type "textDocument/semanticTokens/full") - (request `(:textDocument ,(lsp--text-document-identifier))) - (response-handler nil) - (final-region nil)) - (cond - ((and lsp-semantic-tokens-allow-delta-requests - (lsp-feature? "textDocument/semanticTokensFull/Delta") - (--> lsp--semantic-tokens-cache - (plist-get it :response) - (and (lsp-get it :resultId) (lsp-get it :data) - (not (plist-get lsp--semantic-tokens-cache :_region))))) - (setq request-type "textDocument/semanticTokens/full/delta") - (setq response-handler #'lsp--semantic-tokens-ingest-full/delta-response) - (setq request - (plist-put request :previousResultId - (lsp-get (plist-get lsp--semantic-tokens-cache :response) :resultId)))) - ((and lsp-semantic-tokens-allow-ranged-requests region - (lsp-feature? "textDocument/semanticTokensRangeProvider")) - (setq request-type "textDocument/semanticTokens/range") - (setq final-region region) - (setq request - (plist-put request :range (lsp--region-to-range (car final-region) (cdr final-region)))) - (setq response-handler #'lsp--semantic-tokens-ingest-range-response)) - (t (setq response-handler #'lsp--semantic-tokens-ingest-full-response))) - (lsp-request-async - request-type request - (lambda (response) - (lsp--semantic-tokens-putcache :_documentVersion lsp--cur-version) - (lsp--semantic-tokens-putcache :_region final-region) - (funcall response-handler response) - (when (or fontify-immediately (plist-get lsp--semantic-tokens-cache :_truncated)) (font-lock-flush))) - :error-handler ;; buffer is not captured in `error-handler', it is in `callback' - (let ((buf (current-buffer))) - (lambda (&rest _) - (when (buffer-live-p buf) - (lsp--semantic-tokens-request-full-token-set-when-idle buf t)))) - :mode 'tick - :cancel-token (format "semantic-tokens-%s" (lsp--buffer-uri))))) - - -;;;###autoload -(defvar-local semantic-token-modifier-cache (make-hash-table) - "A cache of modifier values to the selected fonts. -This allows whole-bitmap lookup instead of checking each bit. The -expectation is that usage of modifiers will tend to cluster, so -we will not have the full range of possible usages, hence a -tractable hash map. - -This is set as buffer-local. It should probably be shared in a -given workspace/language-server combination. - -This cache should be flushed every time any modifier -configuration changes.") - -(defun lsp-semantic-tokens--fontify (old-fontify-region beg-orig end-orig &optional loudly) - "Apply fonts to retrieved semantic tokens. -OLD-FONTIFY-REGION is the underlying region fontification function, -e.g., `font-lock-fontify-region'. -BEG-ORIG and END-ORIG deliminate the requested fontification region and maybe -modified by OLD-FONTIFY-REGION. -LOUDLY will be forwarded to OLD-FONTIFY-REGION as-is." - ;; TODO: support multiple language servers per buffer? - (let ((faces (seq-some #'lsp--workspace-semantic-tokens-faces lsp--buffer-workspaces)) - (modifier-faces - (when lsp-semantic-tokens-apply-modifiers - (seq-some #'lsp--workspace-semantic-tokens-modifier-faces lsp--buffer-workspaces))) - old-bounds - beg end) - (cond - ((or (eq nil faces) - (eq nil lsp--semantic-tokens-cache) - (eq nil (plist-get lsp--semantic-tokens-cache :response))) - ;; default to non-semantic highlighting until first response has arrived - (funcall old-fontify-region beg-orig end-orig loudly)) - ((not (= lsp--cur-version (plist-get lsp--semantic-tokens-cache :_documentVersion))) - ;; delay fontification until we have fresh tokens - '(jit-lock-bounds 0 . 0)) - (t - (setq old-bounds (funcall old-fontify-region beg-orig end-orig loudly)) - ;; this is to prevent flickering when semantic token highlighting - ;; is layered on top of, e.g., tree-sitter-hl, or clojure-mode's syntax highlighting. - (setq beg (min beg-orig (cadr old-bounds)) - end (max end-orig (cddr old-bounds))) - ;; if we're using the response to a ranged request, we'll only be able to fontify within - ;; that range (and hence shouldn't clear any highlights outside of that range) - (let ((token-region (plist-get lsp--semantic-tokens-cache :_region))) - (if token-region - (progn - (lsp--semantic-tokens-putcache :_truncated (or (< beg (car token-region)) - (> end (cdr token-region)))) - (setq beg (max beg (car token-region))) - (setq end (min end (cdr token-region)))) - (lsp--semantic-tokens-putcache :_truncated nil))) - (-let* ((inhibit-field-text-motion t) - (data (lsp-get (plist-get lsp--semantic-tokens-cache :response) :data)) - (i0 0) - (i-max (1- (length data))) - (current-line 1) - (line-delta) - (column 0) - (face) - (line-start-pos) - (line-min) - (line-max-inclusive) - (text-property-beg) - (text-property-end)) - (save-mark-and-excursion - (save-restriction - (widen) - (goto-char beg) - (goto-char (line-beginning-position)) - (setq line-min (line-number-at-pos)) - (with-silent-modifications - (goto-char end) - (goto-char (line-end-position)) - (setq line-max-inclusive (line-number-at-pos)) - (forward-line (- line-min line-max-inclusive)) - (let ((skip-lines (- line-min current-line))) - (while (and (<= i0 i-max) (< (aref data i0) skip-lines)) - (setq skip-lines (- skip-lines (aref data i0))) - (setq i0 (+ i0 5))) - (setq current-line (- line-min skip-lines))) - (forward-line (- current-line line-min)) - (setq line-start-pos (point)) - (cl-loop - for i from i0 to i-max by 5 do - (setq line-delta (aref data i)) - (unless (= line-delta 0) - (forward-line line-delta) - (setq line-start-pos (point)) - (setq column 0) - (setq current-line (+ current-line line-delta))) - (setq column (+ column (aref data (1+ i)))) - (setq face (aref faces (aref data (+ i 3)))) - (setq text-property-beg (+ line-start-pos column)) - (setq text-property-end - (min (if lsp-semantic-tokens-enable-multiline-token-support - (point-max) (line-end-position)) - (+ text-property-beg (aref data (+ i 2))))) - (when face - (put-text-property text-property-beg text-property-end 'face face)) - ;; Deal with modifiers. We cache common combinations of - ;; modifiers, storing the faces they resolve to. - (let* ((modifier-code (aref data (+ i 4))) - (faces-to-apply (gethash modifier-code semantic-token-modifier-cache 'not-found))) - (when (eq 'not-found faces-to-apply) - (setq faces-to-apply nil) - (cl-loop for j from 0 to (1- (length modifier-faces)) do - (when (and (aref modifier-faces j) - (> (logand modifier-code (ash 1 j)) 0)) - (push (aref modifier-faces j) faces-to-apply))) - (puthash modifier-code faces-to-apply semantic-token-modifier-cache)) - (dolist (face faces-to-apply) - (add-face-text-property text-property-beg text-property-end face))) - when (> current-line line-max-inclusive) return nil))))) - `(jit-lock-bounds ,beg . ,end))))) - -(defun lsp-semantic-tokens--request-update () - "Request semantic-tokens update." - ;; when dispatching ranged requests, we'll over-request by several chunks in both directions, - ;; which should minimize those occasions where font-lock region extension extends beyond the - ;; region covered by our freshly requested tokens (see lsp-mode issue #3154), while still limiting - ;; requests to fairly small regions even if the underlying buffer is large - (when (lsp-feature? "textDocument/semanticTokensFull") - (lsp--semantic-tokens-request - (cons (max (point-min) (- (window-start) (* 5 jit-lock-chunk-size))) - (min (point-max) (+ (window-end) (* 5 jit-lock-chunk-size)))) t))) - -(defun lsp--semantic-tokens-as-defined-by-workspace (workspace) - "Return plist of token-types and token-modifiers defined by WORKSPACE, -or nil if none are defined." - (when-let ((token-capabilities - (or - (-some-> - (lsp--registered-capability "textDocument/semanticTokens") - (lsp--registered-capability-options)) - (lsp:server-capabilities-semantic-tokens-provider? - (lsp--workspace-server-capabilities workspace))))) - (-let* (((&SemanticTokensOptions :legend) token-capabilities)) - `(:token-types ,(lsp:semantic-tokens-legend-token-types legend) - :token-modifiers ,(lsp:semantic-tokens-legend-token-modifiers legend))))) - -(defun lsp-semantic-tokens-suggest-overrides () - "Suggest face overrides that best match the faces -chosen by `font-lock-fontify-region'." - (interactive) - (-when-let* ((token-info (-some #'lsp--semantic-tokens-as-defined-by-workspace lsp--buffer-workspaces)) - ((&plist :token-types token-types :token-modifiers token-modifiers) token-info)) - (let* ((tokens (lsp-request - "textDocument/semanticTokens/full" - `(:textDocument, (lsp--text-document-identifier)))) - (inhibit-field-text-motion t) - (data (lsp-get tokens :data)) - (associated-faces '()) - (line-delta) - ;; KLUDGE: clear cache so our font-lock advice won't apply semantic-token faces - (old-cache lsp--semantic-tokens-cache) - (face-or-faces)) - (setq lsp--semantic-tokens-cache nil) - (save-restriction - (save-excursion - (widen) - (font-lock-fontify-region (point-min) (point-max) t) - (save-mark-and-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (cl-loop - for i from 0 to (1- (length data)) by 5 do - (setq line-delta (aref data i)) - (unless (= line-delta 0) (forward-line line-delta)) - (forward-char (aref data (+ i 1))) - (setq face-or-faces (get-text-property (point) 'face)) - ;; TODO: consider modifiers? - (when face-or-faces - (--each (if (listp face-or-faces) face-or-faces (list face-or-faces)) - (cl-pushnew `(,(aref data (+ i 3)) . ,it) associated-faces :test #'equal)))) - (setq lsp--semantic-tokens-cache old-cache) - (font-lock-flush))))) - (switch-to-buffer (get-buffer-create "*Suggested Overrides*")) - (insert "(") - ;; TODO: sort alternatives by frequency - (--each-indexed (-group-by #'car associated-faces) - (insert (if (= it-index 0) "(" "\n (")) - (insert (format "%s . " (aref token-types (car it)))) - (--each-indexed (mapcar #'cdr (cdr it)) - (insert (if (= it-index 0) (format "%s)" (prin1-to-string it)) - (format " ; Alternative: %s" (prin1-to-string it)))))) - (insert ")")))) - -(declare-function tree-sitter-hl-mode "ext:tree-sitter-hl") - -(with-eval-after-load 'tree-sitter-hl - (add-hook - 'tree-sitter-hl-mode-hook - (lambda () - (when (and lsp-mode lsp--semantic-tokens-teardown - (boundp 'tree-sitter-hl-mode) tree-sitter-hl-mode) - (lsp-warn "It seems you have configured tree-sitter-hl to activate after lsp-mode. -To prevent tree-sitter-hl from overriding lsp-mode's semantic token highlighting, lsp-mode -will now disable both semantic highlighting and tree-sitter-hl mode and subsequently re-enable both, -starting with tree-sitter-hl-mode. - -Please adapt your config to prevent unnecessary mode reinitialization in the future.") - (tree-sitter-hl-mode -1) - (funcall lsp--semantic-tokens-teardown) - (setq lsp--semantic-tokens-teardown nil) - (tree-sitter-hl-mode t) - (lsp--semantic-tokens-initialize-buffer))))) - -;;;###autoload -(defun lsp--semantic-tokens-initialize-buffer () - "Initialize the buffer for semantic tokens. -IS-RANGE-PROVIDER is non-nil when server supports range requests." - (let* ((old-extend-region-functions font-lock-extend-region-functions) - ;; make sure font-lock always fontifies entire lines (TODO: do we also have - ;; to change some jit-lock-...-region functions/variables?) - (new-extend-region-functions - (if (memq 'font-lock-extend-region-wholelines old-extend-region-functions) - old-extend-region-functions - (cons 'font-lock-extend-region-wholelines old-extend-region-functions))) - (buffer (current-buffer))) - (setq lsp--semantic-tokens-cache nil) - (setq font-lock-extend-region-functions new-extend-region-functions) - (add-function :around (local 'font-lock-fontify-region-function) #'lsp-semantic-tokens--fontify) - (add-hook 'lsp-on-change-hook #'lsp-semantic-tokens--request-update nil t) - (lsp-semantic-tokens--request-update) - (setq lsp--semantic-tokens-teardown - (lambda () - (setq lsp--semantic-tokens-pending-full-token-requests - (--remove (eq buffer (car it)) lsp--semantic-tokens-pending-full-token-requests)) - (setq font-lock-extend-region-functions old-extend-region-functions) - (setq lsp--semantic-tokens-cache nil) - (remove-function (local 'font-lock-fontify-region-function) - #'lsp-semantic-tokens--fontify) - (remove-hook 'lsp-on-change-hook #'lsp-semantic-tokens--request-update t))))) - -(defun lsp--semantic-tokens-build-face-map (identifiers faces category varname) - "Build map of FACES for IDENTIFIERS using CATEGORY and VARNAME." - (apply 'vector - (mapcar (lambda (id) - (let ((maybe-face (cdr (assoc id faces)))) - (when (and lsp-semantic-tokens-warn-on-missing-face (not maybe-face)) - (lsp-warn "No face has been associated to the %s '%s': consider adding a corresponding definition to %s" - category id varname)) maybe-face)) identifiers))) - -(defun lsp-semantic-tokens--apply-alist-overrides (base overrides discard-defaults) - "Merge or replace BASE with OVERRIDES, depending on DISCARD-DEFAULTS. -For keys present in both alists, the assignments made by -OVERRIDES will take precedence." - (if discard-defaults - overrides - (let* ((copy-base (copy-alist base))) - (mapc (-lambda ((key . value)) (setf (alist-get key copy-base nil nil #'string=) value)) overrides) - copy-base))) - -(defun lsp-semantic-tokens--type-faces-for (client) - "Return the semantic token type faces for CLIENT." - (lsp-semantic-tokens--apply-alist-overrides - lsp-semantic-token-faces - (plist-get (lsp--client-semantic-tokens-faces-overrides client) :types) - (plist-get (lsp--client-semantic-tokens-faces-overrides client) :discard-default-types))) - -(defun lsp-semantic-tokens--modifier-faces-for (client) - "Return the semantic token type faces for CLIENT." - (lsp-semantic-tokens--apply-alist-overrides - lsp-semantic-token-modifier-faces - (plist-get (lsp--client-semantic-tokens-faces-overrides client) :modifiers) - (plist-get (lsp--client-semantic-tokens-faces-overrides client) :discard-default-modifiers))) - -(defun lsp--semantic-tokens-on-refresh (workspace) - "Clear semantic tokens within all buffers of WORKSPACE, -refresh in currently active buffer." - (cl-assert (not (eq nil workspace))) - (when lsp-semantic-tokens-honor-refresh-requests - (cl-loop - for ws-buffer in (lsp--workspace-buffers workspace) do - (let ((fontify-immediately (equal (current-buffer) ws-buffer))) - (with-current-buffer ws-buffer (lsp--semantic-tokens-request nil fontify-immediately)))))) - -;;;###autoload -(defun lsp--semantic-tokens-initialize-workspace (workspace) - "Initialize semantic tokens for WORKSPACE." - (cl-assert workspace) - (-let (((&plist :token-types types :token-modifiers modifiers) - (lsp--semantic-tokens-as-defined-by-workspace workspace)) - (client (lsp--workspace-client workspace))) - (setf (lsp--workspace-semantic-tokens-faces workspace) - (lsp--semantic-tokens-build-face-map - types (lsp-semantic-tokens--type-faces-for client) - "semantic token" "lsp-semantic-token-faces")) - (setf (lsp--workspace-semantic-tokens-modifier-faces workspace) - (lsp--semantic-tokens-build-face-map - modifiers (lsp-semantic-tokens--modifier-faces-for client) - "semantic token modifier" "lsp-semantic-token-modifier-faces")))) - -;;;###autoload -(defun lsp-semantic-tokens--warn-about-deprecated-setting () - "Warn about deprecated semantic highlighting variable." - (when (boundp 'lsp-semantic-highlighting) - (pcase lsp-semantic-highlighting - (:semantic-tokens - (lsp-warn "It seems you wish to use semanticTokens-based - highlighting. To do so, please remove any references to the - deprecated variable `lsp-semantic-highlighting' from your - configuration and set `lsp-semantic-tokens-enable' to `t' - instead.") - (setq lsp-semantic-tokens-enable t)) - ((or :immediate :deferred) - (lsp-warn "It seems you wish to use Theia-based semantic - highlighting. This protocol has been superseded by the - semanticTokens protocol specified by LSP v3.16 and is no longer - supported by lsp-mode. If your language server provides - semanticToken support, please set - `lsp-semantic-tokens-enable' to `t' to use it."))))) - -;;;###autoload -(defun lsp-semantic-tokens--enable () - "Enable semantic tokens mode." - (when (and lsp-semantic-tokens-enable - (lsp-feature? "textDocument/semanticTokensFull")) - (lsp-semantic-tokens--warn-about-deprecated-setting) - (lsp-semantic-tokens-mode 1))) - -(defun lsp-semantic-tokens--disable () - "Disable semantic tokens mode." - (lsp-semantic-tokens-mode -1)) - -;;;###autoload -(define-minor-mode lsp-semantic-tokens-mode - "Toggle semantic-tokens support." - :group 'lsp-semantic-tokens - :global nil - (cond - ((and lsp-semantic-tokens-mode (lsp-feature? "textDocument/semanticTokensFull")) - (add-hook 'lsp-configure-hook #'lsp-semantic-tokens--enable nil t) - (add-hook 'lsp-unconfigure-hook #'lsp-semantic-tokens--disable nil t) - (mapc #'lsp--semantic-tokens-initialize-workspace - (lsp--find-workspaces-for "textDocument/semanticTokensFull")) - (lsp--semantic-tokens-initialize-buffer)) - (t - (remove-hook 'lsp-configure-hook #'lsp-semantic-tokens--enable t) - (remove-hook 'lsp-unconfigure-hook #'lsp-semantic-tokens--disable t) - (when lsp--semantic-tokens-teardown - (funcall lsp--semantic-tokens-teardown)) - (lsp-semantic-tokens--request-update) - (setq lsp--semantic-tokens-cache nil - lsp--semantic-tokens-teardown nil)))) - -;; debugging helpers -(defun lsp--semantic-tokens-verify () - "Store current token set and compare with the response to a full token request." - (interactive) - (let ((old-tokens (--> lsp--semantic-tokens-cache (plist-get it :response) (lsp-get it :data))) - (old-version (--> lsp--semantic-tokens-cache (plist-get it :_documentVersion)))) - (if (not (equal lsp--cur-version old-version)) - (message "Stored documentVersion %d differs from current version %d" old-version lsp--cur-version) - (lsp-request-async - "textDocument/semanticTokens/full" `(:textDocument ,(lsp--text-document-identifier)) - (lambda (response) - (let ((new-tokens (lsp-get response :data))) - (if (equal old-tokens new-tokens) - (message "New tokens (total count %d) are identical to previously held token set" - (length new-tokens)) - (message "Newly returned tokens differ from old token set") - (print old-tokens) - (print new-tokens)))) - :mode 'tick - :cancel-token (format "semantic-tokens-%s" (lsp--buffer-uri)))))) - -(defvar-local lsp-semantic-tokens--log '()) - -(defvar-local lsp-semantic-tokens--prev-response nil) - -(defun lsp-semantic-tokens--log-buffer-contents (tag) - "Log buffer contents for TAG." - (save-restriction - (save-excursion - (widen) (push `(:tag ,tag - :buffer-contents ,(buffer-substring (point-min) (point-max)) - :prev-response ,lsp-semantic-tokens--prev-response) - lsp-semantic-tokens--log)))) - -(defun lsp-semantic-tokens-enable-log () - "Enable logging of intermediate fontification states. - -This is a debugging tool, and may incur significant performance penalties." - (setq lsp-semantic-tokens--log '()) - (defun lsp-advice-tokens-fontify (orig-func old-fontify-region beg-orig end-orig &optional loudly) - (lsp-semantic-tokens--log-buffer-contents 'before) - (let ((result (funcall orig-func old-fontify-region beg-orig end-orig loudly))) - (lsp-semantic-tokens--log-buffer-contents 'after) - result)) - (advice-add 'lsp-semantic-tokens--fontify :around 'lsp-advice-tokens-fontify) - - (defun lsp-log-delta-response (response) - (setq lsp-semantic-tokens--prev-response `(:request-type "delta" - :response ,response - :version ,lsp--cur-version))) - (advice-add 'lsp--semantic-tokens-ingest-full/delta-response :before 'lsp-log-delta-response) - - (defun lsp-log-full-response (response) - (setq lsp-semantic-tokens--prev-response `(:request-type "full" - :response ,response - :version ,lsp--cur-version))) - (advice-add 'lsp--semantic-tokens-ingest-full-response :before 'lsp-log-full-response) - - (defun lsp-log-range-response (response) - (setq lsp-semantic-tokens--prev-response `(:request-type "range" - :response ,response - :version ,lsp--cur-version))) - (advice-add 'lsp--semantic-tokens-ingest-range-response :before 'lsp-log-range-response)) - -(defun lsp-semantic-tokens-disable-log () - "Disable logging of intermediate fontification states." - (advice-remove 'lsp-semantic-tokens--fontify 'lsp-advice-tokens-fontify) - (advice-remove 'lsp--semantic-tokens-ingest-full/delta-response 'lsp-log-delta-response) - (advice-remove 'lsp--semantic-tokens-ingest-full-response 'lsp-log-full-response) - (advice-remove 'lsp--semantic-tokens-ingest-range-response 'lsp-log-range-response)) - -(declare-function htmlize-buffer "ext:htmlize") - -(defun lsp-semantic-tokens-export-log () - "Write HTML-formatted snapshots of previous fontification results to /tmp." - (require 'htmlize) - (let* ((outdir (f-join "/tmp" "semantic-token-snapshots")) - (progress-reporter - (make-progress-reporter - (format "Writing buffer snapshots to %s..." outdir) - 0 (length lsp-semantic-tokens--log)))) - (f-mkdir outdir) - (--each-indexed (reverse lsp-semantic-tokens--log) - (-let* (((&plist :tag tag - :buffer-contents buffer-contents - :prev-response prev-response) it) - (html-buffer)) - ;; FIXME: doesn't update properly; sit-for helps... somewhat, - ;; but unreliably - (when (= (% it-index 5) 0) - (progress-reporter-update progress-reporter it-index) - (sit-for 0.01)) - ;; we're emitting 2 snapshots (before & after) per update, so request - ;; parameters should only change on every 2nd invocation - (when (cl-evenp it-index) - (with-temp-buffer - (insert (prin1-to-string prev-response)) - (write-file (f-join outdir (format "parameters_%d.el" (/ it-index 2)))))) - (with-temp-buffer - (insert buffer-contents) - (setq html-buffer (htmlize-buffer)) - (with-current-buffer html-buffer - ;; some configs such as emacs-doom may autoformat on save; switch to - ;; fundamental-mode to avoid this - (fundamental-mode) - (write-file (f-join outdir (format "buffer_%d_%s.html" (/ it-index 2) tag))))) - (kill-buffer html-buffer))) - (progress-reporter-done progress-reporter))) - -(lsp-consistency-check lsp-semantic-tokens) - -(provide 'lsp-semantic-tokens) -;;; lsp-semantic-tokens.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-sqls.el b/emacs/elpa/lsp-mode-20241113.743/lsp-sqls.el @@ -1,201 +0,0 @@ -;;; lsp-sqls.el --- SQL Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 Shunya Ishii - -;; Author: Shunya Ishii -;; Keywords: sql lsp - -;; 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: - -;; LSP client for SQL - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-sqls nil - "LSP support for SQL, using sqls." - :group 'lsp-mode - :link '(url-link "https://github.com/sqls-server/sqls") - :package-version `(lsp-mode . "7.0")) - -(defcustom lsp-sqls-server "sqls" - "Path to the `sqls` binary." - :group 'lsp-sqls - :risky t - :type 'file - :package-version `(lsp-mode . "7.0")) - -(defcustom lsp-sqls-workspace-config-path "workspace" - "If non-nil then setup workspace configuration with json file path." - :group 'lsp-sqls - :risky t - :type '(choice (const "workspace") - (const "root")) - :package-version `(lsp-mode . "7.0")) - -(defun lsp-sqls--make-launch-cmd () - (-let [base `(,lsp-sqls-server)] - ;; we can add some options to command. (e.g. "-config") - base)) - - -(defcustom lsp-sqls-timeout 0.5 - "Timeout to use for `sqls' requests." - :type 'number - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-sqls-connections nil - "The connections to the SQL server(s)." - :type '(repeat (alist :key-type (choice - (const :tag "Driver" driver) - (const :tag "Connection String" dataSourceName)) - :value-type string))) - -(defun lsp-sqls-setup-workspace-configuration () - "Setup workspace configuration using json file. -Depending on `lsp-sqls-workspace-config-path'." - - (if lsp-sqls-connections - (lsp--set-configuration `(:sqls (:connections ,(apply #'vector lsp-sqls-connections)))) - (when-let ((config-json-path (cond - ((equal lsp-sqls-workspace-config-path "workspace") - ".sqls/config.json") - ((equal lsp-sqls-workspace-config-path "root") - (-> (lsp-workspace-root) - (f-join ".sqls/config.json")))))) - (when (file-exists-p config-json-path) - (lsp--set-configuration (lsp--read-json-file config-json-path)))))) - -(defun lsp-sqls--show-results (result) - (with-current-buffer (get-buffer-create "*sqls results*") - (with-help-window (buffer-name) - (erase-buffer) - (insert result)))) - -(defun lsp-sql-execute-query (&optional command start end) - "Execute COMMAND on buffer text against current database. -Buffer text is between START and END. If START and END are nil, -use the current region if set, otherwise the entire buffer." - (interactive) - (lsp-sqls--show-results - (lsp-request - "workspace/executeCommand" - (list :command "executeQuery" - :arguments (or - (when command - (lsp:command-arguments? command)) - (vector (lsp--buffer-uri))) - :timeout lsp-sqls-timeout - :range (list - :start (lsp--point-to-position - (cond - (start start) - ((use-region-p) (region-beginning)) - (t (point-min)))) - :end (lsp--point-to-position - (cond - (end end) - ((use-region-p) (region-end)) - (t (point-max))))))))) - -(defun lsp-sql-execute-paragraph (&optional command) - "Execute COMMAND on paragraph against current database." - (interactive) - (let ((start (save-excursion (backward-paragraph) (point))) - (end (save-excursion (forward-paragraph) (point)))) - (lsp-sql-execute-query command start end))) - -(defun lsp-sql-show-databases (&optional _command) - "Show databases." - (interactive) - (lsp-sqls--show-results - (lsp-request - "workspace/executeCommand" - (list :command "showDatabases" :timeout lsp-sqls-timeout)))) - -(defun lsp-sql-show-schemas (&optional _command) - "Show schemas." - (interactive) - (lsp-sqls--show-results - (lsp-request - "workspace/executeCommand" - (list :command "showSchemas" :timeout lsp-sqls-timeout)))) - -(defun lsp-sql-show-connections (&optional _command) - "Show connections." - (interactive) - (lsp-sqls--show-results - (lsp-request - "workspace/executeCommand" - (list :command "showConnections" :timeout lsp-sqls-timeout)))) - -(defun lsp-sql-show-tables (&optional _command) - "Show tables." - (interactive) - (lsp-sqls--show-results - (lsp-request - "workspace/executeCommand" - (list :command "showTables" :timeout lsp-sqls-timeout)))) - -(defun lsp-sql-switch-database (&optional _command) - "Switch database." - (interactive) - (lsp-workspace-command-execute - "switchDatabase" - (vector (completing-read - "Select database: " - (s-lines (lsp-workspace-command-execute "showDatabases")) - nil - t)))) - -(defun lsp-sql-switch-connection (&optional _command) - "Switch connection." - (interactive) - (lsp-workspace-command-execute - "switchConnections" - (vector (cl-first - (s-match "\\([[:digit:]]*\\)" - (completing-read - "Select connection: " - (s-lines (lsp-workspace-command-execute "showConnections")) - nil - t)))))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection #'lsp-sqls--make-launch-cmd) - :major-modes '(sql-mode) - :priority -2 - :action-handlers (ht ("executeParagraph" #'lsp-sql-execute-paragraph) - ("executeQuery" #'lsp-sql-execute-query) - ("showDatabases" #'lsp-sql-show-databases) - ("showSchemas" #'lsp-sql-show-schemas) - ("showConnections" #'lsp-sql-show-connections) - ("showTables" #'lsp-sql-show-tables) - ("switchDatabase" #'lsp-sql-switch-database) - ("switchConnections" #'lsp-sql-switch-connection)) - :server-id 'sqls - :initialized-fn (lambda (workspace) - (-> workspace - (lsp--workspace-server-capabilities) - (lsp:set-server-capabilities-execute-command-provider? t)) - (with-lsp-workspace workspace - (lsp-sqls-setup-workspace-configuration))))) - -(lsp-consistency-check lsp-sqls) - -(provide 'lsp-sqls) -;;; lsp-sqls.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-typespec.el b/emacs/elpa/lsp-mode-20241113.743/lsp-typespec.el @@ -1,87 +0,0 @@ -;;; lsp-typespec.el --- Typespec Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2024 jeremy.ymeng@gmail.com - -;; Author: Jeremy Meng <jeremy.ymeng@gmail.com> -;; Keywords: languages,tools - -;; 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: - -;; lsp-typespec client - -;;; Code: - -(require 'lsp-mode) -(require 'lsp-semantic-tokens) - -(defgroup lsp-typespec nil - "LSP support for Typespec." - :link '(url-link "https://github.com/microsoft/typespec/blob/9c95ccda8c84c7c6afa24b2f4b21cf1ecbe680dd/packages/compiler/cmd/tsp-server.js") - :group 'lsp-mode - :tag "Lsp Typespec") - -(defcustom lsp-typespec-custom-server-command nil - "The typespec-lisp server command." - :group 'lsp-typespec - :risky t - :type '(repeat string)) - -(lsp-dependency - 'typespec-lsp - '(:npm :package "@typespec/compiler" - :path "tsp-server") - '(:system "tsp-server")) - -(defun lsp-typespec--server-executable-path () - "Return the typespec-lsp server command." - (or - (when-let ((workspace-folder (lsp-find-session-folder (lsp-session) default-directory))) - (let ((tsp-server-local-path (f-join workspace-folder "node_modules" ".bin" - (if (eq system-type 'windows-nt) "tsp-server.cmd" "tsp-server")))) - (when (f-exists? tsp-server-local-path) - tsp-server-local-path))) - (executable-find "tsp-server") - (lsp-package-path 'tsp-server) - "tsp-server")) - -(lsp-register-client - (make-lsp-client - :semantic-tokens-faces-overrides '(:types (("docCommentTag" . font-lock-keyword-face) - ("event" . default))) - :new-connection (lsp-stdio-connection `(,(lsp-typespec--server-executable-path) "--stdio")) - :activation-fn (lsp-activate-on "typespec") - :major-modes '(typespec-mode) - :server-id 'typespec-lsp)) - -(lsp-consistency-check lsp-typespec) - -(defun lsp-typespec-semantic-tokens-refresh (&rest _) - "Force refresh semantic tokens." - (when-let ((workspace (and lsp-semantic-tokens-enable - (lsp-find-workspace 'typespec-lsp (buffer-file-name))))) - (--each (lsp--workspace-buffers workspace) - (when (lsp-buffer-live-p it) - (lsp-with-current-buffer it - (lsp-semantic-tokens--enable)))))) - -(with-eval-after-load 'typespec - (when lsp-semantic-tokens-enable - ;; refresh tokens - (add-hook 'typespec-mode-hook #'lsp-typespec-semantic-tokens-refresh))) - -(provide 'lsp-typespec) -;;; lsp-typespec.el ends here - diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-volar.el b/emacs/elpa/lsp-mode-20241113.743/lsp-volar.el @@ -1,152 +0,0 @@ -;;; lsp-volar.el --- A lsp-mode client for Vue3 -*- lexical-binding: t; -*- -;; -;; Copyright (C) 2021 JadeStrong -;; -;; Author: JadeStrong <https://github.com/jadestrong> -;; Maintainer: JadeStrong <jadestrong@163.com> -;; Created: November 08, 2021 -;; Modified: November 08, 2021 -;; Keywords: abbrev bib c calendar comm convenience data docs emulations extensions faces files frames games hardware help hypermedia i18n internal languages lisp local maint mail matching mouse multimedia news outlines processes terminals tex tools unix vc wp -;; Homepage: https://github.com/jadestrong/lsp-volar -;; Package-Requires: ((emacs "25.1")) -;; -;; This file is not part of GNU Emacs. - -;; This file 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. - -;; For a full copy of the GNU General Public License -;; see <http://www.gnu.org/licenses/>. - -;; -;;; Commentary: -;; -;; provide the connection to lsp-mode and volar language server -;; -;;; Code: -(require 'lsp-mode) -(require 'json) - -(defgroup lsp-volar nil - "Lsp support for vue3." - :group 'lsp-mode - :link '(url-link "https://github.com/vuejs/language-tools") - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-volar-take-over-mode t - "Enable Take Over Mode." - :type 'boolean - :group 'lsp-volar - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-volar-hybrid-mode nil - "Enable Hybrid Mode." - :type 'boolean - :group 'lsp-volar - :package-version '(lsp-mode . "9.0.1")) - -(defcustom lsp-volar-activate-file ".volarrc" - "A file with a custom name placed in WORKSPACE-ROOT is used to force enable - volar when there is no package.json in the WORKSPACE-ROOT." - :type 'string - :group 'lsp-volar - :package-version '(lsp-mode . "9.0.0")) - -(defconst lsp-volar--is-windows (memq system-type '(cygwin windows-nt ms-dos))) -(defun lsp-volar-get-typescript-tsdk-path () - "Get tsserver lib*.d.ts directory path." - (if-let ((package-path (lsp-package-path 'typescript)) - (system-tsdk-path (f-join (file-truename package-path) - (if lsp-volar--is-windows - "../node_modules/typescript/lib" - "../../lib"))) - ((file-exists-p system-tsdk-path))) - system-tsdk-path - (prog1 "" - (lsp--error "[lsp-volar] Typescript is not detected correctly. Please ensure the npm package typescript is installed in your project or system (npm install -g typescript), otherwise open an issue")))) - -(lsp-dependency 'typescript - '(:system "tsserver") - '(:npm :package "typescript" - :path "tsserver")) - -(lsp-dependency 'volar-language-server - '(:system "vue-language-server") - '(:npm :package "@vue/language-server" :path "vue-language-server")) - -(lsp-register-custom-settings - '(("typescript.tsdk" - (lambda () - (if-let ((project-root (lsp-workspace-root)) - (tsdk-path (f-join project-root "node_modules/typescript/lib")) - ((file-exists-p tsdk-path))) - tsdk-path - (lsp-volar-get-typescript-tsdk-path))) - t))) - -(lsp-register-custom-settings - '(("vue.hybridMode" lsp-volar-hybrid-mode t))) - -(defun lsp-volar--vue-project-p (workspace-root) - "Check if the `Vue' package is present in the package.json file -in the WORKSPACE-ROOT." - (if-let ((package-json (f-join workspace-root "package.json")) - (exist (f-file-p package-json)) - (config (json-read-file package-json)) - (dependencies (alist-get 'dependencies config))) - (alist-get 'vue (append dependencies (alist-get 'devDependencies config))) - nil)) - -(defun lsp-volar--activate-p (filename &optional _) - "Check if the volar-language-server should be enabled base on FILENAME." - (if lsp-volar-take-over-mode - (or (or - (and (lsp-workspace-root) (lsp-volar--vue-project-p (lsp-workspace-root))) - (and (lsp-workspace-root) lsp-volar-activate-file (f-file-p (f-join (lsp-workspace-root) lsp-volar-activate-file)))) - (or (or (string-match-p "\\.mjs\\|\\.[jt]sx?\\'" filename) - (and (derived-mode-p 'js-mode 'typescript-mode 'typescript-ts-mode) - (not (derived-mode-p 'json-mode)))) - (string= (file-name-extension filename) "vue"))) - (string= (file-name-extension filename) "vue"))) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection - (lambda () - `(,(lsp-package-path 'volar-language-server) "--stdio"))) - :activation-fn 'lsp-volar--activate-p - :priority 0 - :multi-root nil - :server-id 'vue-semantic-server - :initialization-options (lambda () (ht-merge (lsp-configuration-section "typescript") - (lsp-configuration-section "vue") - (ht ("serverMode" 0) - ("diagnosticModel" 1) - ("textDocumentSync" 2)))) - :initialized-fn (lambda (workspace) - (with-lsp-workspace workspace - (lsp--server-register-capability - (lsp-make-registration - :id "random-id" - :method "workspace/didChangeWatchedFiles" - :register-options? (lsp-make-did-change-watched-files-registration-options - :watchers - `[,(lsp-make-file-system-watcher :glob-pattern "**/*.js") - ,(lsp-make-file-system-watcher :glob-pattern "**/*.ts") - ,(lsp-make-file-system-watcher :glob-pattern "**/*.vue") - ,(lsp-make-file-system-watcher :glob-pattern "**/*.jsx") - ,(lsp-make-file-system-watcher :glob-pattern "**/*.tsx") - ,(lsp-make-file-system-watcher :glob-pattern "**/*.json")]))))) - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'volar-language-server - callback error-callback)))) - -(provide 'lsp-volar) -;;; lsp-volar.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-volar.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-volar.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-yaml.el b/emacs/elpa/lsp-mode-20241113.743/lsp-yaml.el @@ -1,247 +0,0 @@ -;;; lsp-yaml.el --- LSP YAML server integration -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Aya Igarashi - -;; Author: Aya Igarashi <ladiclexxx@gmail.com> -;; Keywords: - -;; 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: - -;; - -;;; Code: - -(require 'lsp-mode) -(require 'dash) - -(defgroup lsp-yaml nil - "LSP support for YAML, using yaml-language-server." - :group 'lsp-mode - :link '(url-link "https://github.com/redhat-developer/yaml-language-server") - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-yaml-format-enable t - "Enable/disable default YAML formatter." - :type 'boolean - :group 'lsp-yaml - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-yaml-single-quote nil - "Use single quote instead of double quotes." - :type 'boolean - :group 'lsp-yaml - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-yaml-bracket-spacing t - "Print spaces between brackets in objects." - :type 'boolean - :group 'lsp-yaml - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-yaml-prose-wrap "preserve" - "Options for prose-wrap. - Always: wrap prose if it exceeds the print width. - Never: never wrap the prose. - Preserve: wrap prose as-is." - :type '(choice - (const "always") - (const "never") - (const "preserve")) - :group 'lsp-yaml - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-yaml-print-width 80 - "Specify the line length that the printer will wrap on." - :type 'number - :group 'lsp-yaml - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-yaml-validate t - "Enable/disable validation feature." - :type 'boolean - :group 'lsp-yaml - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-yaml-hover t - "Enable/disable hover feature." - :type 'boolean - :group 'lsp-yaml - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-yaml-completion t - "Enable/disable completion feature." - :type 'boolean - :group 'lsp-yaml - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-yaml-schemas '() - "Associate schemas to YAML files in a glob pattern." - :type '(alist :key-type (symbol :tag "schema") :value-type (lsp-string-vector :tag "files (glob)")) - :group 'lsp-yaml - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-yaml-schema-store-enable t - "Enable/disable JSON Schema store. When set to true, available YAML - schemas will be automatically pulled from the store." - :type 'boolean - :group 'lsp-yaml - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-yaml-custom-tags nil - "Custom tags for the parser to use." - :type '(lsp-repeatable-vector string) - :group 'lsp-yaml - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-yaml-schema-store-uri "https://www.schemastore.org/api/json/catalog.json" - "URL of schema store catalog to use." - :type 'string - :group 'lsp-yaml) - -(defcustom lsp-yaml-schema-store-local-db (expand-file-name - (locate-user-emacs-file - (f-join ".cache" "lsp" "lsp-yaml-schemas.json"))) - "Cached database of schema store." - :type 'file - :group 'lsp-yaml) - -(defcustom lsp-yaml-max-items-computed 5000 - "The maximum number of outline symbols and folding regions computed. -Limited for performance reasons." - :type 'number - :group 'lsp-yaml - :package-version '(lsp-mode . "8.0.0")) - - -(defvar lsp-yaml--schema-store-schemas-alist nil - "A list of schemas fetched from schema stores.") - -(lsp-register-custom-settings - '(("yaml.format.enable" lsp-yaml-format-enable t) - ("yaml.format.singleQuote" lsp-yaml-single-quote t) - ("yaml.format.bracketSpacing" lsp-yaml-bracket-spacing) - ("yaml.format.proseWrap" lsp-yaml-prose-wrap) - ("yaml.format.printWidth" lsp-yaml-print-width) - ("yaml.validate" lsp-yaml-validate t) - ("yaml.hover" lsp-yaml-hover t) - ("yaml.completion" lsp-yaml-completion t) - ("yaml.schemas" lsp-yaml-schemas) - ("yaml.schemaStore.enable" lsp-yaml-schema-store-enable t) - ("yaml.schemaStore.url" lsp-yaml-schema-store-uri) - ("yaml.customTags" lsp-yaml-custom-tags) - ("yaml.maxItemsComputed" lsp-yaml-max-items-computed))) - -(defcustom lsp-yaml-server-command '("yaml-language-server" "--stdio") - "Command to start yaml-languageserver." - :type '(repeat string) - :group 'lsp-yaml - :package-version '(lsp-mode . "6.2")) - -(lsp-dependency 'yaml-language-server - '(:system "yaml-language-server") - '(:npm :package "yaml-language-server" - :path "yaml-language-server")) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection - (lambda () - `(,(or (executable-find (cl-first lsp-yaml-server-command)) - (lsp-package-path 'yaml-language-server)) - ,@(cl-rest lsp-yaml-server-command)))) - :activation-fn (lsp-activate-on "yaml") - :priority 0 - :server-id 'yamlls - :initialized-fn (lambda (workspace) - (with-lsp-workspace workspace - (lsp--set-configuration - (lsp-configuration-section "yaml")))) - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'yaml-language-server - callback error-callback)))) - -(defcustom lsp-yaml-schema-extensions '(((name . "Kubernetes v1.30.3") - (description . "Kubernetes v1.30.3 manifest schema definition") - (url . "https://raw.githubusercontent.com/yannh/kubernetes-json-schema/master/v1.30.3-standalone-strict/all.json") - (fileMatch . ["*-k8s.yaml" "*-k8s.yml"]))) - "User defined schemas that extend default schema store. -Used in `lsp-yaml--get-supported-schemas' to supplement schemas provided by -`lsp-yaml-schema-store-uri'." - :type 'list - :group 'lsp-yaml - :package-version '(lsp-mode . "9.0.1")) - -(defun lsp-yaml-download-schema-store-db (&optional force-downloading) - "Download remote schema store at `lsp-yaml-schema-store-uri' into local cache. -Set FORCE-DOWNLOADING to non-nil to force re-download the database." - (interactive "P") - (when (or force-downloading (not (file-exists-p lsp-yaml-schema-store-local-db))) - (unless (file-directory-p (file-name-directory lsp-yaml-schema-store-local-db)) - (mkdir (file-name-directory lsp-yaml-schema-store-local-db) t)) - (url-copy-file lsp-yaml-schema-store-uri lsp-yaml-schema-store-local-db force-downloading))) - -(defun lsp-yaml--get-supported-schemas () - "Get out the list of supported schemas." - (when (and lsp-yaml-schema-store-enable - (not lsp-yaml--schema-store-schemas-alist)) - (lsp-yaml-download-schema-store-db) - (setq lsp-yaml--schema-store-schemas-alist - (alist-get 'schemas (json-read-file lsp-yaml-schema-store-local-db)))) - (seq-concatenate 'list lsp-yaml-schema-extensions lsp-yaml--schema-store-schemas-alist)) - -(defun lsp-yaml-set-buffer-schema (uri-string) - "Set yaml schema for the current buffer to URI-STRING." - (interactive "MURI: ") - (let* ((uri (intern uri-string)) - (workspace-path (file-relative-name - (lsp--uri-to-path (lsp--buffer-uri)) - (lsp-workspace-root (lsp--buffer-uri)))) - (glob (concat "/" workspace-path)) - (current-config (assoc uri lsp-yaml-schemas)) - (current-patterns (and current-config (cdr current-config)))) - (if current-config - (or (member glob (append current-patterns nil)) - (setq lsp-yaml-schemas - (cl-acons uri - (vconcat (vector glob) current-patterns) - (assq-delete-all uri - (mapcar (lambda (x) (lsp-yaml--remove-glob x glob)) - lsp-yaml-schemas))))) - (setq lsp-yaml-schemas - (cl-acons uri (vector glob) (mapcar (lambda (x) (lsp-yaml--remove-glob x glob)) - lsp-yaml-schemas)))) - (lsp--set-configuration (lsp-configuration-section "yaml")))) - -(defun lsp-yaml-select-buffer-schema () - "Select schema for the current buffer based on the list of supported schemas." - (interactive) - (let* ((schema (lsp--completing-read "Select buffer schema: " - (lsp-yaml--get-supported-schemas) - (lambda (schema) - (format "%s: %s" (alist-get 'name schema)(alist-get 'description schema))) - nil t)) - (uri (alist-get 'url schema))) - (lsp-yaml-set-buffer-schema uri))) - -(defun lsp-yaml--remove-glob (mapping glob) - (let ((patterns (cdr mapping))) - (cons (car mapping) - (vconcat (-filter (lambda (p) (not (equal p glob))) - (append patterns nil)) nil)))) - -(lsp-consistency-check lsp-yaml) - -(provide 'lsp-yaml) -;;; lsp-yaml.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-yaml.elc b/emacs/elpa/lsp-mode-20241113.743/lsp-yaml.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-actionscript.el b/emacs/elpa/lsp-mode-20241119.828/lsp-actionscript.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-actionscript.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-actionscript.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-ada.el b/emacs/elpa/lsp-mode-20241119.828/lsp-ada.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-ada.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-ada.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-angular.el b/emacs/elpa/lsp-mode-20241119.828/lsp-angular.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-angular.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-angular.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-ansible.el b/emacs/elpa/lsp-mode-20241119.828/lsp-ansible.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-ansible.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-ansible.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-asm.el b/emacs/elpa/lsp-mode-20241119.828/lsp-asm.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-asm.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-asm.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-astro.el b/emacs/elpa/lsp-mode-20241119.828/lsp-astro.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-astro.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-astro.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-autotools.el b/emacs/elpa/lsp-mode-20241119.828/lsp-autotools.el @@ -0,0 +1,78 @@ +;;; lsp-autotools.el --- Support configure.ac, Makefile.am, Makefile -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Jen-Chieh Shen + +;; Author: Jen-Chieh Shen <jcs090218@gmail.com> +;; Keywords: autotools lsp + +;; 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: + +;; Support configure.ac, Makefile.am, Makefile + +;;; Code: + +(require 'lsp-mode) + +(defgroup lsp-autotools nil + "LSP support for Autotools." + :group 'lsp-mode + :link '(url-link "https://github.com/Freed-Wu/autotools-language-server") + :package-version `(lsp-mode . "9.0.0")) + +(defcustom lsp-autotools-active-modes + '( autoconf-mode + makefile-mode + makefile-automake-mode + makefile-gmake-mode + makefile-makepp-mode + makefile-bsdmake-mode + makefile-imake-mode) + "List of major mode that work with Autotools." + :type '(list symbol) + :group 'lsp-autotools) + +(defun lsp-autotools--download-server (_client callback error-callback update?) + "Install/update Autotools language server using `pip + +Will invoke CALLBACK or ERROR-CALLBACK based on result. +Will update if UPDATE? is t." + (lsp-async-start-process + callback + error-callback + "pip" "install" "autotools-language-server" (when update? "-U"))) + +(defun lsp-autotools--server-command () + "Startup command for Autotools language server." + (list "autotools-language-server")) + +(defun lsp-autotools--test-present () + "Return non-nil if Autotools language server is installed globally." + (executable-find "autotools-language-server")) + +(lsp-register-client + (make-lsp-client + :new-connection (lsp-stdio-connection + #'lsp-autotools--server-command + #'lsp-autotools--test-present) + :major-modes lsp-autotools-active-modes + :priority -1 + :server-id 'autotools-ls + :download-server-fn #'lsp-autotools--download-server)) + +(lsp-consistency-check lsp-autotools) + +(provide 'lsp-autotools) +;;; lsp-autotools.el ends here diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-autotools.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-autotools.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-awk.el b/emacs/elpa/lsp-mode-20241119.828/lsp-awk.el @@ -0,0 +1,49 @@ +;;; lsp-awk.el --- AWK client -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 emacs-lsp maintainers + +;; Author: Konstantin Kharlamov <Hi-Angel@yandex.ru> +;; Keywords: languages lsp awk + +;; 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: +;; +;; LSP client for AWK language. +;; + +;;; Code: + +(require 'lsp-mode) + +(defgroup lsp-awk nil + "LSP support for AWK." + :group 'lsp-mode + :link '(url-link "https://github.com/Beaglefoot/awk-language-server")) + +(defcustom lsp-awk-executable '("awk-language-server") + "Command to run the AWK language server." + :group 'lsp-awk + :risky t + :type '(list string)) + +(lsp-register-client + (make-lsp-client + :new-connection (lsp-stdio-connection (lambda () lsp-awk-executable)) + :activation-fn (lsp-activate-on "awk") + :priority -1 + :server-id 'awkls)) + +(provide 'lsp-awk) +;;; lsp-awk.el ends here diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-awk.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-awk.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-bash.el b/emacs/elpa/lsp-mode-20241119.828/lsp-bash.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-bash.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-bash.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-beancount.el b/emacs/elpa/lsp-mode-20241119.828/lsp-beancount.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-beancount.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-beancount.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-bufls.el b/emacs/elpa/lsp-mode-20241119.828/lsp-bufls.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-bufls.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-bufls.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-camel.el b/emacs/elpa/lsp-mode-20241119.828/lsp-camel.el @@ -0,0 +1,67 @@ +;;; lsp-camel.el --- LSP Camel server integration -*- lexical-binding: t; -*- + + +;;; Code: + +(require 'lsp-mode) + +(defgroup lsp-camel nil + "LSP support for Camel, using camel-language-server" + :group 'lsp-mode + :tag "Language Server" + :package-version '(lsp-mode . "9.0.0")) + +;; Define a variable to store camel language server jar version +(defconst lsp-camel-jar-version "1.5.0") + +;; Define a variable to store camel language server jar name +(defconst lsp-camel-jar-name (format "camel-lsp-server-%s.jar" lsp-camel-jar-version)) + +;; Directory in which the servers will be installed. Lsp Server Install Dir: ~/.emacs.d/.cache/camells +(defcustom lsp-camel-jar-file (f-join lsp-server-install-dir "camells" lsp-camel-jar-name) + "Camel Language server jar command." + :group 'lsp-camel + :type 'file + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-camel-jar-download-url + (format "https://repo1.maven.org/maven2/com/github/camel-tooling/camel-lsp-server/%s/%s" lsp-camel-jar-version lsp-camel-jar-name) + "Automatic download url for lsp-camel." + :type 'string + :group 'lsp-camel + :package-version '(lsp-mode . "9.0.0")) + +(lsp-dependency + 'camells + '(:system lsp-camel-jar-file) + `(:download :url lsp-camel-jar-download-url + :store-path lsp-camel-jar-file)) + +(defcustom lsp-camel-server-command `("java" "-jar" , lsp-camel-jar-file) + "Camel server command." + :type '(repeat string) + :group 'lsp-camel + :package-version '(lsp-mode . "9.0.0")) + +(defun lsp-camel--create-connection () + (lsp-stdio-connection + (lambda () lsp-camel-server-command) + (lambda () (f-exists? lsp-camel-jar-file)))) + +(lsp-register-client + (make-lsp-client :new-connection (lsp-camel--create-connection) + :activation-fn (lsp-activate-on "xml" "java") + :priority 0 + :server-id 'camells + :add-on? t + :multi-root t + :initialized-fn (lambda (workspace) + (with-lsp-workspace workspace + (lsp--set-configuration (lsp-configuration-section "camel")))) + :download-server-fn (lambda (_client callback error-callback _update?) + (lsp-package-ensure 'camells callback error-callback)))) + +(lsp-consistency-check lsp-camel) + +(provide 'lsp-camel) +;;; lsp-camel.el ends here diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-camel.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-camel.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-clangd.el b/emacs/elpa/lsp-mode-20241119.828/lsp-clangd.el @@ -0,0 +1,318 @@ +;;; lsp-clangd.el --- LSP clients for the C Languages Family -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Daniel Martin & emacs-lsp maintainers +;; URL: https://github.com/emacs-lsp/lsp-mode +;; Keywords: languages, c, cpp, clang + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; LSP clients for the C Languages Family. + +;; ** Clang-tidy Flycheck integration (Clangd) ** +;; +;; If you invoke `flycheck-display-error-explanation' on a +;; `clang-tidy' error (if Clangd is configured to show `clang-tidy' +;; diagnostics), Emacs will open a detailed explanation about the +;; message by querying the LLVM website. As an embedded web browser is +;; used to show the documentation, this feature requires that Emacs is +;; compiled with libxml2 support. + +;;; Code: + +(require 'lsp-mode) +(require 'cl-lib) +(require 'rx) +(require 'seq) +(require 'dom) +(eval-when-compile (require 'subr-x)) + +(require 'dash) +(require 's) + +(defvar flycheck-explain-error-buffer) +(declare-function flycheck-error-id "ext:flycheck" (err) t) +(declare-function flycheck-error-group "ext:flycheck" (err) t) +(declare-function flycheck-error-message "ext:flycheck" (err) t) + +(defcustom lsp-clangd-version "15.0.6" + "Clangd version to download. +It has to be set before `lsp-clangd.el' is loaded and it has to +be available here: https://github.com/clangd/clangd/releases/" + :type 'string + :group 'lsp-clangd + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-clangd-download-url + (format (pcase system-type + ('darwin "https://github.com/clangd/clangd/releases/download/%s/clangd-mac-%s.zip") + ('windows-nt "https://github.com/clangd/clangd/releases/download/%s/clangd-windows-%s.zip") + (_ "https://github.com/clangd/clangd/releases/download/%s/clangd-linux-%s.zip")) + lsp-clangd-version + lsp-clangd-version) + "Automatic download url for clangd" + :type 'string + :group 'lsp-clangd + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-clangd-binary-path + (f-join lsp-server-install-dir (format "clangd/clangd_%s/bin" + lsp-clangd-version) + (pcase system-type + ('windows-nt "clangd.exe") + (_ "clangd"))) + "The path to `clangd' binary." + :type 'file + :group 'lsp-clangd + :package-version '(lsp-mode . "8.0.0")) + +(lsp-dependency + 'clangd + `(:download :url lsp-clangd-download-url + :decompress :zip + :store-path ,(f-join lsp-server-install-dir "clangd" "clangd.zip") + :binary-path lsp-clangd-binary-path + :set-executable? t)) + +(defun lsp-cpp-flycheck-clang-tidy--skip-http-headers () + "Position point just after HTTP headers." + (re-search-forward "^$")) + +(defun lsp-cpp-flycheck-clang-tidy--narrow-to-http-body () + "Narrow the current buffer to contain the body of an HTTP response." + (lsp-cpp-flycheck-clang-tidy--skip-http-headers) + (narrow-to-region (point) (point-max))) + +(defun lsp-cpp-flycheck-clang-tidy--decode-region-as-utf8 (start end) + "Decode a region from START to END in UTF-8." + (condition-case nil + (decode-coding-region start end 'utf-8) + (coding-system-error nil))) + +(defun lsp-cpp-flycheck-clang-tidy--remove-crlf () + "Remove carriage return and line feeds from the current buffer." + (save-excursion + (while (re-search-forward "\r$" nil t) + (replace-match "" t t)))) + +(defun lsp-cpp-flycheck-clang-tidy--extract-relevant-doc-section () + "Extract the parts of the LLVM clang-tidy documentation that are relevant. + +This function assumes that the current buffer contains the result +of browsing `clang.llvm.org', as returned by `url-retrieve'. +More concretely, this function returns the main <div> element +with class `section', and also removes `headerlinks'." + (goto-char (point-min)) + (lsp-cpp-flycheck-clang-tidy--narrow-to-http-body) + (lsp-cpp-flycheck-clang-tidy--decode-region-as-utf8 (point-min) (point-max)) + (lsp-cpp-flycheck-clang-tidy--remove-crlf) + (let* ((dom (libxml-parse-html-region (point-min) (point-max))) + (section (dom-by-class dom "section"))) + (dolist (headerlink (dom-by-class section "headerlink")) + (dom-remove-node section headerlink)) + section)) + +(defun lsp-cpp-flycheck-clang-tidy--explain-error (explanation &rest args) + "Explain an error in the Flycheck error explanation buffer using EXPLANATION. + +EXPLANATION is a function with optional ARGS that, when +evaluated, inserts the content in the appropriate Flycheck +buffer." + (with-current-buffer flycheck-explain-error-buffer + (let ((inhibit-read-only t) + (inhibit-modification-hooks t)) + (erase-buffer) + (apply explanation args) + (goto-char (point-min))))) + +(defun lsp-cpp-flycheck-clang-tidy--show-loading-status () + "Show a loading string while clang-tidy documentation is fetched from llvm.org. +Recent versions of `flycheck' call `display-message-or-buffer' to +display error explanations. `display-message-or-buffer' displays +the documentation string either in the echo area or in a separate +window, depending on the string's height. This function forces to +always display it in a separate window by appending the required +number of newlines." + (let* ((num-lines-threshold + (round (if resize-mini-windows + (cond ((floatp max-mini-window-height) + (* (frame-height) + max-mini-window-height)) + ((integerp max-mini-window-height) + max-mini-window-height) + (t + 1)) + 1))) + (extra-new-lines (make-string (1+ num-lines-threshold) ?\n))) + (concat "Loading documentation..." extra-new-lines))) + +(defun lsp-cpp-flycheck-clang-tidy--show-documentation (error-id) + "Show clang-tidy documentation about ERROR-ID. + +Information comes from the clang.llvm.org website." + ;; Example error-id: modernize-loop-convert + ;; Example url: https://clang.llvm.org/extra/clang-tidy/checks/modernize/loop-convert.html + (setq error-id (s-join "/" (s-split-up-to "-" error-id 1 t))) + (url-retrieve (format + "https://clang.llvm.org/extra/clang-tidy/checks/%s.html" error-id) + (lambda (status) + (if-let* ((error-status (plist-get status :error))) + (lsp-cpp-flycheck-clang-tidy--explain-error + #'insert + (format + "Error accessing clang-tidy documentation: %s" + (error-message-string error-status))) + (let ((doc-contents + (lsp-cpp-flycheck-clang-tidy--extract-relevant-doc-section))) + (lsp-cpp-flycheck-clang-tidy--explain-error + #'shr-insert-document doc-contents))))) + (lsp-cpp-flycheck-clang-tidy--show-loading-status)) + +;;;###autoload +(defun lsp-cpp-flycheck-clang-tidy-error-explainer (error) + "Explain a clang-tidy ERROR by scraping documentation from llvm.org." + (unless (fboundp 'libxml-parse-html-region) + (error "This function requires Emacs to be compiled with libxml2")) + (if-let* ((clang-tidy-error-id (flycheck-error-id error))) + (condition-case err + (lsp-cpp-flycheck-clang-tidy--show-documentation clang-tidy-error-id) + (error + (format + "Error accessing clang-tidy documentation: %s" + (error-message-string err)))) + (error "The clang-tidy error message does not contain an [error-id]"))) + + +;;; lsp-clangd +(defgroup lsp-clangd nil + "LSP support for C-family languages (C, C++, Objective-C, Objective-C++, CUDA), using clangd." + :group 'lsp-mode + :link '(url-link "https://clang.llvm.org/extra/clangd")) + +(defcustom lsp-clients-clangd-executable nil + "The clangd executable to use. +When `'non-nil' use the name of the clangd executable file +available in your path to use. Otherwise the system will try to +find a suitable one. Set this variable before loading lsp." + :group 'lsp-clangd + :risky t + :type '(choice (file :tag "Path") + (const :tag "Auto" nil))) + +(defvar lsp-clients--clangd-default-executable nil + "Clang default executable full path when found. +This must be set only once after loading the clang client.") + +(defcustom lsp-clients-clangd-args '("--header-insertion-decorators=0") + "Extra arguments for the clangd executable." + :group 'lsp-clangd + :risky t + :type '(repeat string)) + +(defcustom lsp-clients-clangd-library-directories '("/usr") + "List of directories which will be considered to be libraries." + :risky t + :type '(repeat string) + :group 'lsp-clangd + :package-version '(lsp-mode . "9.0.0")) + +(defun lsp-clients--clangd-command () + "Generate the language server startup command." + (unless lsp-clients--clangd-default-executable + (setq lsp-clients--clangd-default-executable + (or (lsp-package-path 'clangd) + (-first #'executable-find + (-map (lambda (version) + (concat "clangd" version)) + ;; Prefer `clangd` without a version number appended. + (cl-list* "" (-map + (lambda (vernum) (format "-%d" vernum)) + (number-sequence 17 6 -1))))) + (lsp-clients-executable-find "xcodebuild" "-find-executable" "clangd") + (lsp-clients-executable-find "xcrun" "--find" "clangd")))) + + `(,(or lsp-clients-clangd-executable lsp-clients--clangd-default-executable "clangd") + ,@lsp-clients-clangd-args)) + +(lsp-register-client + (make-lsp-client :new-connection (lsp-stdio-connection + 'lsp-clients--clangd-command) + :activation-fn (lsp-activate-on "c" "cpp" "objective-c" "cuda") + :priority -1 + :server-id 'clangd + :library-folders-fn (lambda (_workspace) lsp-clients-clangd-library-directories) + :download-server-fn (lambda (_client callback error-callback _update?) + (lsp-package-ensure 'clangd callback error-callback)))) + +(defun lsp-clangd-join-region (beg end) + "Apply join-line from BEG to END. +This function is useful when an indented function prototype needs +to be shown in a single line." + (save-excursion + (let ((end (copy-marker end))) + (goto-char beg) + (while (< (point) end) + (join-line 1))) + (s-trim (buffer-string)))) + +(cl-defmethod lsp-clients-extract-signature-on-hover (contents (_server-id (eql clangd))) + "Extract a representative line from clangd's CONTENTS, to show in the echo area. +This function tries to extract the type signature from CONTENTS, +or the first line if it cannot do so. A single line is always +returned to avoid that the echo area grows uncomfortably." + (with-temp-buffer + (-let [value (lsp:markup-content-value contents)] + (insert value) + (goto-char (point-min)) + (if (re-search-forward (rx (seq "```cpp\n" + (opt (group "//" + (zero-or-more nonl) + "\n")) + (group + (one-or-more + (not (any "`"))) + "\n") + "```")) nil t nil) + (progn (narrow-to-region (match-beginning 2) (match-end 2)) + (lsp--render-element (lsp-make-marked-string + :language "cpp" + :value (lsp-clangd-join-region (point-min) (point-max))))) + (car (s-lines (lsp--render-element contents))))))) + +(cl-defmethod lsp-diagnostics-flycheck-error-explainer (e (_server-id (eql clangd))) + "Explain a `flycheck-error' E that was generated by the Clangd language server." + (cond ((string-equal "clang-tidy" (flycheck-error-group e)) + (lsp-cpp-flycheck-clang-tidy-error-explainer e)) + (t (flycheck-error-message e)))) + +(defun lsp-clangd-find-other-file (&optional new-window) + "Switch between the corresponding C/C++ source and header file. +If NEW-WINDOW (interactively the prefix argument) is non-nil, +open in a new window. + +Only works with clangd." + (interactive "P") + (let ((other (lsp-send-request (lsp-make-request + "textDocument/switchSourceHeader" + (lsp--text-document-identifier))))) + (unless (s-present? other) + (user-error "Could not find other file")) + (funcall (if new-window #'find-file-other-window #'find-file) + (lsp--uri-to-path other)))) + +(lsp-consistency-check lsp-clangd) + +(provide 'lsp-clangd) +;;; lsp-clangd.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-clangd.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-clangd.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-clojure.el b/emacs/elpa/lsp-mode-20241119.828/lsp-clojure.el @@ -0,0 +1,618 @@ +;;; lsp-clojure.el --- Clojure Client settings -*- lexical-binding: t; -*- + +;; Copyright (C) 2019 Benedek Fazekas + +;; Author: Benedek Fazekas <benedek.fazekas@gmail.com> +;; Keywords: languages,tools + +;; 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: + +;; lsp-clojure client + +;;; Code: + +(require 'lsp-mode) +(require 'lsp-protocol) +(require 'cl-lib) +(require 'lsp-semantic-tokens) + +(defgroup lsp-clojure nil + "LSP support for Clojure." + :link '(url-link "https://github.com/snoe/clojure-lsp") + :group 'lsp-mode + :tag "Lsp Clojure") + +(define-obsolete-variable-alias 'lsp-clojure-server-command + 'lsp-clojure-custom-server-command "lsp-mode 8.0.0") + +(defcustom lsp-clojure-custom-server-command nil + "The clojure-lisp server command." + :group 'lsp-clojure + :risky t + :type '(repeat string)) + +(defcustom lsp-clojure-server-download-url + (format "https://github.com/clojure-lsp/clojure-lsp/releases/latest/download/clojure-lsp-native-%s.zip" + (let ((arch (car (split-string system-configuration "-")))) + (pcase system-type + ('gnu/linux (concat "linux-" + (cond + ((string= "x86_64" arch) "amd64") + (t arch)))) + ('darwin (concat "macos-" + (cond + ((string= "x86_64" arch) "amd64") + (t arch)))) + ('windows-nt "windows-amd64")))) + "Automatic download url for lsp-clojure." + :type 'string + :group 'lsp-clojure + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-clojure-server-store-path + (f-join lsp-server-install-dir + "clojure" + (if (eq system-type 'windows-nt) + "clojure-lsp.exe" + "clojure-lsp")) + "The path to the file in which `clojure-lsp' will be stored." + :type 'file + :group 'lsp-clojure + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-clojure-trace-enable nil + "Enable trace logs between client and clojure-lsp server." + :group 'lsp-clojure + :type 'boolean) + +(defcustom lsp-clojure-workspace-dir (expand-file-name (locate-user-emacs-file "workspace/")) + "LSP clojure workspace directory." + :group 'lsp-clojure + :risky t + :type 'directory) + +(defcustom lsp-clojure-workspace-cache-dir (expand-file-name ".cache/" lsp-clojure-workspace-dir) + "LSP clojure workspace cache directory." + :group 'lsp-clojure + :risky t + :type 'directory) + +(defcustom lsp-clojure-library-dirs (list lsp-clojure-workspace-cache-dir + (expand-file-name "~/.gitlibs/libs")) + "LSP clojure dirs that should be considered library folders." + :group 'lsp-clojure + :type '(list string)) + +(defcustom lsp-clojure-test-tree-position-params nil + "The optional test tree position params. +Defaults to side following treemacs default." + :type 'alist + :group 'lsp-clojure) + +(defcustom lsp-clojure-project-tree-position-params nil + "The optional project tree position params. +Defaults to side following treemacs default." + :type 'alist + :group 'lsp-clojure) + +;; Internal + +(lsp-interface + (Clojure:CursorInfoParams (:textDocument :position) nil)) + +(lsp-dependency + 'clojure-lsp + `(:download :url lsp-clojure-server-download-url + :decompress :zip + :store-path lsp-clojure-server-store-path + :set-executable? t) + '(:system "clojure-lsp")) + +;; Refactorings + +(defun lsp-clojure--execute-command (command &optional args) + "Send an executeCommand request for COMMAND with ARGS." + (lsp--cur-workspace-check) + (lsp-send-execute-command command (apply #'vector args))) + +(defun lsp-clojure--refactoring-call (refactor-name &rest additional-args) + "Send an executeCommand request for REFACTOR-NAME with ADDITIONAL-ARGS. +If there are more arguments expected after the line and column numbers." + (lsp--cur-workspace-check) + (lsp-clojure--execute-command refactor-name (cl-list* (lsp--buffer-uri) + (- (line-number-at-pos) 1) ;; clojure-lsp expects line numbers to start at 0 + (current-column) + additional-args))) + +(defun lsp-clojure-add-import-to-namespace (import-name) + "Add to IMPORT-NAME to :import form." + (interactive "MImport name: ") + (lsp-clojure--refactoring-call "add-import-to-namespace" import-name)) + +(defun lsp-clojure-add-missing-libspec () + "Apply add-missing-libspec refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "add-missing-libspec")) + +(defun lsp-clojure-clean-ns () + "Apply clean-ns refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "clean-ns")) + +(defun lsp-clojure-cycle-coll () + "Apply cycle-coll refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "cycle-coll")) + +(defun lsp-clojure-cycle-privacy () + "Apply cycle-privacy refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "cycle-privacy")) + +(defun lsp-clojure-expand-let () + "Apply expand-let refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "expand-let")) + +(defun lsp-clojure-extract-function (function-name) + "Move form at point into a new function named FUNCTION-NAME." + (interactive "MFunction name: ") ;; Name of the function + (lsp-clojure--refactoring-call "extract-function" function-name)) + +(defun lsp-clojure-inline-symbol () + "Apply inline-symbol refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "inline-symbol")) + +(defun lsp-clojure-introduce-let (binding-name) + "Move form at point into a new let binding as BINDING-NAME." + (interactive "MBinding name: ") ;; Name of the let binding + (lsp-clojure--refactoring-call "introduce-let" binding-name)) + +(defun lsp-clojure-move-to-let (binding-name) + "Move form at point into nearest existing let binding as BINDING-NAME." + (interactive "MBinding name: ") ;; Name of the let binding + (lsp-clojure--refactoring-call "move-to-let" binding-name)) + +(defun lsp-clojure-thread-first () + "Apply thread-first refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "thread-first")) + +(defun lsp-clojure-thread-first-all () + "Apply thread-first-all refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "thread-first-all")) + +(defun lsp-clojure-thread-last () + "Apply thread-last refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "thread-last")) + +(defun lsp-clojure-thread-last-all () + "Apply thread-last-all refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "thread-last-all")) + +(defun lsp-clojure-unwind-all () + "Apply unwind-all refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "unwind-all")) + +(defun lsp-clojure-unwind-thread () + "Apply unwind-thread refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "unwind-thread")) + +(defun lsp-clojure-create-function () + "Apply create-function refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "create-function")) + +(defun lsp-clojure-create-test () + "Apply create-test refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "create-test")) + +(defun lsp-clojure-sort-map () + "Apply sort-map refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "sort-map")) + +(defun lsp-clojure-move-coll-entry-up () + "Apply move coll entry up refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "move-coll-entry-up")) + +(defun lsp-clojure-move-coll-entry-down () + "Apply move coll entry down refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "move-coll-entry-down")) + +(defun lsp-clojure-forward-slurp () + "Apply forward slurp refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "forward-slurp")) + +(defun lsp-clojure-forward-barf () + "Apply forward barf refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "forward-barf")) + +(defun lsp-clojure-backward-slurp () + "Apply backward slurp refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "backward-slurp")) + +(defun lsp-clojure-backward-barf () + "Apply backward slurp refactoring at point." + (interactive) + (lsp-clojure--refactoring-call "backward-barf")) + +(defun lsp-clojure-move-form (dest-filename) + "Apply move-form refactoring at point to DEST-FILENAME." + (interactive + (list (or (read-file-name "Move form to: ") + (user-error "No filename selected. Aborting")))) + (lsp-clojure--refactoring-call "move-form" (expand-file-name dest-filename))) + +(defun lsp-clojure-server-info () + "Request server info." + (interactive) + (lsp--cur-workspace-check) + (lsp-notify "clojure/serverInfo/log" nil)) + +(defvar lsp-clojure-server-buffer-name "*lsp-clojure-server-log*") + +(defun lsp-clojure--server-log-revert-function (original-file-log-buffer &rest _) + "Spit contents to ORIGINAL-FILE-LOG-BUFFER." + (with-current-buffer (get-buffer-create lsp-clojure-server-buffer-name) + (erase-buffer) + (insert (with-current-buffer original-file-log-buffer (buffer-string))) + (goto-char (point-max)) + (read-only-mode))) + +(defun lsp-clojure-server-log () + "Open a buffer with the server logs." + (interactive) + (lsp--cur-workspace-check) + (let* ((log-path (-> (lsp--json-serialize (lsp-request "clojure/serverInfo/raw" nil)) + (lsp--read-json) + (lsp-get :log-path)))) + (with-current-buffer (find-file log-path) + (read-only-mode) + (goto-char (point-max))))) + +(defun lsp-clojure-server-info-raw () + "Request server info raw data." + (interactive) + (lsp--cur-workspace-check) + (message "%s" (lsp--json-serialize (lsp-request "clojure/serverInfo/raw" nil)))) + +(defun lsp-clojure-cursor-info () + "Request cursor info at point." + (interactive) + (lsp--cur-workspace-check) + (lsp-notify "clojure/cursorInfo/log" + (lsp-make-clojure-cursor-info-params + :textDocument (lsp-make-text-document-identifier :uri (lsp--buffer-uri)) + :position (lsp-make-position :line (- (line-number-at-pos) 1) + :character (current-column))))) + +(defun lsp-clojure-resolve-macro-as () + "Ask to user how the unresolved macro should be resolved." + (interactive) + (lsp--cur-workspace-check) + (lsp-clojure--execute-command "resolve-macro-as" + (list (lsp--buffer-uri) + (- (line-number-at-pos) 1) ;; clojure-lsp expects line numbers to start at 0 + (current-column)))) + +(defun lsp-clojure--ensure-dir (path) + "Ensure that directory PATH exists." + (unless (file-directory-p path) + (make-directory path t))) + +(defun lsp-clojure--get-metadata-location (file-location) + "Given a FILE-LOCATION return the file containing the metadata for the file." + (format "%s.%s.metadata" + (file-name-directory file-location) + (file-name-base file-location))) + +(defun lsp-clojure--file-in-jar (uri) + "Check URI for a valid jar and include it in workspace." + (string-match "^\\(jar\\|zip\\):\\(file:.+\\)!/\\(.+\\)" uri) + (let* ((ns-path (match-string 3 uri)) + (ns (s-replace "/" "." ns-path)) + (file-location (concat lsp-clojure-workspace-cache-dir ns))) + (unless (file-readable-p file-location) + (lsp-clojure--ensure-dir (file-name-directory file-location)) + (with-lsp-workspace (lsp-find-workspace 'clojure-lsp nil) + (let ((content (lsp-send-request (lsp-make-request "clojure/dependencyContents" (list :uri uri))))) + (with-temp-file file-location + (insert content)) + (with-temp-file (lsp-clojure--get-metadata-location file-location) + (insert uri))))) + file-location)) + +(defun lsp-clojure--server-executable-path () + "Return the clojure-lsp server command." + (or (executable-find "clojure-lsp") + (lsp-package-path 'clojure-lsp))) + +(lsp-defun lsp-clojure--show-references ((&Command :arguments? args)) + "Show references for command with ARGS. +ARGS is a vector which the first element is the uri, the second the line +and the third the column." + (lsp-show-xrefs + (lsp--locations-to-xref-items + (lsp-request "textDocument/references" + (lsp--make-reference-params + (lsp--text-document-position-params + (list :uri (seq-elt args 0)) + (list :line (1- (seq-elt args 1)) + :character (1- (seq-elt args 2))))))) + nil + t)) + +;; Test tree + +(defvar-local lsp-clojure--test-tree-data nil) +(defconst lsp-clojure--test-tree-buffer-name "*Clojure Test Tree*") + +(defvar treemacs-position) +(defvar treemacs-width) +(declare-function lsp-treemacs-render "ext:lsp-treemacs" (tree title expand-depth &optional buffer-name right-click-actions clear-cache?)) +(declare-function lsp-treemacs--open-file-in-mru "ext:lsp-treemacs" (file)) + +(defun lsp-clojure--test-tree-ret-action (uri range) + "Build the ret action for an item in the test tree view. +URI is the source of the item. +RANGE is the range of positions to where this item should point." + (interactive) + (lsp-treemacs--open-file-in-mru (lsp--uri-to-path uri)) + (goto-char (lsp--position-to-point (lsp:range-start range))) + (run-hooks 'xref-after-jump-hook)) + +(lsp-defun lsp-clojure--test-tree-data->tree (uri (&clojure-lsp:TestTreeNode :name :range :kind :children?)) + "Builds a test tree. +URI is the source of the test tree. +NODE is the node with all test children data." + (-let* ((icon (cl-case kind + (1 'namespace) + (2 'method) + (3 'field))) + (base-tree (list :key name + :label name + :icon icon + :ret-action (lambda (&rest _) (lsp-clojure--test-tree-ret-action uri range)) + :uri uri))) + (if (seq-empty-p children?) + base-tree + (plist-put base-tree :children (seq-map (-partial #'lsp-clojure--test-tree-data->tree uri) children?))))) + +(lsp-defun lsp-clojure--render-test-tree ((&clojure-lsp:TestTreeParams :uri :tree)) + "Render a test tree view for current test tree buffer data." + (save-excursion + (lsp-treemacs-render + (list (lsp-clojure--test-tree-data->tree uri tree)) + "Clojure Test Tree" + t + lsp-clojure--test-tree-buffer-name))) + +(defun lsp-clojure--show-test-tree (ignore-focus?) + "Show a test tree for current buffer. +Focus on it if IGNORE-FOCUS? is nil." + (if lsp-clojure--test-tree-data + (-let* ((tree-buffer (lsp-clojure--render-test-tree lsp-clojure--test-tree-data)) + (position-params (or lsp-clojure-test-tree-position-params + `((side . ,treemacs-position) + (slot . 2) + (window-width . ,treemacs-width)))) + (window (display-buffer-in-side-window tree-buffer position-params))) + (unless ignore-focus? + (select-window window) + (set-window-dedicated-p window t))) + (unless ignore-focus? + (lsp-log "No Clojure test tree data found.")))) + +(lsp-defun lsp-clojure--handle-test-tree (_workspace (notification &as &clojure-lsp:TestTreeParams :uri)) + "Test tree notification handler for workspace WORKSPACE. +NOTIFICATION is the test tree notification data received from server. +It updates the test tree view data." + (when (require 'lsp-treemacs nil t) + (when-let* ((buffer (find-buffer-visiting (lsp--uri-to-path uri)))) + (with-current-buffer buffer + (setq lsp-clojure--test-tree-data notification) + (when (get-buffer-window lsp-clojure--test-tree-buffer-name) + (lsp-clojure--show-test-tree t)))))) + +;;;###autoload +(defun lsp-clojure-show-test-tree (ignore-focus?) + "Show a test tree and focus on it if IGNORE-FOCUS? is nil." + (interactive "P") + (if (require 'lsp-treemacs nil t) + (lsp-clojure--show-test-tree ignore-focus?) + (error "The package lsp-treemacs is not installed"))) + +;; Project Tree + +(defconst lsp-clojure--project-tree-buffer-name "*Clojure Project Tree*") + +(defun lsp-clojure--project-tree-type->icon (type) + "Convert the project tree type TYPE to icon." + (cl-case type + (1 'project) + (2 'folder) + (3 'library) + (4 'jar) + (5 'namespace) + (6 'class) + (7 'method) + (8 'variable) + (9 'interface))) + +(defun lsp-clojure--project-tree-ret-action (uri range) + "Build the ret action for an item in the project tree view. +URI is the source of the item." + (interactive) + (lsp-treemacs--open-file-in-mru (lsp--uri-to-path uri)) + (goto-char (lsp--position-to-point (lsp:range-start range))) + (run-hooks 'xref-after-jump-hook)) + +(lsp-defun lsp-clojure--project-tree-children-data->tree (buffer current-node &optional _ callback) + "Builds a project tree considering CURRENT-NODE." + (with-current-buffer buffer + (lsp-request-async + "clojure/workspace/projectTree/nodes" + current-node + (-lambda ((&clojure-lsp:ProjectTreeNode :nodes?)) + (funcall + callback + (-map + (-lambda ((node &as &clojure-lsp:ProjectTreeNode :id? :name :type :uri? :range? :detail? :final?)) + (-let ((label (if detail? + (format "%s %s" name (propertize detail? 'face 'lsp-details-face)) + name))) + `(:label ,label + :key ,(or id? name) + :icon ,(lsp-clojure--project-tree-type->icon type) + ,@(unless final? + (list :children-async (-partial #'lsp-clojure--project-tree-children-data->tree buffer node))) + ,@(when uri? + (list :uri uri? + :ret-action (lambda (&rest _) + (interactive) + (lsp-clojure--project-tree-ret-action uri? range?))))))) + nodes?))) + :mode 'detached))) + +(defun lsp-clojure--project-tree-data->tree () + "Builds a project tree considering CURRENT-NODE." + (-let* (((&clojure-lsp:ProjectTreeNode :id? :name :nodes? :uri?) (lsp-request "clojure/workspace/projectTree/nodes" nil)) + (buffer (current-buffer))) + (list :key (or id? name) + :label name + :icon "clj" + :children (seq-map (-lambda ((node &as &clojure-lsp:ProjectTreeNode :id? :name :type :uri?)) + (list :key (or id? name) + :label name + :icon (lsp-clojure--project-tree-type->icon type) + :children-async (-partial #'lsp-clojure--project-tree-children-data->tree buffer node) + :uri uri?)) + nodes?) + :uri uri?))) + +(defun lsp-clojure--render-project-tree () + "Render a project tree view." + (save-excursion + (lsp-treemacs-render + (list (lsp-clojure--project-tree-data->tree)) + "Clojure Project Tree" + nil + lsp-clojure--project-tree-buffer-name + nil + t))) + +(defun lsp-clojure--show-project-tree (ignore-focus?) + "Show a project tree for current project. +Focus on it if IGNORE-FOCUS? is nil." + (-let* ((tree-buffer (lsp-clojure--render-project-tree)) + (position-params (or lsp-clojure-project-tree-position-params + `((side . ,treemacs-position) + (slot . 2) + (window-width . ,treemacs-width)))) + (window (display-buffer-in-side-window tree-buffer position-params))) + (unless ignore-focus? + (select-window window) + (set-window-dedicated-p window t)))) + +;;;###autoload +(defun lsp-clojure-show-project-tree (ignore-focus?) + "Show a project tree with source-paths and dependencies. +Focus on it if IGNORE-FOCUS? is nil." + (interactive "P") + (if (require 'lsp-treemacs nil t) + (lsp-clojure--show-project-tree ignore-focus?) + (error "The package lsp-treemacs is not installed"))) + +(defun lsp-clojure--build-command () + "Build clojure-lsp start command." + (let* ((base-command (or lsp-clojure-custom-server-command + (-some-> (lsp-clojure--server-executable-path) list)))) + (if lsp-clojure-trace-enable + (-map-last #'stringp + (lambda (command) + (concat command " --trace")) + base-command) + base-command))) + +(lsp-register-client + (make-lsp-client + :download-server-fn (lambda (_client callback error-callback _update?) + (lsp-package-ensure 'clojure-lsp callback error-callback)) + :semantic-tokens-faces-overrides '(:types (("macro" . font-lock-keyword-face) + ("keyword" . clojure-keyword-face) + ("event" . default))) + :new-connection (lsp-stdio-connection + #'lsp-clojure--build-command + #'lsp-clojure--build-command) + :major-modes '(clojure-mode clojurec-mode clojurescript-mode + clojure-ts-mode clojure-ts-clojurec-mode clojure-ts-clojurescript-mode) + :library-folders-fn (lambda (_workspace) lsp-clojure-library-dirs) + :uri-handlers (lsp-ht ("jar" #'lsp-clojure--file-in-jar)) + :action-handlers (lsp-ht ("code-lens-references" #'lsp-clojure--show-references)) + :notification-handlers (lsp-ht ("clojure/textDocument/testTree" #'lsp-clojure--handle-test-tree)) + :initialization-options '(:dependency-scheme "jar" + :show-docs-arity-on-same-line? t) + :custom-capabilities `((experimental . ((testTree . ,(and (require 'lsp-treemacs nil t) t))))) + :server-id 'clojure-lsp)) + +(lsp-consistency-check lsp-clojure) + +;; For debugging + +(declare-function cider-connect-clj "ext:cider" (params)) + +(defun lsp-clojure-nrepl-connect () + "Connect to the running nrepl debug server of clojure-lsp." + (interactive) + (let ((info (lsp-clojure-server-info-raw))) + (save-match-data + (when (functionp 'cider-connect-clj) + (when-let* ((port (and (string-match "\"port\":\\([0-9]+\\)" info) + (match-string 1 info)))) + (cider-connect-clj `(:host "localhost" + :port ,port))))))) + +;; Cider integration + +(defun lsp-clojure-semantic-tokens-refresh (&rest _) + "Force refresh semantic tokens." + (when-let* ((workspace (and lsp-semantic-tokens-enable + (lsp-find-workspace 'clojure-lsp (buffer-file-name))))) + (--each (lsp--workspace-buffers workspace) + (when (lsp-buffer-live-p it) + (lsp-with-current-buffer it + (lsp-semantic-tokens--enable)))))) + +(with-eval-after-load 'cider + (when lsp-semantic-tokens-enable + ;; refresh tokens as cider flush font-faces after disconnected + (add-hook 'cider-mode-hook #'lsp-clojure-semantic-tokens-refresh))) + +(provide 'lsp-clojure) +;;; lsp-clojure.el ends here diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-clojure.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-clojure.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-cmake.el b/emacs/elpa/lsp-mode-20241119.828/lsp-cmake.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-cmake.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-cmake.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-cobol.el b/emacs/elpa/lsp-mode-20241119.828/lsp-cobol.el @@ -0,0 +1,154 @@ +;;; lsp-cobol.el --- COBOL support -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Shen, Jen-Chieh + +;; 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 this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; COBOL support. +;; + +;;; Code: + +(require 'lsp-mode) + +(defgroup lsp-cobol nil + "LSP support for COBOL." + :group 'lsp-mode + :link '(url-link "https://github.com/eclipse-che4z/che-che4z-lsp-for-cobol") + :package-version `(lsp-mode . "9.0.0")) + +(defcustom lsp-cobol-server-path nil + "Path points for COBOL language service. + +This is only for development use." + :type 'string + :group 'lsp-cobol) + +(defcustom lsp-cobol-port 1044 + "Port to connect server to." + :type 'integer + :group 'lsp-cobol) + +;; +;;; Installation + +(defcustom lsp-cobol-server-store-path + (expand-file-name "cobol/" lsp-server-install-dir) + "The path to the file in which COBOL language service will be stored." + :type 'file + :group 'lsp-cobol) + +(defcustom lsp-cobol-server-version "2.1.1" + "The COBOL language service version to install." + :type 'file + :group 'lsp-cobol) + +(defconst lsp-cobol-download-url-format + "https://github.com/eclipse-che4z/che-che4z-lsp-for-cobol/releases/download/%s/cobol-language-support-%s-%s-%s%s.vsix" + "Format to the download url link.") + +(defun lsp-cobol--server-url () + "Return Url points to the cobol language service's zip/tar file." + (let* ((x86 (string-prefix-p "x86_64" system-configuration)) + (arch (if x86 "x64" "arm64")) + (version lsp-cobol-server-version)) + (cl-case system-type + ((cygwin windows-nt ms-dos) + (format lsp-cobol-download-url-format + version "win32" arch version "-signed")) + (darwin + (format lsp-cobol-download-url-format + version "darwin" arch version "")) + (gnu/linux + (format lsp-cobol-download-url-format + version "linux" arch version ""))))) + +(defun lsp-cobol--stored-executable () + "Return the stored COBOL language service executable." + (f-join lsp-cobol-server-store-path + (concat "extension/server/native/" + (cl-case system-type + ((cygwin windows-nt ms-dos) "engine.exe") + (darwin "server-mac") + (gnu/linux "server-linux"))))) + +(lsp-dependency + 'cobol-ls + '(:system "cobol-ls") + `(:download :url ,(lsp-cobol--server-url) + :decompress :zip + :store-path ,(f-join lsp-cobol-server-store-path "temp") + :set-executable? t) + `(:system ,(lsp-cobol--stored-executable))) + +;; +;;; Server + +;;;###autoload +(add-hook 'cobol-mode-hook #'lsp-cobol-start-ls) + +;;;###autoload +(defun lsp-cobol-start-ls () + "Start the COBOL language service." + (interactive) + (when-let* ((exe (lsp-cobol--executable)) + ((lsp--port-available "localhost" lsp-cobol-port))) + (lsp-async-start-process #'ignore #'ignore exe))) + +;; +;;; Core + +(defun lsp-cobol--executable () + "Return the COBOL language service executable." + (or lsp-cobol-server-path + (lsp-cobol--stored-executable))) + +(defun lsp-cobol-server-start-fn (&rest _) + "Define COOBL language service start function." + `(,(lsp-cobol--executable))) + +(defun lsp-cobol--tcp-connect-to-port () + "Define a TCP connection to language server." + (list + :connect + (lambda (filter sentinel name _environment-fn _workspace) + (let* ((host "localhost") + (port lsp-cobol-port) + (tcp-proc (lsp--open-network-stream host port (concat name "::tcp")))) + + ;; TODO: Same :noquery issue (see above) + (set-process-query-on-exit-flag tcp-proc nil) + (set-process-filter tcp-proc filter) + (set-process-sentinel tcp-proc sentinel) + (cons tcp-proc tcp-proc))) + :test? (lambda () (file-executable-p (lsp-cobol--executable))))) + +(lsp-register-client + (make-lsp-client + :new-connection (lsp-cobol--tcp-connect-to-port) + :activation-fn (lsp-activate-on "cobol") + :priority -1 + :server-id 'cobol-ls + :download-server-fn + (lambda (_client callback error-callback _update?) + (lsp-package-ensure 'cobol-ls callback error-callback)))) + +(lsp-consistency-check lsp-cobol) + +(provide 'lsp-cobol) +;;; lsp-cobol.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-cobol.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-cobol.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-completion.el b/emacs/elpa/lsp-mode-20241119.828/lsp-completion.el @@ -0,0 +1,876 @@ +;;; lsp-completion.el --- LSP completion -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2020 emacs-lsp maintainers +;; +;; 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: +;; +;; LSP completion +;; +;;; Code: + +(require 'lsp-mode) + +(defgroup lsp-completion nil + "LSP support for completion." + :prefix "lsp-completion-" + :group 'lsp-mode + :tag "LSP Completion") + +;;;###autoload +(define-obsolete-variable-alias 'lsp-prefer-capf + 'lsp-completion-provider "lsp-mode 7.0.1") + +(defcustom lsp-completion-provider :capf + "The completion backend provider." + :type '(choice + (const :tag "Use company-capf" :capf) + (const :tag "None" :none)) + :group 'lsp-completion + :package-version '(lsp-mode . "7.0.1")) + +;;;###autoload +(define-obsolete-variable-alias 'lsp-enable-completion-at-point + 'lsp-completion-enable "lsp-mode 7.0.1") + +(defcustom lsp-completion-enable t + "Enable `completion-at-point' integration." + :type 'boolean + :group 'lsp-completion) + +(defcustom lsp-completion-enable-additional-text-edit t + "Whether or not to apply additional text edit when performing completion. + +If set to non-nil, `lsp-mode' will apply additional text edits +from the server. Otherwise, the additional text edits are +ignored." + :type 'boolean + :group 'lsp-completion + :package-version '(lsp-mode . "6.3.2")) + +(defcustom lsp-completion-show-kind t + "Whether or not to show kind of completion candidates." + :type 'boolean + :group 'lsp-completion + :package-version '(lsp-mode . "7.0.1")) + +(defcustom lsp-completion-show-detail t + "Whether or not to show detail of completion candidates." + :type 'boolean + :group 'lsp-completion) + +(defcustom lsp-completion-show-label-description t + "Whether or not to show description of completion candidates." + :type 'boolean + :group 'lsp-completion + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-completion-no-cache nil + "Whether or not caching the returned completions from server." + :type 'boolean + :group 'lsp-completion + :package-version '(lsp-mode . "7.0.1")) + +(defcustom lsp-completion-filter-on-incomplete t + "Whether or not filter incomplete results." + :type 'boolean + :group 'lsp-completion + :package-version '(lsp-mode . "7.0.1")) + +(defcustom lsp-completion-sort-initial-results t + "Whether or not filter initial results from server." + :type 'boolean + :group 'lsp-completion + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-completion-use-last-result t + "Temporarily use last server result when interrupted by keyboard. +This will help minimize popup flickering issue in `company-mode'." + :type 'boolean + :group 'lsp-completion + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-completion-default-behaviour :replace + "Default behaviour of `InsertReplaceEdit'." + :type '(choice + (const :tag "Default completion inserts" :insert) + (const :tag "Default completion replaces" :replace)) + :group 'lsp-completion + :package-version '(lsp-mode . "8.0.0")) + +(defconst lsp-completion--item-kind + [nil + "Text" + "Method" + "Function" + "Constructor" + "Field" + "Variable" + "Class" + "Interface" + "Module" + "Property" + "Unit" + "Value" + "Enum" + "Keyword" + "Snippet" + "Color" + "File" + "Reference" + "Folder" + "EnumMember" + "Constant" + "Struct" + "Event" + "Operator" + "TypeParameter"]) + +(defvar yas-indent-line) +(defvar company-backends) +(defvar company-abort-on-unique-match) + +(defvar lsp-completion--no-reordering nil + "Dont do client-side reordering completion items when set.") + +(declare-function company-mode "ext:company") +(declare-function yas-expand-snippet "ext:yasnippet") + +(defun lsp-doc-buffer (&optional string) + "Return doc for STRING." + (with-current-buffer (get-buffer-create "*lsp-documentation*") + (erase-buffer) + (fundamental-mode) + (when string + (save-excursion + (insert string) + (visual-line-mode))) + (current-buffer))) + +(defun lsp-falsy? (val) + "Non-nil if VAL is falsy." + ;; https://developer.mozilla.org/en-US/docs/Glossary/Falsy + (or (not val) (equal val "") (equal val 0))) + +(cl-defun lsp-completion--make-item (item &key markers prefix) + "Make completion item from lsp ITEM and with MARKERS and PREFIX." + (-let (((&CompletionItem :label + :sort-text? + :_emacsStartPoint start-point) + item)) + (propertize label + 'lsp-completion-item item + 'lsp-sort-text sort-text? + 'lsp-completion-start-point start-point + 'lsp-completion-markers markers + 'lsp-completion-prefix prefix))) + +(defun lsp-completion--fix-resolve-data (item) + "Patch `CompletionItem' ITEM for rust-analyzer otherwise resolve will fail. +See #2675" + (let ((data (lsp:completion-item-data? item))) + (when (lsp-member? data :import_for_trait_assoc_item) + (unless (lsp-get data :import_for_trait_assoc_item) + (lsp-put data :import_for_trait_assoc_item :json-false))))) + +(defun lsp-completion--resolve (item) + "Resolve completion ITEM. +ITEM can be string or a CompletionItem" + (cl-assert item nil "Completion item must not be nil") + (-let (((completion-item . resolved) + (pcase item + ((pred stringp) (cons (get-text-property 0 'lsp-completion-item item) + (get-text-property 0 'lsp-completion-resolved item))) + (_ (cons item nil))))) + (if resolved item + (lsp-completion--fix-resolve-data completion-item) + (setq completion-item + (or (ignore-errors + (when (lsp-feature? "completionItem/resolve") + (lsp-request "completionItem/resolve" + (lsp-delete (lsp-copy completion-item) :_emacsStartPoint)))) + completion-item)) + (pcase item + ((pred stringp) + (let ((len (length item))) + (put-text-property 0 len 'lsp-completion-item completion-item item) + (put-text-property 0 len 'lsp-completion-resolved t item) + item)) + (_ completion-item))))) + +(defun lsp-completion--resolve-async (item callback &optional cleanup-fn) + "Resolve completion ITEM asynchronously with CALLBACK. +The CLEANUP-FN will be called to cleanup." + (cl-assert item nil "Completion item must not be nil") + (-let (((completion-item . resolved) + (pcase item + ((pred stringp) (cons (get-text-property 0 'lsp-completion-item item) + (get-text-property 0 'lsp-completion-resolved item))) + (_ (cons item nil))))) + (ignore-errors + (if (and (lsp-feature? "completionItem/resolve") (not resolved)) + (progn + (lsp-completion--fix-resolve-data completion-item) + (lsp-request-async "completionItem/resolve" + (lsp-delete (lsp-copy completion-item) :_emacsStartPoint) + (lambda (completion-item) + (when (stringp item) + (let ((len (length item))) + (put-text-property 0 len 'lsp-completion-item completion-item item) + (put-text-property 0 len 'lsp-completion-resolved t item) + item)) + (funcall callback completion-item) + (when cleanup-fn (funcall cleanup-fn))) + :error-handler (lambda (err) + (when cleanup-fn (funcall cleanup-fn)) + (error (lsp:json-error-message err))) + :cancel-handler cleanup-fn + :mode 'alive)) + (funcall callback completion-item) + (when cleanup-fn (funcall cleanup-fn)))))) + +(defun lsp-completion--annotate (item) + "Annotate ITEM detail." + (-let (((completion-item &as &CompletionItem :detail? :kind? :label-details?) + (get-text-property 0 'lsp-completion-item item))) + (lsp-completion--resolve-async item #'ignore) + + (concat (when (and lsp-completion-show-detail detail?) + (concat " " (s-replace "\r" "" detail?))) + (when (and lsp-completion-show-label-description label-details?) + (when-let* ((description (and label-details? (lsp:label-details-description label-details?)))) + (format " %s" description))) + (when lsp-completion-show-kind + (when-let* ((kind-name (and kind? (aref lsp-completion--item-kind kind?)))) + (format " (%s)" kind-name)))))) + +(defun lsp-completion--looking-back-trigger-characterp (trigger-characters) + "Return character if text before point match any of the TRIGGER-CHARACTERS." + (unless (= (point) (line-beginning-position)) + (seq-some + (lambda (trigger-char) + (and (equal (buffer-substring-no-properties (- (point) (length trigger-char)) (point)) + trigger-char) + trigger-char)) + trigger-characters))) + +(defvar lsp-completion--cache nil + "Cached candidates for completion at point function. +In the form of plist (prefix-pos items :lsp-items :prefix ...). +When the completion is incomplete, `items' contains value of :incomplete.") + +(defvar lsp-completion--last-result nil + "Last completion result.") + +(defun lsp-completion--clear-cache (&optional keep-last-result) + "Clear completion caches. +KEEP-LAST-RESULT if specified." + (-some-> lsp-completion--cache + (cddr) + (plist-get :markers) + (cl-second) + (set-marker nil)) + (setq lsp-completion--cache nil) + (unless keep-last-result (setq lsp-completion--last-result nil))) + +(lsp-defun lsp-completion--guess-prefix ((item &as &CompletionItem :text-edit?)) + "Guess ITEM's prefix start point according to following heuristics: +- If `textEdit' exists, use insertion range start as prefix start point. +- Else, find the point before current point is longest prefix match of +`insertText' or `label'. And: + - The character before prefix is not word constitute +Return `nil' when fails to guess prefix." + (cond + ((lsp-insert-replace-edit? text-edit?) + (lsp--position-to-point (lsp:range-start (lsp:insert-replace-edit-insert text-edit?)))) + (text-edit? + (lsp--position-to-point (lsp:range-start (lsp:text-edit-range text-edit?)))) + (t + (-let* (((&CompletionItem :label :insert-text?) item) + (text (or (unless (lsp-falsy? insert-text?) insert-text?) label)) + (point (point)) + (start (max 1 (- point (length text)))) + (char-before (char-before start)) + start-point) + (while (and (< start point) (not start-point)) + (unless (or (and char-before (equal (char-syntax char-before) ?w)) + (not (string-prefix-p (buffer-substring-no-properties start point) + text))) + (setq start-point start)) + (cl-incf start) + (setq char-before (char-before start))) + start-point)))) + +(defun lsp-completion--to-internal (items) + "Convert ITEMS into internal form." + (--> items + (-map (-lambda ((item &as &CompletionItem + :label + :filter-text? + :_emacsStartPoint start-point + :score?)) + `( :label ,(or (unless (lsp-falsy? filter-text?) filter-text?) label) + :item ,item + :start-point ,start-point + :score ,score?)) + it))) + +(cl-defun lsp-completion--filter-candidates (items &key + lsp-items + markers + prefix + &allow-other-keys) + "List all possible completions in cached ITEMS with their prefixes. +We can pass LSP-ITEMS, which will be used when there's no cache. +The MARKERS and PREFIX value will be attached to each candidate." + (lsp--while-no-input + (->> + (if items + (--> (let (queries fuz-queries) + (-keep (-lambda ((cand &as &plist :label :start-point :score)) + (let* ((query (or (plist-get queries start-point) + (let ((s (buffer-substring-no-properties + start-point (point)))) + (setq queries (plist-put queries start-point s)) + s))) + (fuz-query (or (plist-get fuz-queries start-point) + (let ((s (lsp-completion--regex-fuz query))) + (setq fuz-queries + (plist-put fuz-queries start-point s)) + s))) + (label-len (length label))) + (when (string-match fuz-query label) + (put-text-property 0 label-len 'match-data (match-data) label) + (plist-put cand + :sort-score + (* (or (lsp-completion--fuz-score query label) 1e-05) + (or score 0.001))) + cand))) + items)) + (if lsp-completion--no-reordering + it + (sort it (lambda (o1 o2) + (> (plist-get o1 :sort-score) + (plist-get o2 :sort-score))))) + ;; TODO: pass additional function to sort the candidates + (-map (-rpartial #'plist-get :item) it)) + lsp-items) + (-map (lambda (item) (lsp-completion--make-item item + :markers markers + :prefix prefix)))))) + +(defconst lsp-completion--kind->symbol + '((1 . text) + (2 . method) + (3 . function) + (4 . constructor) + (5 . field) + (6 . variable) + (7 . class) + (8 . interface) + (9 . module) + (10 . property) + (11 . unit) + (12 . value) + (13 . enum) + (14 . keyword) + (15 . snippet) + (16 . color) + (17 . file) + (18 . reference) + (19 . folder) + (20 . enum-member) + (21 . constant) + (22 . struct) + (23 . event) + (24 . operator) + (25 . type-parameter))) + +(defun lsp-completion--candidate-kind (item) + "Return ITEM's kind." + (alist-get (lsp:completion-item-kind? (get-text-property 0 'lsp-completion-item item)) + lsp-completion--kind->symbol)) + +(defun lsp-completion--candidate-deprecated (item) + "Return if ITEM is deprecated." + (let ((completion-item (get-text-property 0 'lsp-completion-item item))) + (or (lsp:completion-item-deprecated? completion-item) + (seq-position (lsp:completion-item-tags? completion-item) + lsp/completion-item-tag-deprecated)))) + +(defun lsp-completion--company-match (candidate) + "Return highlight of typed prefix inside CANDIDATE." + (if-let* ((md (cddr (plist-get (text-properties-at 0 candidate) 'match-data)))) + (let (matches start end) + (while (progn (setq start (pop md) end (pop md)) + (and start end)) + (setq matches (nconc matches `((,start . ,end))))) + matches) + (let* ((prefix (downcase + (buffer-substring-no-properties + ;; Put a safe guard to prevent staled cache from setting a wrong start point #4192 + (max (line-beginning-position) + (plist-get (text-properties-at 0 candidate) 'lsp-completion-start-point)) + (point)))) + (prefix-len (length prefix)) + (prefix-pos 0) + (label (downcase candidate)) + (label-len (length label)) + (label-pos 0) + matches start) + (while (and (not matches) + (< prefix-pos prefix-len)) + (while (and (< prefix-pos prefix-len) + (< label-pos label-len)) + (if (equal (aref prefix prefix-pos) (aref label label-pos)) + (progn + (unless start (setq start label-pos)) + (cl-incf prefix-pos)) + (when start + (setq matches (nconc matches `((,start . ,label-pos)))) + (setq start nil))) + (cl-incf label-pos)) + (when start (setq matches (nconc matches `((,start . ,label-pos))))) + ;; Search again when the whole prefix is not matched + (when (< prefix-pos prefix-len) + (setq matches nil)) + ;; Start search from next offset of prefix to find a match with label + (unless matches + (cl-incf prefix-pos) + (setq label-pos 0))) + matches))) + +(defun lsp-completion--get-documentation (item) + "Get doc comment for completion ITEM." + (-some->> item + (lsp-completion--resolve) + (get-text-property 0 'lsp-completion-item) + (lsp:completion-item-documentation?) + (lsp--render-element))) + +(defun lsp-completion--get-context (trigger-characters same-session?) + "Get completion context with provided TRIGGER-CHARACTERS and SAME-SESSION?." + (let* ((triggered-by-char non-essential) + (trigger-char (when triggered-by-char + (lsp-completion--looking-back-trigger-characterp + trigger-characters))) + (trigger-kind (cond + (trigger-char + lsp/completion-trigger-kind-trigger-character) + ((and same-session? + (equal (cl-second lsp-completion--cache) :incomplete)) + lsp/completion-trigger-kind-trigger-for-incomplete-completions) + (t lsp/completion-trigger-kind-invoked)))) + (apply #'lsp-make-completion-context + (nconc + `(:trigger-kind ,trigger-kind) + (when trigger-char + `(:trigger-character? ,trigger-char)))))) + +(defun lsp-completion--sort-completions (completions) + "Sort COMPLETIONS." + (sort + completions + (-lambda ((&CompletionItem :sort-text? sort-text-left :label label-left) + (&CompletionItem :sort-text? sort-text-right :label label-right)) + (if (equal sort-text-left sort-text-right) + (string-lessp label-left label-right) + (string-lessp sort-text-left sort-text-right))))) + +;;;###autoload +(defun lsp-completion-at-point () + "Get lsp completions." + (when (or (--some (lsp--client-completion-in-comments? (lsp--workspace-client it)) + (lsp-workspaces)) + (not (nth 4 (syntax-ppss)))) + (let* ((trigger-chars (-> (lsp--capability-for-method "textDocument/completion") + (lsp:completion-options-trigger-characters?))) + (bounds-start (or (cl-first (bounds-of-thing-at-point 'symbol)) + (point))) + result done? + (candidates + (lambda () + (lsp--catch 'input + (let ((lsp--throw-on-input lsp-completion-use-last-result) + (same-session? (and lsp-completion--cache + ;; Special case for empty prefix and empty result + (or (cl-second lsp-completion--cache) + (not (string-empty-p + (plist-get (cddr lsp-completion--cache) :prefix)))) + (equal (cl-first lsp-completion--cache) bounds-start) + (s-prefix? + (plist-get (cddr lsp-completion--cache) :prefix) + (buffer-substring-no-properties bounds-start (point)))))) + (cond + ((or done? result) result) + ((and (not lsp-completion-no-cache) + same-session? + (listp (cl-second lsp-completion--cache))) + (setf result (apply #'lsp-completion--filter-candidates + (cdr lsp-completion--cache)))) + (t + (-let* ((resp (lsp-request-while-no-input + "textDocument/completion" + (plist-put (lsp--text-document-position-params) + :context (lsp-completion--get-context trigger-chars same-session?)))) + (completed (and resp + (not (and (lsp-completion-list? resp) + (lsp:completion-list-is-incomplete resp))))) + (items (lsp--while-no-input + (--> (cond + ((lsp-completion-list? resp) + (lsp:completion-list-items resp)) + (t resp)) + (if (or completed + (seq-some #'lsp:completion-item-sort-text? it)) + (lsp-completion--sort-completions it) + it) + (-map (lambda (item) + (lsp-put item + :_emacsStartPoint + (or (lsp-completion--guess-prefix item) + bounds-start))) + it)))) + (markers (list bounds-start (copy-marker (point) t))) + (prefix (buffer-substring-no-properties bounds-start (point))) + (lsp-completion--no-reordering (not lsp-completion-sort-initial-results))) + (lsp-completion--clear-cache same-session?) + (setf done? completed + lsp-completion--cache (list bounds-start + (cond + ((and done? (not (seq-empty-p items))) + (lsp-completion--to-internal items)) + ((not done?) :incomplete)) + :lsp-items nil + :markers markers + :prefix prefix) + result (lsp-completion--filter-candidates + (cond (done? + (cl-second lsp-completion--cache)) + (lsp-completion-filter-on-incomplete + (lsp-completion--to-internal items))) + :lsp-items items + :markers markers + :prefix prefix)))))) + (:interrupted lsp-completion--last-result) + (`,res (setq lsp-completion--last-result res)))))) + (list + bounds-start + (point) + (lambda (probe pred action) + (cond + ((eq action 'metadata) + '(metadata (category . lsp-capf) + (display-sort-function . identity) + (cycle-sort-function . identity))) + ((eq (car-safe action) 'boundaries) nil) + (t + (complete-with-action action (funcall candidates) probe pred)))) + :annotation-function #'lsp-completion--annotate + :company-kind #'lsp-completion--candidate-kind + :company-deprecated #'lsp-completion--candidate-deprecated + :company-require-match 'never + :company-prefix-length + (save-excursion + (let ( + ;; 2 is a heuristic number to make sure we look futher back than + ;; the bounds-start, which can be different from the actual start + ;; of the symbol + (bounds-left (max (line-beginning-position) (- bounds-start 2))) + triggered-by-char?) + (while (and (> (point) bounds-left) + (not (equal (char-after) ?\s)) + (not triggered-by-char?)) + (setq triggered-by-char? (lsp-completion--looking-back-trigger-characterp trigger-chars)) + (goto-char (1- (point)))) + (and triggered-by-char? t))) + :company-match #'lsp-completion--company-match + :company-doc-buffer (-compose #'lsp-doc-buffer + #'lsp-completion--get-documentation) + :exit-function + (-rpartial #'lsp-completion--exit-fn candidates))))) + +(defun lsp-completion--find-workspace (server-id) + (--first (eq (lsp--client-server-id (lsp--workspace-client it)) server-id) + (lsp-workspaces))) + +(defun lsp-completion--exit-fn (candidate _status &optional candidates) + "Exit function of `completion-at-point'. +CANDIDATE is the selected completion item. +Others: CANDIDATES" + (unwind-protect + (-let* ((candidate (if (plist-member (text-properties-at 0 candidate) + 'lsp-completion-item) + candidate + (cl-find candidate (funcall candidates) :test #'equal))) + (candidate + ;; see #3498 typescript-language-server does not provide the + ;; proper insertText without resolving. + (if (lsp-completion--find-workspace 'ts-ls) + (lsp-completion--resolve candidate) + candidate)) + ((&plist 'lsp-completion-item item + 'lsp-completion-start-point start-point + 'lsp-completion-markers markers + 'lsp-completion-resolved resolved + 'lsp-completion-prefix prefix) + (text-properties-at 0 candidate)) + ((&CompletionItem? :label :insert-text? :text-edit? :insert-text-format? + :additional-text-edits? :insert-text-mode? :command?) + item)) + (cond + (text-edit? + (apply #'delete-region markers) + (insert prefix) + (pcase text-edit? + ((lsp-interface TextEdit) (lsp--apply-text-edit text-edit?)) + ((lsp-interface InsertReplaceEdit :insert :replace :new-text) + (lsp--apply-text-edit + (lsp-make-text-edit + :new-text new-text + :range (if (or (and current-prefix-arg (eq lsp-completion-default-behaviour :replace)) + (and (not current-prefix-arg) (eq lsp-completion-default-behaviour :insert))) + insert + replace)))))) + ((or (unless (lsp-falsy? insert-text?) insert-text?) label) + (apply #'delete-region markers) + (insert prefix) + (delete-region start-point (point)) + (insert (or (unless (lsp-falsy? insert-text?) insert-text?) label)))) + + (lsp--indent-lines start-point (point) insert-text-mode?) + (when (equal insert-text-format? lsp/insert-text-format-snippet) + (lsp--expand-snippet (buffer-substring start-point (point)) + start-point + (point))) + + (when lsp-completion-enable-additional-text-edit + (if (or resolved + (not (seq-empty-p additional-text-edits?))) + (lsp--apply-text-edits additional-text-edits? 'completion) + (-let [(callback cleanup-fn) (lsp--create-apply-text-edits-handlers)] + (lsp-completion--resolve-async + item + (-compose callback #'lsp:completion-item-additional-text-edits?) + cleanup-fn)))) + + (if (or resolved command?) + (when command? (lsp--execute-command command?)) + (lsp-completion--resolve-async + item + (-lambda ((&CompletionItem? :command?)) + (when command? (lsp--execute-command command?))))) + + (when (and (or + (equal lsp-signature-auto-activate t) + (memq :after-completion lsp-signature-auto-activate) + (and (memq :on-trigger-char lsp-signature-auto-activate) + (-when-let ((&SignatureHelpOptions? :trigger-characters?) + (lsp--capability :signatureHelpProvider)) + (lsp-completion--looking-back-trigger-characterp + trigger-characters?)))) + (lsp-feature? "textDocument/signatureHelp")) + (lsp-signature-activate)) + + (setq-local lsp-inhibit-lsp-hooks nil)) + (lsp-completion--clear-cache))) + +(defun lsp-completion--regex-fuz (str) + "Build a regex sequence from STR. Insert .* between each char." + (apply #'concat + (cl-mapcar + #'concat + (cons "" (cdr (seq-map (lambda (c) (format "[^%c]*" c)) str))) + (seq-map (lambda (c) + (format "\\(%s\\)" (regexp-quote (char-to-string c)))) + str)))) + +(defun lsp-completion--fuz-score (query str) + "Calculate fuzzy score for STR with query QUERY. +The return is nil or in range of (0, inf)." + (-when-let* ((md (cddr (or (get-text-property 0 'match-data str) + (let ((re (lsp-completion--regex-fuz query))) + (when (string-match re str) + (match-data)))))) + (start (pop md)) + (len (length str)) + ;; To understand how this works, consider these bad ascii(tm) + ;; diagrams showing how the pattern "foo" flex-matches + ;; "fabrobazo", "fbarbazoo" and "barfoobaz": + + ;; f abr o baz o + ;; + --- + --- + + + ;; f barbaz oo + ;; + ------ ++ + + ;; bar foo baz + ;; --- +++ --- + + ;; "+" indicates parts where the pattern matched. A "hole" in + ;; the middle of the string is indicated by "-". Note that there + ;; are no "holes" near the edges of the string. The completion + ;; score is a number bound by ]0..1]: the higher the better and + ;; only a perfect match (pattern equals string) will have score + ;; 1. The formula takes the form of a quotient. For the + ;; numerator, we use the number of +, i.e. the length of the + ;; pattern. For the denominator, it first computes + ;; + ;; hole_i_contrib = 1 + (Li-1)^1.05 for first hole + ;; hole_i_contrib = 1 + (Li-1)^0.25 for hole i of length Li + ;; + ;; The final value for the denominator is then given by: + ;; + ;; (SUM_across_i(hole_i_contrib) + 1) + ;; + (score-numerator 0) + (score-denominator 0) + (last-b -1) + (q-ind 0) + (update-score + (lambda (a b) + "Update score variables given match range (A B)." + (setq score-numerator (+ score-numerator (- b a))) + (unless (= a len) + ;; case mismatch will be pushed to near next rank + (unless (equal (aref query q-ind) (aref str a)) + (cl-incf a 0.9)) + (setq score-denominator + (+ score-denominator + (if (= a last-b) 0 + (+ 1 (* (if (< 0 (- a last-b 1)) 1 -1) + (expt (abs (- a last-b 1)) + ;; Give a higher score for match near start + (if (eq last-b -1) 0.75 0.25)))))))) + (setq last-b b)))) + (while md + (funcall update-score start (cl-first md)) + ;; Due to the way completion regex is constructed, `(eq end (+ start 1))` + (cl-incf q-ind) + (pop md) + (setq start (pop md))) + (unless (zerop len) + (/ score-numerator (1+ score-denominator) 1.0)))) + + +;;;###autoload +(defun lsp-completion--enable () + "Enable LSP completion support." + (when (and lsp-completion-enable + (lsp-feature? "textDocument/completion")) + (lsp-completion-mode 1))) + +(defun lsp-completion--disable () + "Disable LSP completion support." + (lsp-completion-mode -1)) + +(defun lsp-completion-passthrough-try-completion (string table pred point) + (let* ((completion-ignore-case t) + (try (completion-basic-try-completion string table pred point)) + (newstr (car try)) + (newpoint (cdr try)) + (beforepoint (and try (substring newstr 0 newpoint)))) + (if (and beforepoint + (string-prefix-p + beforepoint + (try-completion "" table pred) + t)) + try + (cons string point)))) + +(defun lsp-completion-passthrough-all-completions (_string table pred _point) + "Passthrough all completions from TABLE with PRED." + (defvar completion-lazy-hilit-fn) + (when (bound-and-true-p completion-lazy-hilit) + (setq completion-lazy-hilit-fn + (lambda (candidate) + (->> candidate + lsp-completion--company-match + (mapc (-lambda ((start . end)) + (put-text-property start end 'face 'completions-common-part candidate)))) + candidate))) + (all-completions "" table pred)) + +;;;###autoload +(define-minor-mode lsp-completion-mode + "Toggle LSP completion support." + :group 'lsp-completion + :global nil + :lighter "" + (let ((completion-started-fn (lambda (&rest _) + (setq-local lsp-inhibit-lsp-hooks t))) + (after-completion-fn (lambda (result) + (when (stringp result) + (lsp-completion--clear-cache)) + (setq-local lsp-inhibit-lsp-hooks nil)))) + (cond + (lsp-completion-mode + (make-local-variable 'completion-at-point-functions) + ;; Ensure that `lsp-completion-at-point' the first CAPF to be tried, + ;; unless user has put it elsewhere in the list by their own + (add-to-list 'completion-at-point-functions #'lsp-completion-at-point) + (make-local-variable 'completion-category-defaults) + (setf (alist-get 'lsp-capf completion-category-defaults) '((styles . (lsp-passthrough)))) + (make-local-variable 'completion-styles-alist) + (setf (alist-get 'lsp-passthrough completion-styles-alist) + '(lsp-completion-passthrough-try-completion + lsp-completion-passthrough-all-completions + "Passthrough completion.")) + + (cond + ((equal lsp-completion-provider :none)) + ((and (not (equal lsp-completion-provider :none)) + (fboundp 'company-mode)) + (setq-local company-abort-on-unique-match nil) + (company-mode 1) + (setq-local company-backends (cl-adjoin 'company-capf company-backends :test #'equal))) + (t + (lsp--warn "Unable to autoconfigure company-mode."))) + + (when (bound-and-true-p company-mode) + (add-hook 'company-completion-started-hook + completion-started-fn + nil + t) + (add-hook 'company-after-completion-hook + after-completion-fn + nil + t)) + (add-hook 'lsp-unconfigure-hook #'lsp-completion--disable nil t)) + (t + (remove-hook 'completion-at-point-functions #'lsp-completion-at-point t) + (setq-local completion-category-defaults + (cl-remove 'lsp-capf completion-category-defaults :key #'cl-first)) + (setq-local completion-styles-alist + (cl-remove 'lsp-passthrough completion-styles-alist :key #'cl-first)) + (remove-hook 'lsp-unconfigure-hook #'lsp-completion--disable t) + (when (featurep 'company) + (remove-hook 'company-completion-started-hook + completion-started-fn + t) + (remove-hook 'company-after-completion-hook + after-completion-fn + t)))))) + +;;;###autoload +(add-hook 'lsp-configure-hook (lambda () + (when (and lsp-auto-configure + lsp-completion-enable) + (lsp-completion--enable)))) + +(lsp-consistency-check lsp-completion) + +(provide 'lsp-completion) +;;; lsp-completion.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-completion.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-completion.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-credo.el b/emacs/elpa/lsp-mode-20241119.828/lsp-credo.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-credo.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-credo.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-crystal.el b/emacs/elpa/lsp-mode-20241119.828/lsp-crystal.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-crystal.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-crystal.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-csharp.el b/emacs/elpa/lsp-mode-20241119.828/lsp-csharp.el @@ -0,0 +1,573 @@ +;;; lsp-csharp.el --- description -*- lexical-binding: t; -*- + +;; Copyright (C) 2019 Jostein Kjønigsen, Saulius Menkevicius + +;; Author: Saulius Menkevicius <saulius.menkevicius@fastmail.com> +;; Keywords: + +;; 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: + +;; lsp-csharp client + +;;; Code: + +(require 'lsp-mode) +(require 'gnutls) +(require 'f) + +(defgroup lsp-csharp nil + "LSP support for C#, using the Omnisharp Language Server. +Version 1.34.3 minimum is required." + :group 'lsp-mode + :link '(url-link "https://github.com/OmniSharp/omnisharp-roslyn")) + +(defgroup lsp-csharp-omnisharp nil + "LSP support for C#, using the Omnisharp Language Server. +Version 1.34.3 minimum is required." + :group 'lsp-mode + :link '(url-link "https://github.com/OmniSharp/omnisharp-roslyn") + :package-version '(lsp-mode . "9.0.0")) + +(defconst lsp-csharp--omnisharp-metadata-uri-re + "^file:///%24metadata%24/Project/\\(.+\\)/Assembly/\\(.+\\)/Symbol/\\(.+\\)\.cs$" + "Regular expression matching omnisharp's metadata uri. +Group 1 contains the Project name +Group 2 contains the Assembly name +Group 3 contains the Type name") + +(defcustom lsp-csharp-server-install-dir + (f-join lsp-server-install-dir "omnisharp-roslyn/") + "Installation directory for OmniSharp Roslyn server." + :group 'lsp-csharp-omnisharp + :type 'directory) + +(defcustom lsp-csharp-server-path + nil + "The path to the OmniSharp Roslyn language-server binary. +Set this if you have the binary installed or have it built yourself." + :group 'lsp-csharp-omnisharp + :type '(string :tag "Single string value or nil")) + +(defcustom lsp-csharp-test-run-buffer-name + "*lsp-csharp test run*" + "The name of buffer used for outputting lsp-csharp test run results." + :group 'lsp-csharp-omnisharp + :type 'string) + +(defcustom lsp-csharp-solution-file + nil + "Solution to load when starting the server. +Usually this is to be set in your .dir-locals.el on the project root directory." + :group 'lsp-csharp-omnisharp + :type 'string) + +(defcustom lsp-csharp-omnisharp-roslyn-download-url + (concat "https://github.com/omnisharp/omnisharp-roslyn/releases/latest/download/" + (cond ((eq system-type 'windows-nt) + ; On Windows we're trying to avoid a crash starting 64bit .NET PE binaries in + ; Emacs by using x86 version of omnisharp-roslyn on older (<= 26.4) versions + ; of Emacs. See https://lists.nongnu.org/archive/html/bug-gnu-emacs/2017-06/msg00893.html" + (if (and (string-match "^x86_64-.*" system-configuration) + (version<= "26.4" emacs-version)) + "omnisharp-win-x64.zip" + "omnisharp-win-x86.zip")) + + ((eq system-type 'darwin) + (if (string-match "aarch64-.*" system-configuration) + "omnisharp-osx-arm64-net6.0.zip" + "omnisharp-osx-x64-net6.0.zip")) + + ((and (eq system-type 'gnu/linux) + (or (eq (string-match "^x86_64" system-configuration) 0) + (eq (string-match "^i[3-6]86" system-configuration) 0))) + "omnisharp-linux-x64-net6.0.zip") + + (t "omnisharp-mono.zip"))) + "Automatic download url for omnisharp-roslyn." + :group 'lsp-csharp-omnisharp + :type 'string) + +(defcustom lsp-csharp-omnisharp-roslyn-store-path + (f-join lsp-csharp-server-install-dir "latest" "omnisharp-roslyn.zip") + "The path where omnisharp-roslyn .zip archive will be stored." + :group 'lsp-csharp-omnisharp + :type 'file) + +(defcustom lsp-csharp-omnisharp-roslyn-binary-path + (f-join lsp-csharp-server-install-dir "latest" (if (eq system-type 'windows-nt) + "OmniSharp.exe" + "OmniSharp")) + "The path where omnisharp-roslyn binary after will be stored." + :group 'lsp-csharp-omnisharp + :type 'file) + +(defcustom lsp-csharp-omnisharp-roslyn-server-dir + (f-join lsp-csharp-server-install-dir "latest" "omnisharp-roslyn") + "The path where omnisharp-roslyn .zip archive will be extracted." + :group 'lsp-csharp-omnisharp + :type 'file) + + +(defcustom lsp-csharp-omnisharp-enable-decompilation-support + nil + "Decompile bytecode when browsing method metadata for types in assemblies. +Otherwise only declarations for the methods are visible (the default)." + :group 'lsp-csharp + :type 'boolean) + +(defcustom lsp-csharp-csharpls-use-dotnet-tool t + "Whether to use a dotnet tool version of the expected C# + language server; only available for csharp-ls" + :group 'lsp-csharp + :type 'boolean + :risky t) + +(defcustom lsp-csharp-csharpls-use-local-tool nil + "Whether to use csharp-ls as a global or local dotnet tool. + +Note: this variable has no effect if +lsp-csharp-csharpls-use-dotnet-tool is nil." + :group 'lsp-csharp + :type 'boolean + :risky t) + +(lsp-dependency + 'omnisharp-roslyn + `(:download :url lsp-csharp-omnisharp-roslyn-download-url + :decompress :zip + :store-path lsp-csharp-omnisharp-roslyn-store-path + :binary-path lsp-csharp-omnisharp-roslyn-binary-path + :set-executable? t) + '(:system "OmniSharp")) + +(defun lsp-csharp--omnisharp-download-server (_client callback error-callback _update?) + "Download zip package for omnisharp-roslyn and install it. +Will invoke CALLBACK on success, ERROR-CALLBACK on error." + (lsp-package-ensure 'omnisharp-roslyn callback error-callback)) + +(defun lsp-csharp--language-server-path () + "Resolve path to use to start the server." + (let ((executable-name (if (eq system-type 'windows-nt) + "OmniSharp.exe" + "OmniSharp"))) + (or (and lsp-csharp-server-path + (executable-find lsp-csharp-server-path)) + (executable-find executable-name) + (lsp-package-path 'omnisharp-roslyn)))) + +(defun lsp-csharp-open-project-file () + "Open corresponding project file (.csproj) for the current file." + (interactive) + (-let* ((project-info-req (lsp-make-omnisharp-project-information-request :file-name (buffer-file-name))) + (project-info (lsp-request "o#/project" project-info-req)) + ((&omnisharp:ProjectInformation :ms-build-project) project-info) + ((&omnisharp:MsBuildProject :path) ms-build-project)) + (find-file path))) + +(defun lsp-csharp--get-buffer-code-elements () + "Retrieve code structure by calling into the /v2/codestructure endpoint. +Returns :elements from omnisharp:CodeStructureResponse." + (-let* ((code-structure (lsp-request "o#/v2/codestructure" + (lsp-make-omnisharp-code-structure-request :file-name (buffer-file-name)))) + ((&omnisharp:CodeStructureResponse :elements) code-structure)) + elements)) + +(defun lsp-csharp--inspect-code-elements-recursively (fn elements) + "Invoke FN for every omnisharp:CodeElement found recursively in ELEMENTS." + (seq-each + (lambda (el) + (funcall fn el) + (-let (((&omnisharp:CodeElement :children) el)) + (lsp-csharp--inspect-code-elements-recursively fn children))) + elements)) + +(defun lsp-csharp--collect-code-elements-recursively (predicate elements) + "Flatten the omnisharp:CodeElement tree in ELEMENTS matching PREDICATE." + (let ((results nil)) + (lsp-csharp--inspect-code-elements-recursively (lambda (el) + (when (funcall predicate el) + (setq results (cons el results)))) + elements) + results)) + +(lsp-defun lsp-csharp--l-c-within-range (l c (&omnisharp:Range :start :end)) + "Determine if L (line) and C (column) are within RANGE." + (-let* (((&omnisharp:Point :line start-l :column start-c) start) + ((&omnisharp:Point :line end-l :column end-c) end)) + (or (and (= l start-l) (>= c start-c) (or (> end-l start-l) (<= c end-c))) + (and (> l start-l) (< l end-l)) + (and (= l end-l) (<= c end-c))))) + +(defun lsp-csharp--code-element-stack-on-l-c (l c elements) + "Return omnisharp:CodeElement stack at L (line) and C (column) in ELEMENTS tree." + (when-let* ((matching-element (seq-find (lambda (el) + (-when-let* (((&omnisharp:CodeElement :ranges) el) + ((&omnisharp:RangeList :full?) ranges)) + (lsp-csharp--l-c-within-range l c full?))) + elements))) + (-let (((&omnisharp:CodeElement :children) matching-element)) + (cons matching-element (lsp-csharp--code-element-stack-on-l-c l c children))))) + +(defun lsp-csharp--code-element-stack-at-point () + "Return omnisharp:CodeElement stack at point as a list." + (let ((pos-line (plist-get (lsp--cur-position) :line)) + (pos-col (plist-get (lsp--cur-position) :character))) + (lsp-csharp--code-element-stack-on-l-c pos-line + pos-col + (lsp-csharp--get-buffer-code-elements)))) + +(lsp-defun lsp-csharp--code-element-test-method-p (element) + "Return test method name and test framework for a given ELEMENT." + (when element + (-when-let* (((&omnisharp:CodeElement :properties) element) + ((&omnisharp:CodeElementProperties :test-method-name? :test-framework?) properties)) + (list test-method-name? test-framework?)))) + +(defun lsp-csharp--reset-test-buffer (present-buffer) + "Create new or reuse an existing test result output buffer. +PRESENT-BUFFER will make the buffer be presented to the user." + (with-current-buffer (get-buffer-create lsp-csharp-test-run-buffer-name) + (compilation-mode) + (read-only-mode) + (let ((inhibit-read-only t)) + (erase-buffer))) + + (when present-buffer + (display-buffer lsp-csharp-test-run-buffer-name))) + +(defun lsp-csharp--start-tests (test-method-framework test-method-names) + "Run test(s) identified by TEST-METHOD-NAMES using TEST-METHOD-FRAMEWORK." + (if (and test-method-framework test-method-names) + (let ((request-message (lsp-make-omnisharp-run-tests-in-class-request + :file-name (buffer-file-name) + :test-frameworkname test-method-framework + :method-names (vconcat test-method-names)))) + (lsp-csharp--reset-test-buffer t) + (lsp-session-set-metadata "last-test-method-framework" test-method-framework) + (lsp-session-set-metadata "last-test-method-names" test-method-names) + (lsp-request-async "o#/v2/runtestsinclass" + request-message + (-lambda ((&omnisharp:RunTestResponse)) + (message "lsp-csharp: Test run has started")))) + (message "lsp-csharp: No test methods to run"))) + +(defun lsp-csharp--test-message (message) + "Emit a MESSAGE to lsp-csharp test run buffer." + (when-let* ((existing-buffer (get-buffer lsp-csharp-test-run-buffer-name)) + (inhibit-read-only t)) + (with-current-buffer existing-buffer + (save-excursion + (goto-char (point-max)) + (insert message "\n"))))) + +(defun lsp-csharp-run-test-at-point () + "Start test run at current point (if any)." + (interactive) + (let* ((stack (lsp-csharp--code-element-stack-at-point)) + (element-on-point (car (last stack))) + (test-method (lsp-csharp--code-element-test-method-p element-on-point)) + (test-method-name (car test-method)) + (test-method-framework (car (cdr test-method)))) + (lsp-csharp--start-tests test-method-framework (list test-method-name)))) + +(defun lsp-csharp-run-all-tests-in-buffer () + "Run all test methods in the current buffer." + (interactive) + (let* ((elements (lsp-csharp--get-buffer-code-elements)) + (test-methods (lsp-csharp--collect-code-elements-recursively 'lsp-csharp--code-element-test-method-p elements)) + (test-method-framework (car (cdr (lsp-csharp--code-element-test-method-p (car test-methods))))) + (test-method-names (mapcar (lambda (method) + (car (lsp-csharp--code-element-test-method-p method))) + test-methods))) + (lsp-csharp--start-tests test-method-framework test-method-names))) + +(defun lsp-csharp-run-test-in-buffer () + "Run selected test in current buffer." + (interactive) + (when-let* ((elements (lsp-csharp--get-buffer-code-elements)) + (test-methods (lsp-csharp--collect-code-elements-recursively 'lsp-csharp--code-element-test-method-p elements)) + (test-method-framework (car (cdr (lsp-csharp--code-element-test-method-p (car test-methods))))) + (test-method-names (mapcar (lambda (method) + (car (lsp-csharp--code-element-test-method-p method))) + test-methods)) + (selected-test-method-name (lsp--completing-read "Select test:" test-method-names 'identity))) + (lsp-csharp--start-tests test-method-framework (list selected-test-method-name)))) + +(defun lsp-csharp-run-last-tests () + "Re-run test(s) that were run last time." + (interactive) + (if-let* ((last-test-method-framework (lsp-session-get-metadata "last-test-method-framework")) + (last-test-method-names (lsp-session-get-metadata "last-test-method-names"))) + (lsp-csharp--start-tests last-test-method-framework last-test-method-names) + (message "lsp-csharp: No test method(s) found to be ran previously on this workspace"))) + +(lsp-defun lsp-csharp--handle-os-error (_workspace (&omnisharp:ErrorMessage :file-name :text)) + "Handle the `o#/error' (interop) notification displaying a message." + (lsp-warn "%s: %s" file-name text)) + +(lsp-defun lsp-csharp--handle-os-testmessage (_workspace (&omnisharp:TestMessageEvent :message)) + "Handle the `o#/testmessage and display test message on test output buffer." + (lsp-csharp--test-message message)) + +(lsp-defun lsp-csharp--handle-os-testcompleted (_workspace (&omnisharp:DotNetTestResult + :method-name + :outcome + :error-message + :error-stack-trace + :standard-output + :standard-error)) + "Handle the `o#/testcompleted' message from the server. + +Will display the results of the test on the lsp-csharp test output buffer." + (let ((passed (string-equal "passed" outcome))) + (lsp-csharp--test-message + (format "[%s] %s " + (propertize (upcase outcome) 'font-lock-face (if passed 'success 'error)) + method-name)) + + (unless passed + (lsp-csharp--test-message error-message) + + (when error-stack-trace + (lsp-csharp--test-message error-stack-trace)) + + (unless (seq-empty-p standard-output) + (lsp-csharp--test-message "STANDARD OUTPUT:") + (seq-doseq (stdout-line standard-output) + (lsp-csharp--test-message stdout-line))) + + (unless (seq-empty-p standard-error) + (lsp-csharp--test-message "STANDARD ERROR:") + (seq-doseq (stderr-line standard-error) + (lsp-csharp--test-message stderr-line)))))) + +(lsp-defun lsp-csharp--action-client-find-references ((&Command :arguments?)) + "Read first argument from ACTION as Location and display xrefs for that location +using the `textDocument/references' request." + (-if-let* (((&Location :uri :range) (lsp-seq-first arguments?)) + ((&Range :start range-start) range) + (find-refs-params (append (lsp--text-document-position-params (list :uri uri) range-start) + (list :context (list :includeDeclaration json-false)))) + (locations-found (lsp-request "textDocument/references" find-refs-params))) + (lsp-show-xrefs (lsp--locations-to-xref-items locations-found) nil t) + (message "No references found"))) + +(defun lsp-csharp--omnisharp-path->qualified-name (path) + "Convert PATH to qualified-namespace-like name." + (replace-regexp-in-string + (regexp-quote "/") + "." + path)) + +(defun lsp-csharp--omnisharp-metadata-uri-handler (uri) + "Handle `file:/(metadata)' URI from omnisharp-roslyn server. + +The URI is parsed and then `o#/metadata' request is issued to retrieve +metadata from the server. A cache file is created on project root dir that +stores this metadata and filename is returned so lsp-mode can display this file." + (string-match lsp-csharp--omnisharp-metadata-uri-re uri) + (-when-let* ((project-name (lsp-csharp--omnisharp-path->qualified-name (url-unhex-string (match-string 1 uri)))) + (assembly-name (lsp-csharp--omnisharp-path->qualified-name (url-unhex-string (match-string 2 uri)))) + (type-name (lsp-csharp--omnisharp-path->qualified-name (url-unhex-string (match-string 3 uri)))) + (metadata-req (lsp-make-omnisharp-metadata-request :project-name project-name + :assembly-name assembly-name + :type-name type-name)) + (metadata (lsp-request "o#/metadata" metadata-req)) + ((&omnisharp:MetadataResponse :source-name :source) metadata) + (filename (f-join ".cache" + "lsp-csharp" + "metadata" + "Project" project-name + "Assembly" assembly-name + "Symbol" (concat type-name ".cs"))) + (file-location (expand-file-name filename (lsp--suggest-project-root))) + (metadata-file-location (concat file-location ".metadata-uri")) + (path (f-dirname file-location))) + + (unless (find-buffer-visiting file-location) + (unless (file-directory-p path) + (make-directory path t)) + + (with-temp-file metadata-file-location + (insert uri)) + + (with-temp-file file-location + (insert source))) + + file-location)) + +(defun lsp-csharp--omnisharp-uri->path-fn (uri) + "Custom implementation of lsp--uri-to-path function to glue omnisharp's +metadata uri." + (if (string-match-p lsp-csharp--omnisharp-metadata-uri-re uri) + (lsp-csharp--omnisharp-metadata-uri-handler uri) + (lsp--uri-to-path-1 uri))) + +(defun lsp-csharp--omnisharp-environment-fn () + "Build environment structure for current values of lsp-csharp customizables. +See https://github.com/OmniSharp/omnisharp-roslyn/wiki/Configuration-Options" + `(("OMNISHARP_RoslynExtensionsOptions:enableDecompilationSupport" . ,(if lsp-csharp-omnisharp-enable-decompilation-support "true" "false")))) + +(lsp-register-client + (make-lsp-client :new-connection + (lsp-stdio-connection + #'(lambda () + (append + (list (lsp-csharp--language-server-path) "-lsp") + (when lsp-csharp-solution-file + (list "-s" (expand-file-name lsp-csharp-solution-file))))) + #'(lambda () + (when-let* ((binary (lsp-csharp--language-server-path))) + (f-exists? binary)))) + :activation-fn (lsp-activate-on "csharp") + :server-id 'omnisharp + :priority -1 + :uri->path-fn #'lsp-csharp--omnisharp-uri->path-fn + :environment-fn #'lsp-csharp--omnisharp-environment-fn + :action-handlers (ht ("omnisharp/client/findReferences" 'lsp-csharp--action-client-find-references)) + :notification-handlers (ht ("o#/projectadded" 'ignore) + ("o#/projectchanged" 'ignore) + ("o#/projectremoved" 'ignore) + ("o#/packagerestorestarted" 'ignore) + ("o#/msbuildprojectdiagnostics" 'ignore) + ("o#/packagerestorefinished" 'ignore) + ("o#/unresolveddependencies" 'ignore) + ("o#/error" 'lsp-csharp--handle-os-error) + ("o#/testmessage" 'lsp-csharp--handle-os-testmessage) + ("o#/testcompleted" 'lsp-csharp--handle-os-testcompleted) + ("o#/projectconfiguration" 'ignore) + ("o#/projectdiagnosticstatus" 'ignore) + ("o#/backgrounddiagnosticstatus" 'ignore)) + :download-server-fn #'lsp-csharp--omnisharp-download-server)) + +;; +;; Alternative "csharp-ls" language server support +;; see https://github.com/razzmatazz/csharp-language-server +;; +(lsp-defun lsp-csharp--cls-metadata-uri-handler (uri) + "Handle `csharp:/(metadata)' uri from csharp-ls server. + +`csharp/metadata' request is issued to retrieve metadata from the server. +A cache file is created on project root dir that stores this metadata and +filename is returned so lsp-mode can display this file." + + (-when-let* ((metadata-req (lsp-make-csharp-ls-c-sharp-metadata + :text-document (lsp-make-text-document-identifier :uri uri))) + (metadata (lsp-request "csharp/metadata" metadata-req)) + ((&csharp-ls:CSharpMetadataResponse :project-name + :assembly-name + :symbol-name + :source) metadata) + (filename (f-join ".cache" + "lsp-csharp" + "metadata" + "projects" project-name + "assemblies" assembly-name + (concat symbol-name ".cs"))) + (file-location (expand-file-name filename (lsp-workspace-root))) + (metadata-file-location (concat file-location ".metadata-uri")) + (path (f-dirname file-location))) + + (unless (file-exists-p file-location) + (unless (file-directory-p path) + (make-directory path t)) + + (with-temp-file metadata-file-location + (insert uri)) + + (with-temp-file file-location + (insert source))) + + file-location)) + +(defun lsp-csharp--cls-before-file-open (_workspace) + "Set `lsp-buffer-uri' variable after C# file is open from *.metadata-uri file." + + (let ((metadata-file-name (concat buffer-file-name ".metadata-uri"))) + (setq-local lsp-buffer-uri + (when (file-exists-p metadata-file-name) + (with-temp-buffer (insert-file-contents metadata-file-name) + (buffer-string)))))) + +(defun lsp-csharp--cls-find-executable () + (or (when lsp-csharp-csharpls-use-dotnet-tool + (if lsp-csharp-csharpls-use-local-tool + (list "dotnet" "tool" "run" "csharp-ls") + (list "csharp-ls"))) + (executable-find "csharp-ls") + (f-join (or (getenv "USERPROFILE") (getenv "HOME")) + ".dotnet" "tools" "csharp-ls"))) + +(defun lsp-csharp--cls-make-launch-cmd () + "Return command line to invoke csharp-ls." + + ;; emacs-28.1 on macOS has an issue + ;; that it launches processes using posix_spawn but does not reset sigmask properly + ;; thus causing dotnet runtime to lockup awaiting a SIGCHLD signal that never comes + ;; from subprocesses that quit + ;; + ;; as a workaround we will wrap csharp-ls invocation in "/bin/ksh -c" on macos + ;; so it launches with proper sigmask + ;; + ;; see https://lists.gnu.org/archive/html/emacs-devel/2022-02/msg00461.html + + (let ((startup-wrapper (cond ((and (eq 'darwin system-type) + (version= "28.1" emacs-version)) + (list "/bin/ksh" "-c")) + + (t nil))) + + (csharp-ls-exec (lsp-csharp--cls-find-executable)) + + (solution-file-params (when lsp-csharp-solution-file + (list "-s" lsp-csharp-solution-file)))) + (append startup-wrapper + (if (listp csharp-ls-exec) + csharp-ls-exec + (list csharp-ls-exec)) + solution-file-params))) + +(defun lsp-csharp--cls-test-csharp-ls-present () + "Return non-nil if dotnet tool csharp-ls is installed as a dotnet tool." + (string-match-p "csharp-ls" + (shell-command-to-string + (if lsp-csharp-csharpls-use-local-tool + "dotnet tool list" + "dotnet tool list -g")))) + +(defun lsp-csharp--cls-download-server (_client callback error-callback update?) + "Install/update csharp-ls language server using `dotnet tool'. + +Will invoke CALLBACK or ERROR-CALLBACK based on result. +Will update if UPDATE? is t" + (lsp-async-start-process + callback + error-callback + "dotnet" "tool" (if update? "update" "install") (if lsp-csharp-csharpls-use-local-tool "" "-g") "csharp-ls")) + +(lsp-register-client + (make-lsp-client :new-connection (lsp-stdio-connection #'lsp-csharp--cls-make-launch-cmd) + :priority -2 + :server-id 'csharp-ls + :activation-fn (lsp-activate-on "csharp") + :before-file-open-fn #'lsp-csharp--cls-before-file-open + :uri-handlers (ht ("csharp" #'lsp-csharp--cls-metadata-uri-handler)) + :download-server-fn #'lsp-csharp--cls-download-server)) + +(lsp-consistency-check lsp-csharp) + +(provide 'lsp-csharp) +;;; lsp-csharp.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-csharp.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-csharp.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-css.el b/emacs/elpa/lsp-mode-20241119.828/lsp-css.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-css.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-css.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-cucumber.el b/emacs/elpa/lsp-mode-20241119.828/lsp-cucumber.el @@ -0,0 +1,97 @@ +;;; lsp-cucumber.el --- LSP Clients for Cucumber -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Shen, Jen-Chieh + +;; 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 this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; LSP server implementation for Cucumber +;; + +;;; Code: + +(require 'lsp-mode) + +(defgroup lsp-cucumber nil + "LSP server implementation for Cucumber." + :group 'lsp-mode + :link '(url-link "https://github.com/cucumber/language-server")) + +(defcustom lsp-cucumber-server-path nil + "Path points for Cucumber language server. + +This is only for development use." + :type 'string + :group 'lsp-cucumber) + +(defcustom lsp-cucumber-active-modes + '( feature-mode) + "List of major mode that work with Cucumber language server." + :type '(list symbol) + :group 'lsp-cucumber) + +(lsp-defcustom lsp-cucumber-features + ["src/test/**/*.feature" "features/**/*.feature" "tests/**/*.feature" "*specs*/**/*.feature"] + "Configure where the extension should look for .feature files." + :type '(repeat string) + :group 'lsp-cucumber + :package-version '(lsp-mode . "9.0.0") + :lsp-path "cucumber.features") + +(lsp-defcustom lsp-cucumber-glue + ["*specs*/**/*.cs" "features/**/*.js" "features/**/*.jsx" "features/**/*.php" "features/**/*.py" "features/**/*.rs" "features/**/*.rb" "features/**/*.ts" "features/**/*.tsx" "features/**/*_test.go" "**/*_test.go" "src/test/**/*.java" "tests/**/*.py" "tests/**/*.rs"] + "Configure where the extension should look for source code where +step definitions and parameter types are defined." + :type '(repeat string) + :group 'lsp-cucumber + :package-version '(lsp-mode . "9.0.0") + :lsp-path "cucumber.glue") + +(lsp-defcustom lsp-cucumber-parameter-types [] + "Configure parameters types to convert output parameters to your own types. + +Details at https://github.com/cucumber/cucumber-expressions#custom-parameter-types. +Sample: +[(:name \"actor\" + :regexp \"[A-Z][a-z]+\")]" + :type '(lsp-repeatable-vector plist) + :group 'lsp-cucumber + :package-version '(lsp-mode . "9.0.0") + :lsp-path "cucumber.parameterTypes") + +(defun lsp-cucumber--server-command () + "Generate startup command for Cucumber language server." + (or (and lsp-cucumber-server-path + (list lsp-cucumber-server-path "--stdio")) + (list (lsp-package-path 'cucumber-language-server) "--stdio"))) + +(lsp-dependency 'cucumber-language-server + '(:system "cucumber-language-server") + '(:npm :package "@cucumber/language-server" + :path "cucumber-language-server")) + +(lsp-register-client + (make-lsp-client + :new-connection (lsp-stdio-connection #'lsp-cucumber--server-command) + :major-modes lsp-cucumber-active-modes + :priority -1 + :server-id 'cucumber-language-server + :download-server-fn (lambda (_client callback error-callback _update?) + (lsp-package-ensure 'cucumber-language-server callback error-callback)))) + +(provide 'lsp-cucumber) +;;; lsp-cucumber.el ends here diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-cucumber.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-cucumber.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-cypher.el b/emacs/elpa/lsp-mode-20241119.828/lsp-cypher.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-cypher.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-cypher.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-d.el b/emacs/elpa/lsp-mode-20241119.828/lsp-d.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-d.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-d.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-dhall.el b/emacs/elpa/lsp-mode-20241119.828/lsp-dhall.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-dhall.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-dhall.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-diagnostics.el b/emacs/elpa/lsp-mode-20241119.828/lsp-diagnostics.el @@ -0,0 +1,373 @@ +;;; lsp-diagnostics.el --- LSP diagnostics integration -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2020 emacs-lsp maintainers +;; +;; 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: +;; +;; LSP diagnostics integration +;; +;;; Code: + +(require 'lsp-mode) + +(defgroup lsp-diagnostics nil + "LSP support for diagnostics" + :prefix "lsp-disagnostics-" + :group 'lsp-mode + :tag "LSP Diagnostics") + +;;;###autoload +(define-obsolete-variable-alias 'lsp-diagnostic-package + 'lsp-diagnostics-provider "lsp-mode 7.0.1") + +(defcustom lsp-diagnostics-provider :auto + "The checker backend provider." + :type + '(choice + (const :tag "Pick flycheck if present and fallback to flymake" :auto) + (const :tag "Pick flycheck" :flycheck) + (const :tag "Pick flymake" :flymake) + (const :tag "Use neither flymake nor lsp" :none) + (const :tag "Prefer flymake" t) + (const :tag "Prefer flycheck" nil)) + :group 'lsp-diagnostics + :package-version '(lsp-mode . "6.3")) + +;;;###autoload +(define-obsolete-variable-alias 'lsp-flycheck-default-level + 'lsp-diagnostics-flycheck-default-level "lsp-mode 7.0.1") + +(defcustom lsp-diagnostics-flycheck-default-level 'error + "Error level to use when the server does not report back a diagnostic level." + :type '(choice + (const error) + (const warning) + (const info)) + :group 'lsp-diagnostics) + +(defcustom lsp-diagnostics-attributes + `((unnecessary :foreground "gray") + (deprecated :strike-through t)) + "The Attributes used on the diagnostics. +List containing (tag attributes) where tag is the LSP diagnostic tag and +attributes is a `plist' containing face attributes which will be applied +on top the flycheck face for that error level." + :type '(repeat (list symbol plist)) + :group 'lsp-diagnostics) + +(defcustom lsp-diagnostics-disabled-modes nil + "A list of major models for which `lsp-diagnostics-mode' should be disabled." + :type '(repeat symbol) + :group 'lsp-diagnostics + :package-version '(lsp-mode . "8.0.0")) + +;; Flycheck integration + +(declare-function flycheck-mode "ext:flycheck") +(declare-function flycheck-define-generic-checker + "ext:flycheck" (symbol docstring &rest properties)) +(declare-function flycheck-error-new "ext:flycheck" t t) +(declare-function flycheck-error-message "ext:flycheck" (err) t) +(declare-function flycheck-define-error-level "ext:flycheck" (level &rest properties)) +(declare-function flycheck-buffer "ext:flycheck") +(declare-function flycheck-valid-checker-p "ext:flycheck") +(declare-function flycheck-stop "ext:flycheck") + +(defvar flycheck-mode) +(defvar flycheck-check-syntax-automatically) +(defvar flycheck-checker) +(defvar flycheck-checkers) + + +(defvar-local lsp-diagnostics--flycheck-enabled nil + "True when lsp diagnostics flycheck integration has been enabled in this buffer.") + +(defvar-local lsp-diagnostics--flycheck-checker nil + "The value of flycheck-checker before lsp diagnostics was activated.") + +(defun lsp-diagnostics--flycheck-level (flycheck-level tags) + "Generate flycheck level from the original FLYCHECK-LEVEL (e. +g. `error', `warning') and list of LSP TAGS." + (let ((name (format "lsp-flycheck-%s-%s" + flycheck-level + (mapconcat #'symbol-name tags "-")))) + (or (intern-soft name) + (let* ((face (--doto (intern (format "%s-face" name)) + (copy-face (-> flycheck-level + (get 'flycheck-overlay-category) + (get 'face)) + it) + (mapc (lambda (tag) + (apply #'set-face-attribute it nil + (cl-rest (assoc tag lsp-diagnostics-attributes)))) + tags))) + (category (--doto (intern (format "%s-category" name)) + (setf (get it 'face) face + (get it 'priority) 100))) + (new-level (intern name)) + (bitmap (or (get flycheck-level 'flycheck-fringe-bitmaps) + (get flycheck-level 'flycheck-fringe-bitmap-double-arrow)))) + (flycheck-define-error-level new-level + :severity (get flycheck-level 'flycheck-error-severity) + :compilation-level (get flycheck-level 'flycheck-compilation-level) + :overlay-category category + :fringe-bitmap bitmap + :fringe-face (get flycheck-level 'flycheck-fringe-face) + :error-list-face face) + new-level)))) + +(defun lsp-diagnostics--flycheck-calculate-level (severity tags) + "Calculate flycheck level by SEVERITY and TAGS." + (let ((level (pcase severity + (1 'error) + (2 'warning) + (3 'info) + (4 'info) + (_ lsp-flycheck-default-level))) + ;; materialize only first tag. + (tags (seq-map (lambda (tag) + (cond + ((= tag lsp/diagnostic-tag-unnecessary) 'unnecessary) + ((= tag lsp/diagnostic-tag-deprecated) 'deprecated))) + tags))) + (if tags + (lsp-diagnostics--flycheck-level level tags) + level))) + +(defun lsp-diagnostics--flycheck-start (checker callback) + "Start an LSP syntax check with CHECKER. + +CALLBACK is the status callback passed by Flycheck." + + (remove-hook 'lsp-on-idle-hook #'lsp-diagnostics--flycheck-buffer t) + + (->> (lsp--get-buffer-diagnostics) + (-map (-lambda ((&Diagnostic :message :severity? :tags? :code? :source? + :range (&Range :start (start &as &Position + :line start-line + :character start-character) + :end (end &as &Position + :line end-line + :character end-character)))) + (flycheck-error-new + :buffer (current-buffer) + :checker checker + :filename buffer-file-name + :message message + :level (lsp-diagnostics--flycheck-calculate-level severity? tags?) + :id code? + :group source? + :line (lsp-translate-line (1+ start-line)) + :column (1+ (lsp-translate-column start-character)) + :end-line (lsp-translate-line (1+ end-line)) + :end-column (unless (lsp--position-equal start end) + (1+ (lsp-translate-column end-character)))))) + (funcall callback 'finished))) + +(defun lsp-diagnostics--flycheck-buffer () + "Trigger flyckeck on buffer." + (remove-hook 'lsp-on-idle-hook #'lsp-diagnostics--flycheck-buffer t) + (when (bound-and-true-p flycheck-mode) + (flycheck-buffer))) + +(defun lsp-diagnostics--flycheck-report () + "Report flycheck. +This callback is invoked when new diagnostics are received +from the language server." + (when (and (or (memq 'idle-change flycheck-check-syntax-automatically) + (and (memq 'save flycheck-check-syntax-automatically) + (not (buffer-modified-p)))) + lsp--cur-workspace) + ;; make sure diagnostics are published even if the diagnostics + ;; have been received after idle-change has been triggered + (->> lsp--cur-workspace + (lsp--workspace-buffers) + (mapc (lambda (buffer) + (when (and (lsp-buffer-live-p buffer) + (or + (not (bufferp buffer)) + (and (get-buffer-window buffer) + (not (-contains? (buffer-local-value 'lsp-on-idle-hook buffer) + 'lsp-diagnostics--flycheck-buffer))))) + (lsp-with-current-buffer buffer + (add-hook 'lsp-on-idle-hook #'lsp-diagnostics--flycheck-buffer nil t) + (lsp--idle-reschedule (current-buffer))))))))) + +(cl-defgeneric lsp-diagnostics-flycheck-error-explainer (e _server-id) + "Explain a `flycheck-error' E in a generic way depending on the SERVER-ID." + (flycheck-error-message e)) + +(defvar lsp-diagnostics-mode) ;; properly defined by define-minor-mode below + +;;;###autoload +(defun lsp-diagnostics-lsp-checker-if-needed () + (unless (flycheck-valid-checker-p 'lsp) + (flycheck-define-generic-checker 'lsp + "A syntax checker using the Language Server Protocol (LSP) +provided by lsp-mode. +See https://github.com/emacs-lsp/lsp-mode." + :start #'lsp-diagnostics--flycheck-start + :modes '(lsp-placeholder-mode) ;; placeholder + :predicate (lambda () lsp-diagnostics-mode) + :error-explainer (lambda (e) + (lsp-diagnostics-flycheck-error-explainer + e (lsp--workspace-server-id (car-safe (lsp-workspaces)))))))) + +(defun lsp-diagnostics-flycheck-enable (&rest _) + "Enable flycheck integration for the current buffer." + (require 'flycheck) + (lsp-diagnostics-lsp-checker-if-needed) + (and (not lsp-diagnostics--flycheck-enabled) + (not (eq flycheck-checker 'lsp)) + (setq lsp-diagnostics--flycheck-checker flycheck-checker)) + (setq-local lsp-diagnostics--flycheck-enabled t) + (flycheck-mode 1) + (flycheck-stop) + (setq-local flycheck-checker 'lsp) + (lsp-flycheck-add-mode major-mode) + (add-to-list 'flycheck-checkers 'lsp) + (add-hook 'lsp-diagnostics-updated-hook #'lsp-diagnostics--flycheck-report nil t) + (add-hook 'lsp-managed-mode-hook #'lsp-diagnostics--flycheck-report nil t)) + +(defun lsp-diagnostics-flycheck-disable () + "Disable flycheck integration for the current buffer is it was enabled." + (when lsp-diagnostics--flycheck-enabled + (flycheck-stop) + (when (eq flycheck-checker 'lsp) + (setq-local flycheck-checker lsp-diagnostics--flycheck-checker)) + (setq lsp-diagnostics--flycheck-checker nil) + (setq-local lsp-diagnostics--flycheck-enabled nil) + (when flycheck-mode + (flycheck-mode 1)))) + +;; Flymake integration + +(declare-function flymake-mode "ext:flymake") +(declare-function flymake-make-diagnostic "ext:flymake") +(declare-function flymake-diag-region "ext:flymake") + +(defvar flymake-diagnostic-functions) +(defvar flymake-mode) +(defvar-local lsp-diagnostics--flymake-report-fn nil) + +(defun lsp-diagnostics--flymake-setup () + "Setup flymake." + (setq lsp-diagnostics--flymake-report-fn nil) + (add-hook 'flymake-diagnostic-functions 'lsp-diagnostics--flymake-backend nil t) + (add-hook 'lsp-diagnostics-updated-hook 'lsp-diagnostics--flymake-after-diagnostics nil t) + (flymake-mode 1)) + +(defun lsp-diagnostics--flymake-after-diagnostics () + "Handler for `lsp-diagnostics-updated-hook'." + (cond + ((and lsp-diagnostics--flymake-report-fn flymake-mode) + (lsp-diagnostics--flymake-update-diagnostics)) + ((not flymake-mode) + (setq lsp-diagnostics--flymake-report-fn nil)))) + +(defun lsp-diagnostics--flymake-backend (report-fn &rest _args) + "Flymake backend using REPORT-FN." + (let ((first-run (null lsp-diagnostics--flymake-report-fn))) + (setq lsp-diagnostics--flymake-report-fn report-fn) + (when first-run + (lsp-diagnostics--flymake-update-diagnostics)))) + +(defun lsp-diagnostics--flymake-update-diagnostics () + "Report new diagnostics to flymake." + (funcall lsp-diagnostics--flymake-report-fn + (-some->> (lsp-diagnostics t) + (gethash (lsp--fix-path-casing buffer-file-name)) + (--map (-let* (((&Diagnostic :message :severity? + :range (range &as &Range + :start (&Position :line start-line :character) + :end (&Position :line end-line))) it) + ((start . end) (lsp--range-to-region range))) + (when (= start end) + (if-let* ((region (flymake-diag-region (current-buffer) + (1+ start-line) + character))) + (setq start (car region) + end (cdr region)) + (lsp-save-restriction-and-excursion + (goto-char (point-min)) + (setq start (line-beginning-position (1+ start-line)) + end (line-end-position (1+ end-line)))))) + (flymake-make-diagnostic (current-buffer) + start + end + (cl-case severity? + (1 :error) + (2 :warning) + (t :note)) + message)))) + ;; This :region keyword forces flymake to delete old diagnostics in + ;; case the buffer hasn't changed since the last call to the report + ;; function. See https://github.com/joaotavora/eglot/issues/159 + :region (cons (point-min) (point-max)))) + + + +;;;###autoload +(defun lsp-diagnostics--enable () + "Enable LSP checker support." + (when (and (member lsp-diagnostics-provider '(:auto :none :flycheck :flymake t nil)) + (not (member major-mode lsp-diagnostics-disabled-modes))) + (lsp-diagnostics-mode 1))) + +(defun lsp-diagnostics--disable () + "Disable LSP checker support." + (lsp-diagnostics-mode -1)) + +;;;###autoload +(define-minor-mode lsp-diagnostics-mode + "Toggle LSP diagnostics integration." + :group 'lsp-diagnostics + :global nil + :lighter "" + (cond + (lsp-diagnostics-mode + (cond + ((and (or + (and (eq lsp-diagnostics-provider :auto) + (functionp 'flycheck-mode)) + (and (eq lsp-diagnostics-provider :flycheck) + (or (functionp 'flycheck-mode) + (user-error "The lsp-diagnostics-provider is set to :flycheck but flycheck is not installed?"))) + ;; legacy + (null lsp-diagnostics-provider)) + (require 'flycheck nil t)) + (lsp-diagnostics-flycheck-enable)) + ((or (eq lsp-diagnostics-provider :auto) + (eq lsp-diagnostics-provider :flymake) + (eq lsp-diagnostics-provider t)) + (require 'flymake) + (lsp-diagnostics--flymake-setup)) + ((not (eq lsp-diagnostics-provider :none)) + (lsp--warn "Unable to autoconfigure flycheck/flymake. The diagnostics won't be rendered."))) + + (add-hook 'lsp-unconfigure-hook #'lsp-diagnostics--disable nil t)) + (t (lsp-diagnostics-flycheck-disable) + (remove-hook 'lsp-unconfigure-hook #'lsp-diagnostics--disable t)))) + +;;;###autoload +(add-hook 'lsp-configure-hook (lambda () + (when lsp-auto-configure + (lsp-diagnostics--enable)))) + +(lsp-consistency-check lsp-diagnostics) + +(provide 'lsp-diagnostics) +;;; lsp-diagnostics.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-diagnostics.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-diagnostics.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-dired.el b/emacs/elpa/lsp-mode-20241119.828/lsp-dired.el @@ -0,0 +1,181 @@ +;;; lsp-dired.el --- `lsp-mode' diagnostics integrated into `dired' -*- lexical-binding: t -*- + +;; Copyright (C) 2021 + +;; Author: Alexander Miller <alexanderm@web.de> +;; Author: Ivan Yonchovski <yyoncho@gmail.com> + +;; 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: +;;; `lsp-mode' diagnostics integrated into `dired' + +;;; Code: + +(require 'dired) +(require 'pcase) +(require 'lsp-mode) + +(defgroup lsp-dired nil + "LSP support for dired" + :prefix "lsp-dired-" + :group 'lsp-mode + :tag "LSP Dired") + +(defvar lsp-dired--ranger-adjust nil) +(with-eval-after-load 'ranger (setf lsp-dired--ranger-adjust t)) + +(defvar-local lsp-dired-displayed nil + "Flags whether icons have been added.") + +(defvar-local lsp-dired--covered-subdirs nil + "List of subdirs icons were already added for.") + +(defun lsp-dired--display () + "Display the icons of files in a dired buffer." + (when (and (display-graphic-p) + (not lsp-dired-displayed) + dired-subdir-alist) + (setq-local lsp-dired-displayed t) + (pcase-dolist (`(,path . ,pos) dired-subdir-alist) + (lsp-dired--insert-for-subdir path pos)))) + +(defun lsp-dired--insert-for-subdir (path pos) + "Display icons for subdir PATH at given POS." + (let ((buf (current-buffer))) + ;; run the function after current to make sure that we are creating the + ;; overlays after `treemacs-icons-dired' has run. + (run-with-idle-timer + 0.0 nil + (lambda () + (unless (and (member path lsp-dired--covered-subdirs) + (not (buffer-live-p buf))) + (with-current-buffer buf + (add-to-list 'lsp-dired--covered-subdirs path) + (let (buffer-read-only) + (save-excursion + (goto-char pos) + (forward-line (if lsp-dired--ranger-adjust 1 2)) + (cl-block :file + (while (not (eobp)) + (if (dired-move-to-filename nil) + (let* ((file (dired-get-filename nil t)) + (bol (progn + (search-forward-regexp "^[[:space:]]*" (line-end-position) t) + (point))) + (face (lsp-dired--face-for-path file))) + (when face + (-doto (make-overlay bol (line-end-position)) + (overlay-put 'evaporate t) + (overlay-put 'face face)))) + (cl-return-from :file nil)) + (forward-line 1))))))))))) + +(defface lsp-dired-path-face '((t :inherit font-lock-string-face)) + "Face used for breadcrumb paths on headerline." + :group 'lsp-dired) + +(defface lsp-dired-path-error-face + '((t :underline (:style wave :color "Red1"))) + "Face used for breadcrumb paths on headerline when there is an error under +that path" + :group 'lsp-dired) + +(defface lsp-dired-path-warning-face + '((t :underline (:style wave :color "Yellow"))) + "Face used for breadcrumb paths on headerline when there is an warning under +that path" + :group 'lsp-dired) + +(defface lsp-dired-path-info-face + '((t :underline (:style wave :color "Green"))) + "Face used for breadcrumb paths on headerline when there is an info under that +path" + :group 'lsp-dired) + +(defface lsp-dired-path-hint-face + '((t :underline (:style wave :color "Green"))) + "Face used for breadcrumb paths on headerline when there is an hint under that +path" + :group 'lsp-dired) + +(defun lsp-dired--face-for-path (dir) + "Calculate the face for DIR." + (when-let* ((diags (lsp-diagnostics-stats-for (directory-file-name dir)))) + (cl-labels ((check-severity + (severity) + (not (zerop (aref diags severity))))) + (cond + ((check-severity lsp/diagnostic-severity-error) + 'lsp-dired-path-error-face) + ((check-severity lsp/diagnostic-severity-warning) + 'lsp-dired-path-warning-face) + ((check-severity lsp/diagnostic-severity-information) + 'lsp-dired-path-info-face) + ((check-severity lsp/diagnostic-severity-hint) + 'lsp-dired-path-hint-face))))) + +(defun lsp-dired--insert-subdir-advice (&rest args) + "Advice to dired & dired+ insert-subdir commands. +Will add icons for the subdir in the `car' of ARGS." + (let* ((path (car args)) + (pos (cdr (assoc path dired-subdir-alist)))) + (when pos + (lsp-dired--insert-for-subdir path pos)))) + +(defun lsp-dired--kill-subdir-advice (&rest _args) + "Advice to dired kill-subdir commands. +Will remove the killed subdir from `lsp-dired--covered-subdirs'." + (setf lsp-dired--covered-subdirs (delete (dired-current-directory) + lsp-dired--covered-subdirs))) + +(defun lsp-dired--reset (&rest _args) + "Reset metadata on revert." + (setq-local lsp-dired--covered-subdirs nil) + (setq-local lsp-dired-displayed nil)) + +;;;###autoload +(define-minor-mode lsp-dired-mode + "Display `lsp-mode' icons for each file in a dired buffer." + :require 'lsp-dired + :init-value nil + :global t + :group 'lsp-dired + (cond + (lsp-dired-mode + (add-hook 'dired-after-readin-hook #'lsp-dired--display) + (advice-add 'dired-kill-subdir :before #'lsp-dired--kill-subdir-advice) + (advice-add 'dired-insert-subdir :after #'lsp-dired--insert-subdir-advice) + (advice-add 'diredp-insert-subdirs :after #'lsp-dired--insert-subdir-advice) + (advice-add 'dired-revert :before #'lsp-dired--reset) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (derived-mode-p 'dired-mode) + (lsp-dired--display))))) + (t + (advice-remove 'dired-kill-subdir #'lsp-dired--kill-subdir-advice) + (advice-remove 'dired-insert-subdir #'lsp-dired--insert-subdir-advice) + (advice-remove 'diredp-insert-subdirs #'lsp-dired--insert-subdir-advice) + (advice-remove 'dired-revert #'lsp-dired--reset) + (remove-hook 'dired-after-readin-hook #'lsp-dired--display) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (derived-mode-p 'dired-mode) + (dired-revert))))))) + + +(lsp-consistency-check lsp-dired)(provide 'lsp-dired) + + +;;; lsp-dired.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-dired.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-dired.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-dockerfile.el b/emacs/elpa/lsp-mode-20241119.828/lsp-dockerfile.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-dockerfile.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-dockerfile.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-dot.el b/emacs/elpa/lsp-mode-20241119.828/lsp-dot.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-dot.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-dot.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-earthly.el b/emacs/elpa/lsp-mode-20241119.828/lsp-earthly.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-earthly.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-earthly.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-elixir.el b/emacs/elpa/lsp-mode-20241119.828/lsp-elixir.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-elixir.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-elixir.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-elm.el b/emacs/elpa/lsp-mode-20241119.828/lsp-elm.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-elm.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-elm.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-emmet.el b/emacs/elpa/lsp-mode-20241119.828/lsp-emmet.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-emmet.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-emmet.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-erlang.el b/emacs/elpa/lsp-mode-20241119.828/lsp-erlang.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-erlang.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-erlang.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-eslint.el b/emacs/elpa/lsp-mode-20241119.828/lsp-eslint.el @@ -0,0 +1,454 @@ +;;; lsp-eslint.el --- lsp-mode eslint integration -*- lexical-binding: t; -*- + +;; Copyright (C) 2019 Ivan Yonchovski + +;; Author: Ivan Yonchovski <yyoncho@gmail.com> +;; Keywords: languages + +;; 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: + +;; + +;;; Code: + +(require 'lsp-protocol) +(require 'lsp-mode) + +(defconst lsp-eslint/status-ok 1) +(defconst lsp-eslint/status-warn 2) +(defconst lsp-eslint/status-error 3) + +(defgroup lsp-eslint nil + "ESLint language server group." + :group 'lsp-mode + :link '(url-link "https://github.com/microsoft/vscode-eslint")) + +(defcustom lsp-eslint-unzipped-path (f-join lsp-server-install-dir "eslint/unzipped") + "The path to the file in which `eslint' will be stored." + :type 'file + :group 'lsp-eslint + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-eslint-download-url "https://github.com/emacs-lsp/lsp-server-binaries/blob/master/dbaeumer.vscode-eslint-3.0.10.vsix?raw=true" + "ESLint language server download url." + :type 'string + :group 'lsp-eslint + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-eslint-server-command `("node" + "~/server/out/eslintServer.js" + "--stdio") + "Command to start ESLint server." + :risky t + :type '(repeat string) + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-eslint-enable t + "Controls whether ESLint is enabled for JavaScript files or not." + :type 'boolean + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-eslint-package-manager "npm" + "The package manager you use to install node modules." + :type '(choice (const :tag "npm" "npm") + (const :tag "yarn" "yarn") + (const :tag "pnpm" "pnpm") + (string :tag "other")) + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-eslint-format t + "Whether to perform format." + :type 'boolean + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-eslint-node-path nil + "A path added to NODE_PATH when resolving the `eslint' module." + :type '(repeat string) + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-eslint-node "node" + "Path to Node.js." + :type 'file + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-eslint-options nil + "The ESLint options object to provide args normally passed to + `eslint' when executed from a command line (see + https://eslint.org/docs/latest/integrate/nodejs-api)." + :type 'alist) + +(defcustom lsp-eslint-experimental nil + "The eslint experimental configuration." + :type 'alist) + +(defcustom lsp-eslint-config-problems nil + "The eslint problems configuration." + :type 'alist) + +(defcustom lsp-eslint-time-budget nil + "The eslint config to inform you of slow validation times and + long ESLint runs when computing code fixes during save." + :type 'alist) + +(defcustom lsp-eslint-trace-server "off" + "Traces the communication between VSCode and the ESLint linter service." + :type 'string) + +(defcustom lsp-eslint-run "onType" + "Run the linter on save (onSave) or on type (onType)" + :type '(choice (const :tag "onSave" "onSave") + (const :tag "onType" "onType")) + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-eslint-auto-fix-on-save nil + "Turns auto fix on save on or off." + :type 'boolean + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-eslint-fix-all-problem-type "all" + "Determines which problems are fixed when running the +source.fixAll code action." + :type '(choice + (const "all") + (const "problems") + string) + :package-version '(lsp-mode . "7.0.1")) + +(defcustom lsp-eslint-quiet nil + "Turns on quiet mode, which ignores warnings." + :type 'boolean + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-eslint-working-directories [] + "A vector of working directory names to use. Can be a pattern, an absolute path +or a path relative to the workspace. Examples: + - \"/home/user/abc/\" + - \"abc/\" + - (directory \"abc\") which is equivalent to \"abc\" above + - (pattern \"abc/*\") +Note that the home directory reference ~/ is not currently supported, use +/home/[user]/ instead." + :type 'lsp-string-vector + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-eslint-validate '("svelte") + "An array of language ids which should always be validated by ESLint." + :type '(repeat string) + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-eslint-provide-lint-task nil + "Controls whether a task for linting the whole workspace will be available." + :type 'boolean + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-eslint-lint-task-enable nil + "Controls whether a task for linting the whole workspace will be available." + :type 'boolean + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-eslint-lint-task-options "." + "Command line options applied when running the task for linting the whole +workspace (see https://eslint.org/docs/user-guide/command-line-interface)." + :type 'string + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-eslint-runtime nil + "The location of the node binary to run ESLint under." + :type '(repeat string) + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-eslint-code-action-disable-rule-comment t + "Controls whether code actions to add a rule-disabling comment should be shown." + :type 'bool + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-eslint-code-action-disable-rule-comment-location "separateLine" + "Controls where the disable rule code action places comments. + +Accepts the following values: +- \"separateLine\": Add the comment above the line to be disabled (default). +- \"sameLine\": Add the comment on the same line that will be disabled." + :type '(choice + (const "separateLine") + (const "sameLine")) + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-eslint-code-action-show-documentation t + "Controls whether code actions to show documentation for an ESLint rule should +be shown." + :type 'bool + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-eslint-warn-on-ignored-files nil + "Controls whether a warning should be emitted when a file is ignored." + :type 'bool + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-eslint-rules-customizations [] + "Controls severity overrides for ESLint rules. + +The value is a vector of alists, with each alist containing the following keys: +- rule - The rule to match. Can match wildcards with *, or be prefixed with ! + to negate the match. +- severity - The severity to report this rule as. Can be one of the following: + - \"off\": Disable the rule. + - \"info\": Report as informational. + - \"warn\": Report as a warning. + - \"error\": Report as an error. + - \"upgrade\": Increase by 1 severity level (eg. warning -> error). + - \"downgrade\": Decrease by 1 severity level (eg. warning -> info). + - \"default\": Report as the same severity specified in the ESLint config." + :type '(lsp-repeatable-vector + (alist :options ((rule string) + (severity (choice + (const "off") + (const "info") + (const "warn") + (const "error") + (const "upgrade") + (const "downgrade") + (const "default")))))) + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-eslint-experimental-incremental-sync t + "Controls whether the new incremental text document synchronization should +be used." + :type 'boolean + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-eslint-save-library-choices t + "Controls whether to remember choices made to permit or deny ESLint libraries +from running." + :type 'boolean + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-eslint-library-choices-file (expand-file-name (locate-user-emacs-file ".lsp-eslint-choices")) + "The file where choices to permit or deny ESLint libraries from running is +stored." + :type 'string + :package-version '(lsp-mode . "8.0.0")) + +(defun lsp--find-eslint () + (or + (when-let* ((workspace-folder (lsp-find-session-folder (lsp-session) default-directory))) + (let ((eslint-local-path (f-join workspace-folder "node_modules" ".bin" + (if (eq system-type 'windows-nt) "eslint.cmd" "eslint")))) + (when (f-exists? eslint-local-path) + eslint-local-path))) + "eslint")) + +(defun lsp-eslint-create-default-configuration () + "Create default ESLint configuration." + (interactive) + (unless (lsp-session-folders (lsp-session)) + (user-error "There are no workspace folders")) + (pcase (->> (lsp-session) + lsp-session-folders + (-filter (lambda (dir) + (-none? + (lambda (file) (f-exists? (f-join dir file))) + '(".eslintrc.js" ".eslintrc.yaml" ".eslintrc.yml" ".eslintrc" ".eslintrc.json"))))) + (`nil (user-error "All workspace folders contain ESLint configuration")) + (folders (let ((default-directory (completing-read "Select project folder: " folders nil t))) + (async-shell-command (format "%s --init" (lsp--find-eslint))))))) + +(lsp-defun lsp-eslint-status-handler (workspace (&eslint:StatusParams :state)) + (setf (lsp--workspace-status-string workspace) + (propertize "ESLint" + 'face (cond + ((eq state lsp-eslint/status-error) 'error) + ((eq state lsp-eslint/status-warn) 'warn) + (t 'success))))) + +(lsp-defun lsp-eslint--configuration (_workspace (&ConfigurationParams :items)) + (->> items + (seq-map (-lambda ((&ConfigurationItem :scope-uri?)) + (-when-let* ((file (lsp--uri-to-path scope-uri?)) + (buffer (find-buffer-visiting file)) + (workspace-folder (lsp-find-session-folder (lsp-session) file))) + (with-current-buffer buffer + (let ((working-directory (lsp-eslint--working-directory workspace-folder file))) + (list :validate (if (member (lsp-buffer-language) lsp-eslint-validate) "on" "probe") + :packageManager lsp-eslint-package-manager + :codeAction (list + :disableRuleComment (list + :enable (lsp-json-bool lsp-eslint-code-action-disable-rule-comment) + :location lsp-eslint-code-action-disable-rule-comment-location) + :showDocumentation (list + :enable (lsp-json-bool lsp-eslint-code-action-show-documentation))) + :codeActionOnSave (list :enable (lsp-json-bool lsp-eslint-auto-fix-on-save) + :mode lsp-eslint-fix-all-problem-type) + :format (lsp-json-bool lsp-eslint-format) + :quiet (lsp-json-bool lsp-eslint-quiet) + :onIgnoredFiles (if lsp-eslint-warn-on-ignored-files "warn" "off") + :options (or lsp-eslint-options (ht)) + :experimental (or lsp-eslint-experimental (ht)) + :problems (or lsp-eslint-config-problems (ht)) + :timeBudget (or lsp-eslint-time-budget (ht)) + :rulesCustomizations lsp-eslint-rules-customizations + :run lsp-eslint-run + :nodePath lsp-eslint-node-path + :workingDirectory (when working-directory + (list + :directory working-directory + :!cwd :json-false)) + :workspaceFolder (list :uri (lsp--path-to-uri workspace-folder) + :name (f-filename workspace-folder)))))))) + (apply #'vector))) + +(defun lsp-eslint--working-directory (workspace current-file) + "Find the first directory in the parameter config.workingDirectories which +contains the current file" + (let ((directories (-map (lambda (dir) + (when (and (listp dir) (plist-member dir 'directory)) + (setq dir (plist-get dir 'directory))) + (if (and (listp dir) (plist-member dir 'pattern)) + (progn + (setq dir (plist-get dir 'pattern)) + (when (not (f-absolute? dir)) + (setq dir (f-join workspace dir))) + (f-glob dir)) + (if (f-absolute? dir) + dir + (f-join workspace dir)))) + (append lsp-eslint-working-directories nil)))) + (-first (lambda (dir) (f-ancestor-of-p dir current-file)) (-flatten directories)))) + +(lsp-defun lsp-eslint--open-doc (_workspace (&eslint:OpenESLintDocParams :url)) + "Open documentation." + (browse-url url)) + +(defun lsp-eslint-apply-all-fixes () + "Apply all autofixes in the current buffer." + (interactive) + (lsp-send-execute-command "eslint.applyAllFixes" (vector (lsp--versioned-text-document-identifier)))) + +;; XXX: replace with `lsp-make-interactive-code-action' macro +;; (lsp-make-interactive-code-action eslint-fix-all "source.fixAll.eslint") + +(defun lsp-eslint-fix-all () + "Perform the source.fixAll.eslint code action, if available." + (interactive) + (condition-case nil + (lsp-execute-code-action-by-kind "source.fixAll.eslint") + (lsp-no-code-actions + (when (called-interactively-p 'any) + (lsp--info "source.fixAll.eslint action not available"))))) + +(defun lsp-eslint-server-command () + (if (lsp-eslint-server-exists? lsp-eslint-server-command) + lsp-eslint-server-command + `(,lsp-eslint-node ,(f-join lsp-eslint-unzipped-path + "extension/server/out/eslintServer.js") + "--stdio"))) + +(defun lsp-eslint-server-exists? (eslint-server-command) + (let* ((command-name (f-base (f-filename (cl-first eslint-server-command)))) + (first-argument (cl-second eslint-server-command)) + (first-argument-exist (and first-argument (file-exists-p first-argument)))) + (if (equal command-name lsp-eslint-node) + first-argument-exist + (executable-find (cl-first eslint-server-command))))) + +(defvar lsp-eslint--stored-libraries (ht) + "Hash table defining if a given path to an ESLint library is allowed to run. +If the value for a key is 4, it will be allowed. If it is 1, it will not. If a +value does not exist for the key, or the value is nil, the user will be prompted +to allow or deny it.") + +(when (and (file-exists-p lsp-eslint-library-choices-file) + lsp-eslint-save-library-choices) + (setq lsp-eslint--stored-libraries (lsp--read-from-file lsp-eslint-library-choices-file))) + +(lsp-defun lsp-eslint--confirm-local (_workspace (&eslint:ConfirmExecutionParams :library-path) callback) + (if-let* ((option-alist '(("Always" 4 . t) + ("Yes" 4 . nil) + ("No" 1 . nil) + ("Never" 1 . t))) + (remembered-answer (gethash library-path lsp-eslint--stored-libraries))) + (funcall callback remembered-answer) + (lsp-ask-question + (format + "Allow lsp-mode to execute %s? Note: The latest versions of the ESLint language server no longer create this prompt." + library-path) + (mapcar 'car option-alist) + (lambda (response) + (let ((option (cdr (assoc response option-alist)))) + (when (cdr option) + (puthash library-path (car option) lsp-eslint--stored-libraries) + (when lsp-eslint-save-library-choices + (lsp--persist lsp-eslint-library-choices-file lsp-eslint--stored-libraries))) + (funcall callback (car option))))))) + +(defun lsp-eslint--probe-failed (_workspace _message) + "Called when the server detects a misconfiguration in ESLint." + (lsp--error "ESLint is not configured correctly. Please ensure your eslintrc is set up for the languages you are using.")) + +(lsp-register-client + (make-lsp-client + :new-connection + (lsp-stdio-connection + (lambda () (lsp-eslint-server-command)) + (lambda () (lsp-eslint-server-exists? (lsp-eslint-server-command)))) + :activation-fn (lambda (filename &optional _) + (when lsp-eslint-enable + (or (string-match-p (rx (one-or-more anything) "." + (or "ts" "js" "jsx" "tsx" "html" "vue" "svelte")eos) + filename) + (and (derived-mode-p 'js-mode 'js2-mode 'typescript-mode 'typescript-ts-mode 'html-mode 'svelte-mode) + (not (string-match-p "\\.json\\'" filename)))))) + :priority -1 + :completion-in-comments? t + :add-on? t + :multi-root t + :notification-handlers (ht ("eslint/status" #'lsp-eslint-status-handler)) + :request-handlers (ht ("workspace/configuration" #'lsp-eslint--configuration) + ("eslint/openDoc" #'lsp-eslint--open-doc) + ("eslint/probeFailed" #'lsp-eslint--probe-failed)) + :async-request-handlers (ht ("eslint/confirmESLintExecution" #'lsp-eslint--confirm-local)) + :server-id 'eslint + :initialized-fn (lambda (workspace) + (with-lsp-workspace workspace + (lsp--server-register-capability + (lsp-make-registration + :id "random-id" + :method "workspace/didChangeWatchedFiles" + :register-options? (lsp-make-did-change-watched-files-registration-options + :watchers + `[,(lsp-make-file-system-watcher + :glob-pattern "**/.eslintr{c.js,c.yaml,c.yml,c,c.json}") + ,(lsp-make-file-system-watcher + :glob-pattern "**/.eslintignore") + ,(lsp-make-file-system-watcher + :glob-pattern "**/package.json")]))))) + :download-server-fn (lambda (_client callback error-callback _update?) + (let ((tmp-zip (make-temp-file "ext" nil ".zip"))) + (delete-file tmp-zip) + (lsp-download-install + (lambda (&rest _) + (condition-case err + (progn + (lsp-unzip tmp-zip lsp-eslint-unzipped-path) + (funcall callback)) + (error (funcall error-callback err)))) + error-callback + :url lsp-eslint-download-url + :store-path tmp-zip))))) + +(lsp-consistency-check lsp-eslint) + +(provide 'lsp-eslint) +;;; lsp-eslint.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-eslint.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-eslint.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-fennel.el b/emacs/elpa/lsp-mode-20241119.828/lsp-fennel.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-fennel.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-fennel.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-fortran.el b/emacs/elpa/lsp-mode-20241119.828/lsp-fortran.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-fortran.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-fortran.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-fsharp.el b/emacs/elpa/lsp-mode-20241119.828/lsp-fsharp.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-fsharp.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-fsharp.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-futhark.el b/emacs/elpa/lsp-mode-20241119.828/lsp-futhark.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-futhark.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-futhark.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-gdscript.el b/emacs/elpa/lsp-mode-20241119.828/lsp-gdscript.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-gdscript.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-gdscript.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-gleam.el b/emacs/elpa/lsp-mode-20241119.828/lsp-gleam.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-gleam.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-gleam.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-glsl.el b/emacs/elpa/lsp-mode-20241119.828/lsp-glsl.el @@ -0,0 +1,49 @@ +;;; lsp-glsl.el --- GLSL client -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 emacs-lsp maintainers + +;; Author: Jen-Chieh Shen <jcs090218@gmail.com> +;; Keywords: languages lsp glsl + +;; 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: +;; +;; LSP client for the GLSL. +;; + +;;; Code: + +(require 'lsp-mode) + +(defgroup lsp-glsl nil + "LSP support for GLSL." + :group 'lsp-mode + :link '(url-link "https://github.com/svenstaro/glsl-language-server")) + +(defcustom lsp-glsl-executable '("glslls" "--stdin") + "Command to run the GLSL language server." + :group 'lsp-glsl + :risky t + :type '(list string)) + +(lsp-register-client + (make-lsp-client + :new-connection (lsp-stdio-connection lsp-glsl-executable) + :activation-fn (lsp-activate-on "glsl") + :priority -1 + :server-id 'glslls)) + +(provide 'lsp-glsl) +;;; lsp-glsl.el ends here diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-glsl.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-glsl.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-go.el b/emacs/elpa/lsp-mode-20241119.828/lsp-go.el @@ -0,0 +1,446 @@ +;;; lsp-go.el --- Go Client settings -*- lexical-binding: t; -*- + +;; Copyright (C) 2019 Muir Manders + +;; Author: Muir Manders <muir@mnd.rs> +;; Keywords: + +;; 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: + +;; lsp-go client + +;;; Code: + +(require 'lsp-mode) +(require 'lsp-completion) + +(defgroup lsp-go nil + "LSP support for the Go Programming Language, using the gopls language server." + :link '(url-link "https://github.com/golang/tools/blob/master/gopls/README.md") + :group 'lsp-mode + :package-version '(lsp-mode . "6.3.2")) + +(define-obsolete-variable-alias + 'lsp-gopls-server-path + 'lsp-go-gopls-server-path + "lsp-mode 7.0.1") + +(defcustom lsp-go-gopls-server-path "gopls" + "Path to gopls server binary." + :type 'string + :group 'lsp-go) + +(define-obsolete-variable-alias + 'lsp-gopls-server-args + 'lsp-go-gopls-server-args + "lsp-mode 7.0.1") + +(defcustom lsp-go-gopls-server-args '("-remote=auto") + "Extra CLI arguments for gopls." + :type '(repeat string) + :group 'lsp-go) + +(define-obsolete-variable-alias + 'lsp-gopls-use-placeholders + 'lsp-go-use-placeholders + "lsp-mode 7.0.1") + +(defcustom lsp-go-use-placeholders t + "Cause gopls to provide placeholder parameter snippets when +completing function calls." + :type 'boolean + :group 'lsp-go) + +(define-obsolete-variable-alias + 'lsp-gopls-build-flags + 'lsp-go-build-flags + "lsp-mode 7.0.1") + +(defcustom lsp-go-build-flags [] + "A vector of flags passed on to the build system when invoked, + applied to queries like `go list'." + :type '(lsp-repeatable-vector string) + :group 'lsp-go + :risky t + :package-version '(lsp-mode "6.2")) + +(define-obsolete-variable-alias + 'lsp-gopls-env + 'lsp-go-env + "lsp-mode 7.0.1") + +(defcustom lsp-go-env nil + "`gopls' has the unusual ability to set environment variables, + intended to affect the behavior of commands invoked by `gopls' + on the user's behalf. This variable takes a hash table of env + var names to desired values." + :type '(alist :key-type (symbol :tag "env var name") :value-type (string :tag "value")) + :group 'lsp-go + :risky t + :package-version '(lsp-mode "6.2")) + +(defcustom lsp-go-directory-filters [] + "A vector of directory filters." + :link '(url-link "https://github.com/golang/tools/blob/67e49ef2d0f326051e22a4a55bdf9344ae1a8ed8/gopls/doc/settings.md#directoryfilters-string") + :group 'lsp-go + :type 'lsp-string-vector + :package-version '(lsp-mode "8.0.0")) + +(define-obsolete-variable-alias + 'lsp-gopls-hover-kind + 'lsp-go-hover-kind + "lsp-mode 7.0.1") + +(defcustom lsp-go-hover-kind "SynopsisDocumentation" + "`gopls' allows the end user to select the desired amount of + documentation returned during e.g. hover and thing-at-point + operations." + :type '(choice (const "SynopsisDocumentation") + (const "NoDocumentation") + (const "FullDocumentation") + (const "SingleLine") + (const "Structured")) + :group 'lsp-go + :risky t + :package-version '(lsp-mode "6.2")) + +(define-obsolete-variable-alias + 'lsp-gopls-available-codelens + 'lsp-go-available-codelenses + "lsp-mode 7.0.1") + +(define-obsolete-variable-alias + 'lsp-go-available-codelens + 'lsp-go-available-codelenses + "lsp-mode 7.0.1") + +(defvar lsp-go-available-codelenses + '( + (gc_details . "Toggle the calculation of gc annotations") + (generate . "Run `go generate` for a directory") + (regenerate_cgo . "Regenerate cgo definitions") + (test . "Run `go test` for a specific set of test or benchmark functions (legacy)") + (tidy . "Run `go mod tidy` for a module") + (upgrade_dependency . "Upgrade a dependency") + (vendor . "Runs `go mod vendor' for a module")) + "Available codelenses that can be further enabled or disabled + through `lsp-go-codelenses'.") + +(defun lsp-go--defcustom-available-as-alist-type (alist) + "Return a list for the `:type' field in `defcustom' used to populate an alist. + +The input ALIST has the form `((\"name\" . \"documentation sentence\") [...])' + +The returned type provides a tri-state that either: + - does not include the element in the alist + - sets element to false (actually, :json-false) + - sets element to true \(actually, t)" + (let ((list '())) + (dolist (v alist) + (push `(cons + :tag ,(cdr v) + (const :format "" ,(car v)) + (choice (const :tag "Enable" t) (const :tag "Disable" :json-false))) + list)) + (push 'set list) + list)) + +(define-obsolete-variable-alias + 'lsp-gopls-codelens + 'lsp-go-codelenses + "lsp-mode 7.0.1") + +(define-obsolete-variable-alias + 'lsp-go-codelens + 'lsp-go-codelenses + "lsp-mode 7.0.1") + +(defcustom lsp-go-codelenses '((gc_details . :json-false) + (generate . t) + (regenerate_cgo . t) + (tidy . t) + (upgrade_dependency . t) + (test . t) + (vendor . t)) + "Select what codelenses should be enabled or not. + +The codelenses can be found at https://github.com/golang/tools/blob/3fa0e8f87c1aae0a9adc2a63af1a1945d16d9359/internal/lsp/source/options.go#L106-L112." + :type (lsp-go--defcustom-available-as-alist-type lsp-go-available-codelenses) + :group 'lsp-go + :risky t + :package-version '(lsp-mode "7.0")) + +(define-obsolete-variable-alias + 'lsp-clients-go-library-directories + 'lsp-go-library-directories + "lsp-mode 7.0.1") + +(defcustom lsp-go-library-directories ["/usr"] + "List of directories which will be considered to be libraries." + :group 'lsp-go + :risky t + :type '(lsp-repeatable-vector string)) + +(define-obsolete-variable-alias + 'lsp-clients-go-library-directories-include-go-modules + 'lsp-go-library-directories-include-go-modules + "lsp-mode 7.0.1") + +(defcustom lsp-go-library-directories-include-go-modules t + "Whether or not $GOPATH/pkg/mod should be included as a library directory." + :type 'boolean + :group 'lsp-go) + +(defun lsp-go--library-default-directories (_workspace) + "Calculate go library directories. + +If `lsp-go-library-directories-include-go-modules' is non-nil +and the environment variable GOPATH is set this function will return +$GOPATH/pkg/mod along with the value of +`lsp-go-library-directories'." + (let ((library-dirs lsp-go-library-directories)) + (when (and lsp-go-library-directories-include-go-modules + (or (and (not (file-remote-p default-directory)) (executable-find "go")) + (and (version<= "27.0" emacs-version) (with-no-warnings (executable-find "go" (file-remote-p default-directory)))))) + (with-temp-buffer + (when (zerop (process-file "go" nil t nil "env" "GOPATH")) + (setq library-dirs + (append + library-dirs + (list + (concat + (string-trim-right (buffer-substring (point-min) (point-max))) + "/pkg/mod"))))))) + (if (file-remote-p default-directory) + (mapcar (lambda (path) (concat (file-remote-p default-directory) path)) library-dirs) + library-dirs))) + +(defcustom lsp-go-link-target "pkg.go.dev" + "Which website to use for displaying Go documentation." + :type '(choice (const "pkg.go.dev") + (const "godoc.org") + (string :tag "A custom website")) + :group 'lsp-go + :package-version '(lsp-mode "7.0.1")) + +(defcustom lsp-go-links-in-hover t + "If non-nil, hover documentation includes links." + :type 'boolean + :group 'lsp-go + :package-version '(lsp-mode "8.0.0")) + +(defcustom lsp-go-use-gofumpt nil + "If non-nil, use gofumpt formatting." + :type 'boolean + :group 'lsp-go + :package-version '(lsp-mode "8.0.0")) + +(defcustom lsp-go-goimports-local "" + "Equivalent of the goimports -local flag, which puts imports beginning with + this string after third-party packages. It should be the prefix of the import + path whose imports should be grouped separately." + :type 'string + :group 'lsp-go + :package-version '(lsp-mode "8.0.0")) + +(defcustom lsp-go-analyses nil + "Specify analyses that the user would like to enable or disable. A map of the + names of analysis passes that should be enabled/disabled. A full list of + analyzers that gopls uses can be found at + https://github.com/golang/tools/blob/master/gopls/doc/analyzers.md" + :type '(alist :key-type (string :tag "analyzer name") :value-type (boolean :tag "value")) + :group 'lsp-go + :risky t + :package-version '(lsp-mode "8.0.0")) + +(defcustom lsp-go-import-shortcut "Both" + "Specifies whether import statements should link to documentation or go to + definitions." + :type '(choice (const "Both") + (const "Link") + (const "Definition")) + :group 'lsp-go + :risky t + :package-version '(lsp-mode "8.0.0")) + +(defcustom lsp-go-symbol-matcher "FastFuzzy" + "Sets the algorithm that is used when finding workspace symbols." + :type '(choice (const "Fuzzy") + (const "FastFuzzy") + (const "CaseInsensitive") + (const "CaseSensitive")) + :group 'lsp-go + :risky t + :package-version '(lsp-mode "8.0.0")) + +(defcustom lsp-go-symbol-style "Dynamic" + "Controls how symbols are qualified in symbol responses. + + `Dynamic' uses whichever qualifier results in the highest scoring match for + the given symbol query. Here a `qualifier' is any `/' or '.' delimited suffix + of the fully qualified symbol. i.e. `to/pkg.Foo.Field' or just `Foo.Field'. + + `Full' is fully qualified symbols, i.e. `path/to/pkg.Foo.Field'. + + `Package' is package qualified symbols i.e. `pkg.Foo.Field'." + :type '(choice (const "Dynamic") + (const "Full") + (const "Package")) + :group 'lsp-go + :risky t + :package-version '(lsp-mode "8.0.0")) + +(defcustom lsp-go-template-extensions [] + "The extensions of file names that are treated as template files. + +The extension is the part of the file name after the final dot." + :type '(lsp-repeatable-vector string) + :group 'lsp-go + :package-version '(lsp-mode "9.1")) + +(defcustom lsp-go-standalone-tags ["ignore"] + "Specifies a set of build constraints that identify individual Go +source files that make up the entire main package of an +executable." + :type '(lsp-repeatable-vector string) + :group 'lsp-go + :package-version '(lsp-mode "9.1")) + +(defcustom lsp-go-completion-budget "100ms" + "Soft latency goal for completion requests" + :type 'string + :group 'lsp-go + :package-version '(lsp-mode "9.1")) + +(defcustom lsp-go-matcher "Fuzzy" + "Sets the algorithm that is used when calculating completion candidates." + :type '(choice (const "CaseInsensitive") + (const "CaseSensitive") + (const "Fuzzy")) + :group 'lsp-go + :package-version '(lsp-mode "9.1")) + +(defcustom lsp-go-complete-function-calls t + "Enables function call completion. + +When completing a statement, or when a function return type +matches the expected of the expression being completed, +completion may suggest call expressions." + :type 'boolean + :group 'lsp-go + :package-version '(lsp-mode "9.1")) + +(defcustom lsp-go-diagnostics-delay "1s" + "Controls the amount of time that gopls waits after the most +recent file modification before computing deep diagnostics." + :type 'string + :group 'lsp-go + :package-version '(lsp-mode "9.1")) + +(defcustom lsp-go-analysis-progress-reporting t + "Controls whether gopls sends progress notifications when +construction of its index of analysis facts is taking a long +time." + :type 'boolean + :group 'lsp-go + :package-version '(lsp-mode "9.1")) + +(defcustom lsp-go-symbol-scope "all" + "Controls which packages are searched for workspace/symbol +requests. + +When the scope is \"workspace\", gopls searches only workspace +packages. + +When the scope is \"all\", gopls searches all loaded packages, +including dependencies and the standard library." + :type '(choice (const "all") + (const "workspace")) + :group 'lsp-go + :package-version '(lsp-mode "9.1")) + +(defcustom lsp-go-verbose-output t + "Enables additional debug logging." + :type 'boolean + :group 'lsp-go + :package-version '(lsp-mode "9.1")) + +(lsp-register-custom-settings + '(("gopls.analyses" lsp-go-analyses) + ("gopls.analysisProgressReporting" lsp-go-analysis-progress-reporting t) + ("gopls.buildFlags" lsp-go-build-flags) + ("gopls.codelenses" lsp-go-codelenses) + ("gopls.completeFunctionCalls" lsp-go-complete-function-calls t) + ("gopls.completionBudget" lsp-go-completion-budget) + ("gopls.diagnosticsDelay" lsp-go-diagnostics-delay) + ("gopls.directoryFilters" lsp-go-directory-filters) + ("gopls.env" lsp-go-env) + ("gopls.gofumpt" lsp-go-use-gofumpt t) + ("gopls.hoverKind" lsp-go-hover-kind) + ("gopls.importShortcut" lsp-go-import-shortcut) + ("gopls.linkTarget" lsp-go-link-target) + ("gopls.linksInHover" lsp-go-links-in-hover t) + ("gopls.local" lsp-go-goimports-local) + ("gopls.matcher" lsp-go-matcher) + ("gopls.standaloneTags" lsp-go-standalone-tags) + ("gopls.symbolMatcher" lsp-go-symbol-matcher) + ("gopls.symbolScope" lsp-go-symbol-scope) + ("gopls.symbolStyle" lsp-go-symbol-style) + ("gopls.templateExtensions" lsp-go-template-extensions) + ("gopls.usePlaceholders" lsp-go-use-placeholders t) + ("gopls.verboseOutput" lsp-go-verbose-output t))) + +(defcustom lsp-go-server-wrapper-function + #'identity + "Function to wrap the language server process started by lsp-go. + +For example, you can pick a go binary provided by a repository's +flake.nix file with: + + (use-package nix-sandbox) + (defun my/nix--lsp-go-wrapper (args) + (if-let* ((sandbox (nix-current-sandbox))) + (apply `nix-shell-command sandbox args) + args)) + (setq lsp-go-server-path \"gopls\" + lsp-go-server-wrapper-function `my/nix--lsp-go-wrapper)" + :group 'lsp-go + :type '(choice + (function-item :tag "None" :value identity) + (function :tag "Custom function"))) + +(defun lsp-go--server-command () + "Command and arguments for launching the inferior language server process. +These are assembled from the customizable variables `lsp-go-server-path' +and `lsp-go-server-wrapper-function'." + (funcall lsp-go-server-wrapper-function (append (list lsp-go-gopls-server-path) lsp-go-gopls-server-args))) + +(lsp-register-client + (make-lsp-client :new-connection (lsp-stdio-connection 'lsp-go--server-command) + :activation-fn (lsp-activate-on "go" "go.mod") + :language-id "go" + :priority 0 + :server-id 'gopls + :completion-in-comments? t + :library-folders-fn #'lsp-go--library-default-directories + :after-open-fn (lambda () + ;; https://github.com/golang/tools/commit/b2d8b0336 + (setq-local lsp-completion-filter-on-incomplete nil)))) + +(lsp-consistency-check lsp-go) + +(provide 'lsp-go) +;;; lsp-go.el ends here diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-go.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-go.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-golangci-lint.el b/emacs/elpa/lsp-mode-20241119.828/lsp-golangci-lint.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-golangci-lint.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-golangci-lint.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-graphql.el b/emacs/elpa/lsp-mode-20241119.828/lsp-graphql.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-graphql.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-graphql.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-groovy.el b/emacs/elpa/lsp-mode-20241119.828/lsp-groovy.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-groovy.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-groovy.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-hack.el b/emacs/elpa/lsp-mode-20241119.828/lsp-hack.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-hack.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-hack.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-haxe.el b/emacs/elpa/lsp-mode-20241119.828/lsp-haxe.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-haxe.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-haxe.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-headerline.el b/emacs/elpa/lsp-mode-20241119.828/lsp-headerline.el @@ -0,0 +1,494 @@ +;;; lsp-headerline.el --- LSP headerline features -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2020 emacs-lsp maintainers +;; +;; 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: +;; +;; LSP headerline features +;; +;;; Code: + +(require 'lsp-icons) +(require 'lsp-mode) + +(defgroup lsp-headerline nil + "LSP support for headerline" + :prefix "lsp-headerline-" + :group 'lsp-mode + :tag "LSP Headerline") + +(defcustom lsp-headerline-breadcrumb-segments '(path-up-to-project file symbols) + "Segments used in breadcrumb text on headerline." + :type '(repeat + (choice (const :tag "Include the project name." project) + (const :tag "Include the open file name." file) + (const :tag "Include the directories up to project." path-up-to-project) + (const :tag "Include document symbols if server supports it." symbols))) + :group 'lsp-headerline) + +(defcustom lsp-headerline-breadcrumb-enable-symbol-numbers nil + "Whether to label symbols with numbers on the breadcrumb." + :type 'boolean + :group 'lsp-headerline) + +(defcustom lsp-headerline-breadcrumb-enable-diagnostics t + "If non-nil, apply different face on the breadcrumb based on the errors." + :type 'boolean + :group 'lsp-headerline + :package-version '(lsp-mode . "8.0.0")) + +(defface lsp-headerline-breadcrumb-separator-face '((t :inherit shadow :height 0.8)) + "Face used for breadcrumb separator on headerline." + :group 'lsp-headerline) + +(defface lsp-headerline-breadcrumb-path-face '((t :inherit font-lock-string-face)) + "Face used for breadcrumb paths on headerline." + :group 'lsp-headerline) + +(defface lsp-headerline-breadcrumb-path-error-face + '((t :underline (:style wave :color "Red1") + :inherit lsp-headerline-breadcrumb-path-face)) + "Face used for breadcrumb paths on headerline when there is an error under +that path" + :group 'lsp-headerline) + +(defface lsp-headerline-breadcrumb-path-warning-face + '((t :underline (:style wave :color "Yellow") + :inherit lsp-headerline-breadcrumb-path-face)) + "Face used for breadcrumb paths on headerline when there is an warning under +that path" + :group 'lsp-headerline) + +(defface lsp-headerline-breadcrumb-path-info-face + '((t :underline (:style wave :color "Green") + :inherit lsp-headerline-breadcrumb-path-face)) + "Face used for breadcrumb paths on headerline when there is an info under +that path" + :group 'lsp-headerline) + +(defface lsp-headerline-breadcrumb-path-hint-face + '((t :underline (:style wave :color "Green") + :inherit lsp-headerline-breadcrumb-path-face)) + "Face used for breadcrumb paths on headerline when there is an hint under that +path" + :group 'lsp-headerline) + +(defface lsp-headerline-breadcrumb-project-prefix-face + '((t :inherit font-lock-string-face :weight bold)) + "Face used for breadcrumb prefix on headerline. +Only if `lsp-headerline-breadcrumb-prefix` is `project-name-only`." + :group 'lsp-headerline) + +(defface lsp-headerline-breadcrumb-unknown-project-prefix-face + '((t :inherit shadow :weight bold)) + "Face used for breadcrumb prefix on headerline. +Only if `lsp-headerline-breadcrumb-prefix` is `project-name-only`." + :group 'lsp-headerline) + +(defface lsp-headerline-breadcrumb-symbols-face + '((t :inherit font-lock-doc-face :weight bold)) + "Face used for breadcrumb symbols text on headerline." + :group 'lsp-headerline) + +(defface lsp-headerline-breadcrumb-symbols-error-face + '((t :inherit lsp-headerline-breadcrumb-symbols-face + :underline (:style wave :color "Red1"))) + "Face used for breadcrumb symbols text on headerline when there +is an error in symbols range." + :group 'lsp-headerline) + +(defface lsp-headerline-breadcrumb-symbols-warning-face + '((t :inherit lsp-headerline-breadcrumb-symbols-face + :underline (:style wave :color "Yellow"))) + "Face used for breadcrumb symbols text on headerline when there +is an warning in symbols range." + :group 'lsp-headerline) + +(defface lsp-headerline-breadcrumb-symbols-info-face + '((t :inherit lsp-headerline-breadcrumb-symbols-face + :underline (:style wave :color "Green"))) + "Face used for breadcrumb symbols text on headerline when there +is an info in symbols range." + :group 'lsp-headerline) + +(defface lsp-headerline-breadcrumb-symbols-hint-face + '((t :inherit lsp-headerline-breadcrumb-symbols-face + :underline (:style wave :color "Green"))) + "Face used for breadcrumb symbols text on headerline when there +is an hints in symbols range." + :group 'lsp-headerline) + +(defface lsp-headerline-breadcrumb-deprecated-face + '((t :inherit lsp-headerline-breadcrumb-symbols-face + :strike-through t)) + "Face used on breadcrumb deprecated text on modeline." + :group 'lsp-headerline) + +(defvar lsp-headerline-arrow nil + "Holds the current breadcrumb string on headerline.") + +(defvar-local lsp-headerline--path-up-to-project-segments nil + "Holds the current breadcrumb path-up-to-project segments for +caching purposes.") + +(defvar-local lsp-headerline--cached-workspace-root nil + "Holds the current value of lsp-workspace-root for caching purposes") + +;; Redefine local vars of `all-the-icons' to avoid bytecode compilation errors. +(defvar all-the-icons-default-adjust) +(defvar all-the-icons-scale-factor) + +(defun lsp-headerline--arrow-icon () + "Build the arrow icon for headerline breadcrumb." + (or + lsp-headerline-arrow + (setq lsp-headerline-arrow (let ((all-the-icons-scale-factor 1.0) + (all-the-icons-default-adjust 0)) + (lsp-icons-all-the-icons-icon + 'material + "chevron_right" + 'lsp-headerline-breadcrumb-separator-face + ">" + 'headerline-breadcrumb))))) + +(lsp-defun lsp-headerline--symbol-icon ((&DocumentSymbol :kind)) + "Build the SYMBOL icon for headerline breadcrumb." + (concat (lsp-icons-get-by-symbol-kind kind 'headerline-breadcrumb) + " ")) + +(lsp-defun lsp-headerline--go-to-symbol ((&DocumentSymbol + :selection-range (&RangeToPoint :start selection-start) + :range (&RangeToPoint :start narrowing-start + :end narrowing-end))) + "Go to breadcrumb symbol. +If the buffer is narrowed and the target symbol lies before the +minimum reachable point in the narrowed buffer, then widen and +narrow to the outer symbol." + (when (buffer-narrowed-p) + (narrow-to-region + (min (point-min) narrowing-start) + (max (point-max) narrowing-end))) + (goto-char selection-start)) + +(lsp-defun lsp-headerline--narrow-to-symbol ((&DocumentSymbol :range (&RangeToPoint :start :end))) + "Narrow to breadcrumb symbol range." + (narrow-to-region start end)) + +(defun lsp-headerline--with-action (local-map help-echo-string display-string) + "Assign LOCAL-MAP and HELP-ECHO-STRING to the region around the +DISPLAY-STRING." + (propertize display-string + 'mouse-face 'header-line-highlight + 'help-echo help-echo-string + 'local-map local-map)) + +(defmacro lsp-headerline--make-mouse-handler (&rest body) + "Making mouse event handler. +Switch to current mouse interacting window before doing BODY." + (declare (debug t) (indent 0)) + `(lambda (event) + (interactive "e") + (select-window (posn-window (elt event 1))) + ,@body)) + +(defun lsp-headerline--directory-with-action (full-path directory-display-string) + "Build action for FULL-PATH and DIRECTORY-DISPLAY-STRING." + (lsp-headerline--with-action (let ((map (make-sparse-keymap))) + (define-key map [header-line mouse-1] + (lsp-headerline--make-mouse-handler + (dired full-path))) + (define-key map [header-line mouse-2] + (lsp-headerline--make-mouse-handler + (dired-other-window full-path))) + map) + (format "mouse-1: browse '%s' with Dired\nmouse-2: browse '%s' with Dired in other window" + directory-display-string + directory-display-string) + (propertize directory-display-string + 'lsp-full-path full-path))) + +(declare-function evil-set-jump "ext:evil-jumps") + +(lsp-defun lsp-headerline--symbol-with-action ((symbol &as &DocumentSymbol :name) symbol-display-string) + "Build action for SYMBOL and SYMBOL-STRING." + (lsp-headerline--with-action (let ((map (make-sparse-keymap))) + (define-key map [header-line mouse-1] + (lsp-headerline--make-mouse-handler + (when (bound-and-true-p evil-mode) + (evil-set-jump)) + (lsp-headerline--go-to-symbol symbol))) + (define-key map [header-line mouse-2] + (lsp-headerline--make-mouse-handler + (-let (((&DocumentSymbol :range (&RangeToPoint :start :end)) symbol)) + (if (and (eq (point-min) start) (eq (point-max) end)) + (widen) + (lsp-headerline--narrow-to-symbol symbol))))) + map) + (format "mouse-1: go to '%s' symbol\nmouse-2: %s" + name + (-let (((&DocumentSymbol :range (&RangeToPoint :start :end)) symbol)) + (if (and (eq (point-min) start) (eq (point-max) end)) + "widen" + (format "narrow to '%s' range" name)))) + symbol-display-string)) + +(defun lsp-headerline--path-up-to-project-root (root-path path) + "Find recursively the folders until the project ROOT-PATH. +PATH is the current folder to be checked." + (let ((current-path path) + headerline-path-components) + (while (not (lsp-f-same? root-path current-path)) + (push (lsp-headerline--directory-with-action current-path + (f-filename current-path)) + headerline-path-components) + (setq current-path (lsp-f-parent current-path))) + headerline-path-components)) + +(defun lsp-headerline--build-project-string () + "Build the project-segment string for the breadcrumb." + (-if-let (root (lsp-headerline--workspace-root)) + (propertize (lsp-headerline--directory-with-action + root + (f-filename root)) + 'font-lock-face + 'lsp-headerline-breadcrumb-project-prefix-face) + (propertize "<unknown>" + 'font-lock-face + 'lsp-headerline-breadcrumb-unknown-project-prefix-face))) + +(defun lsp-headerline--build-file-string () + "Build the file-segment string for the breadcrumb." + (let* ((file-path (or (buffer-file-name) "")) + (filename (f-filename file-path))) + (if-let* ((file-ext (f-ext file-path))) + (concat (lsp-icons-get-by-file-ext file-ext 'headerline-breadcrumb) + " " + (propertize filename + 'font-lock-face + (lsp-headerline--face-for-path file-path))) + filename))) + + +(defun lsp-headerline--face-for-path (dir) + "Calculate the face for DIR." + (if-let* ((diags (lsp-diagnostics-stats-for (directory-file-name dir)))) + (cl-labels ((check-severity + (severity) + (not (zerop (aref diags severity))))) + (cond + ((not lsp-headerline-breadcrumb-enable-diagnostics) + 'lsp-headerline-breadcrumb-path-face) + ((check-severity lsp/diagnostic-severity-error) + 'lsp-headerline-breadcrumb-path-error-face) + ((check-severity lsp/diagnostic-severity-warning) + 'lsp-headerline-breadcrumb-path-warning-face) + ((check-severity lsp/diagnostic-severity-information) + 'lsp-headerline-breadcrumb-path-info-face) + ((check-severity lsp/diagnostic-severity-hint) + 'lsp-headerline-breadcrumb-path-hint-face) + (t 'lsp-headerline-breadcrumb-path-face))) + 'lsp-headerline-breadcrumb-path-face)) + +(defun lsp-headerline--severity-level-for-range (range) + "Get the severity level for RANGE." + (let ((range-severity 10)) + (mapc (-lambda ((&Diagnostic :range (&Range :start) :severity?)) + (when (lsp-point-in-range? start range) + (setq range-severity (min range-severity severity?)))) + (lsp--get-buffer-diagnostics)) + range-severity)) + +(defun lsp-headerline--build-path-up-to-project-string () + "Build the path-up-to-project segment for the breadcrumb." + (if-let* ((root (lsp-headerline--workspace-root))) + (let ((segments (or + lsp-headerline--path-up-to-project-segments + (setq lsp-headerline--path-up-to-project-segments + (lsp-headerline--path-up-to-project-root + root + (lsp-f-parent (buffer-file-name))))))) + (mapconcat (lambda (next-dir) + (propertize next-dir + 'font-lock-face + (lsp-headerline--face-for-path + (get-text-property + 0 'lsp-full-path next-dir)))) + segments + (concat " " (lsp-headerline--arrow-icon) " "))) + "")) + +(lsp-defun lsp-headerline--face-for-symbol ((&DocumentSymbol :deprecated? + :range)) + "Get the face for SYMBOL." + (let ((range-severity (lsp-headerline--severity-level-for-range range))) + (cond + (deprecated? 'lsp-headerline-breadcrumb-deprecated-face) + ((not lsp-headerline-breadcrumb-enable-diagnostics) + 'lsp-headerline-breadcrumb-symbols-face) + ((= range-severity lsp/diagnostic-severity-error) + 'lsp-headerline-breadcrumb-symbols-error-face) + ((= range-severity lsp/diagnostic-severity-warning) + 'lsp-headerline-breadcrumb-symbols-warning-face) + ((= range-severity lsp/diagnostic-severity-information) + 'lsp-headerline-breadcrumb-symbols-info-face) + ((= range-severity lsp/diagnostic-severity-hint) + 'lsp-headerline-breadcrumb-symbols-hint-face) + (t 'lsp-headerline-breadcrumb-symbols-face)))) + +(defun lsp-headerline--build-symbol-string () + "Build the symbol segment for the breadcrumb." + (if (lsp-feature? "textDocument/documentSymbol") + (-if-let* ((lsp--document-symbols-request-async t) + (symbols (lsp--get-document-symbols)) + (symbols-hierarchy (lsp--symbols->document-symbols-hierarchy symbols)) + (enumerated-symbols-hierarchy + (-map-indexed (lambda (index elt) + (cons elt (1+ index))) + symbols-hierarchy))) + (mapconcat + (-lambda (((symbol &as &DocumentSymbol :name) + . index)) + (let* ((symbol2-name + (propertize name + 'font-lock-face + (lsp-headerline--face-for-symbol symbol))) + (symbol2-icon (lsp-headerline--symbol-icon symbol)) + (full-symbol-2 + (concat + (if lsp-headerline-breadcrumb-enable-symbol-numbers + (concat + (propertize (number-to-string index) + 'face + 'lsp-headerline-breadcrumb-symbols-face) + " ") + "") + (if symbol2-icon + (concat symbol2-icon symbol2-name) + symbol2-name)))) + (lsp-headerline--symbol-with-action symbol full-symbol-2))) + enumerated-symbols-hierarchy + (concat " " (lsp-headerline--arrow-icon) " ")) + "") + "")) + +(defun lsp-headerline--build-string () + "Build the header-line string." + (string-trim-right + (mapconcat + (lambda (segment) + (let ((segment-string + (pcase segment + ('project (lsp-headerline--build-project-string)) + ('file (lsp-headerline--build-file-string)) + ('path-up-to-project (lsp-headerline--build-path-up-to-project-string)) + ('symbols (lsp-headerline--build-symbol-string)) + (_ (lsp-log "'%s' is not a valid entry for `lsp-headerline-breadcrumb-segments'" + (symbol-name segment)) + "")))) + (if (string-empty-p segment-string) + "" + (concat (lsp-headerline--arrow-icon) + " " + segment-string + " ")))) + lsp-headerline-breadcrumb-segments + ""))) + +(defun lsp-headerline--check-breadcrumb (&rest _) + "Request for document symbols to build the breadcrumb." + (set-window-parameter (selected-window) 'lsp-headerline--string (lsp-headerline--build-string)) + (force-mode-line-update)) + +(defun lsp-headerline--enable-breadcrumb () + "Enable headerline breadcrumb mode." + (when (and lsp-headerline-breadcrumb-enable + (lsp-feature? "textDocument/documentSymbol")) + (lsp-headerline-breadcrumb-mode 1))) + +(defun lsp-headerline--disable-breadcrumb () + "Disable headerline breadcrumb mode." + (lsp-headerline-breadcrumb-mode -1)) + +(defun lsp-headerline--workspace-root () + (or lsp-headerline--cached-workspace-root + (setq lsp-headerline--cached-workspace-root (lsp-workspace-root)))) + +;;;###autoload +(define-minor-mode lsp-headerline-breadcrumb-mode + "Toggle breadcrumb on headerline." + :group 'lsp-headerline + :global nil + (cond + (lsp-headerline-breadcrumb-mode + ;; make sure header-line-format, if non-nil, is a list. as + ;; mode-line-format says: "The value may be nil, a string, a + ;; symbol or a list." + (unless (listp header-line-format) + (setq header-line-format (list header-line-format))) + (add-to-list 'header-line-format '(t (:eval (window-parameter nil 'lsp-headerline--string) ))) + + (add-hook 'xref-after-jump-hook #'lsp-headerline--check-breadcrumb nil t) + + (add-hook 'lsp-on-idle-hook #'lsp-headerline--check-breadcrumb nil t) + (add-hook 'lsp-configure-hook #'lsp-headerline--enable-breadcrumb nil t) + (add-hook 'lsp-unconfigure-hook #'lsp-headerline--disable-breadcrumb nil t)) + (t + (remove-hook 'lsp-on-idle-hook #'lsp-headerline--check-breadcrumb t) + (remove-hook 'lsp-configure-hook #'lsp-headerline--enable-breadcrumb t) + (remove-hook 'lsp-unconfigure-hook #'lsp-headerline--disable-breadcrumb t) + + (remove-hook 'xref-after-jump-hook #'lsp-headerline--check-breadcrumb t) + + (setq lsp-headerline--path-up-to-project-segments nil) + (setq header-line-format (remove '(t (:eval (window-parameter nil 'lsp-headerline--string) )) header-line-format))))) + +;;;###autoload +(defun lsp-breadcrumb-go-to-symbol (symbol-position) + "Go to the symbol on breadcrumb at SYMBOL-POSITION." + (interactive "P") + (if (numberp symbol-position) + (if (lsp-feature? "textDocument/documentSymbol") + (-if-let* ((lsp--document-symbols-request-async t) + (symbols (lsp--get-document-symbols)) + (symbols-hierarchy (lsp--symbols->document-symbols-hierarchy symbols))) + (lsp-headerline--go-to-symbol (nth (1- symbol-position) symbols-hierarchy)) + (lsp--info "Symbol not found for position %s" symbol-position)) + (lsp--info "Server does not support breadcrumb.")) + (lsp--info "Call this function with a number representing the symbol position on breadcrumb"))) + +(declare-function evil-set-command-property "ext:evil-common") + +(with-eval-after-load 'evil + (evil-set-command-property 'lsp-breadcrumb-go-to-symbol :jump t)) + +;;;###autoload +(defun lsp-breadcrumb-narrow-to-symbol (symbol-position) + "Narrow to the symbol range on breadcrumb at SYMBOL-POSITION." + (interactive "P") + (if (numberp symbol-position) + (if (lsp-feature? "textDocument/documentSymbol") + (-if-let* ((lsp--document-symbols-request-async t) + (symbols (lsp--get-document-symbols)) + (symbols-hierarchy (lsp--symbols->document-symbols-hierarchy symbols))) + (lsp-headerline--narrow-to-symbol (nth (1- symbol-position) symbols-hierarchy)) + (lsp--info "Symbol not found for position %s" symbol-position)) + (lsp--info "Server does not support breadcrumb.")) + (lsp--info "Call this function with a number representing the symbol position on breadcrumb"))) + +(lsp-consistency-check lsp-headerline) + +(provide 'lsp-headerline) +;;; lsp-headerline.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-headerline.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-headerline.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-html.el b/emacs/elpa/lsp-mode-20241119.828/lsp-html.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-html.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-html.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-hy.el b/emacs/elpa/lsp-mode-20241119.828/lsp-hy.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-hy.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-hy.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-icons.el b/emacs/elpa/lsp-mode-20241119.828/lsp-icons.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-icons.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-icons.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-ido.el b/emacs/elpa/lsp-mode-20241119.828/lsp-ido.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-ido.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-ido.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-idris.el b/emacs/elpa/lsp-mode-20241119.828/lsp-idris.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-idris.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-idris.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-iedit.el b/emacs/elpa/lsp-mode-20241119.828/lsp-iedit.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-iedit.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-iedit.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-javascript.el b/emacs/elpa/lsp-mode-20241119.828/lsp-javascript.el @@ -0,0 +1,1054 @@ +;;; lsp-javascript.el --- description -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 emacs-lsp maintainers + +;; Author: emacs-lsp maintainers +;; Keywords: lsp, + +;; 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: + +;; LSP Clients for the JavaScript and TypeScript Programming Languages. + +;;; Code: + +(require 'lsp-mode) + +(lsp-dependency 'javascript-typescript-langserver + '(:system "javascript-typescript-stdio") + '(:npm :package "javascript-typescript-langserver" + :path "javascript-typescript-stdio")) + +(defgroup lsp-typescript-javascript nil + "Support for TypeScript/JavaScript, using Sourcegraph's JavaScript/TypeScript language server." + :group 'lsp-mode + :link '(url-link "https://github.com/sourcegraph/javascript-typescript-langserver")) + +;; Original name can be confused with initializationOptions. Preferences is just one option of initializationOptions. +(define-obsolete-variable-alias + 'lsp-clients-typescript-init-opts + 'lsp-clients-typescript-preferences + "lsp-mode 9.0.0") + +(defcustom lsp-clients-typescript-javascript-server-args '() + "Extra arguments for the typescript-language-server language server." + :group 'lsp-typescript-javascript + :risky t + :type '(repeat string)) + +(defun lsp-typescript-javascript-tsx-jsx-activate-p (filename &optional _) + "Check if the js-ts lsp server should be enabled based on FILENAME." + (or (string-match-p "\\.[cm]js\\|\\.[jt]sx?\\'" filename) + (and (derived-mode-p 'js-mode 'js-ts-mode 'typescript-mode 'typescript-ts-mode) + (not (derived-mode-p 'json-mode))))) + +;; Unmaintained sourcegraph server +(lsp-register-client + (make-lsp-client :new-connection (lsp-stdio-connection (lambda () + (cons (lsp-package-path 'javascript-typescript-langserver) + lsp-clients-typescript-javascript-server-args))) + :activation-fn 'lsp-typescript-javascript-tsx-jsx-activate-p + :priority -3 + :completion-in-comments? t + :server-id 'jsts-ls + :download-server-fn (lambda (_client callback error-callback _update?) + (lsp-package-ensure + 'javascript-typescript-langserver + callback + error-callback)) + :initialized-fn (lambda (_workspace) + (warn (concat "The javascript-typescript-langserver (jsts-ls) is unmaintained; " + "it is recommended to use ts-ls or deno-ls instead."))))) + +(defgroup lsp-typescript nil + "LSP support for TypeScript, using Theia/Typefox's TypeScript Language Server." + :group 'lsp-mode + :link '(url-link "https://github.com/theia-ide/typescript-language-server")) + +(defcustom lsp-clients-typescript-tls-path "typescript-language-server" + "Path to the typescript-language-server binary." + :group 'lsp-typescript + :risky t + :type 'string) + +(defcustom lsp-clients-typescript-server-args '("--stdio") + "Extra arguments for the typescript-language-server language server." + :group 'lsp-typescript + :risky t + :type '(repeat string)) + +(defcustom lsp-clients-typescript-disable-automatic-typing-acquisition nil + "Disable tsserver from automatically fetching missing type definitions. +\(@types packages) for external modules." + :group 'lsp-typescript + :type 'boolean) + +(defcustom lsp-clients-typescript-log-verbosity "info" + "The verbosity level of the information printed in the log by tsserver." + :group 'lsp-typescript + :type '(choice + (const "off") + (const "terse") + (const "normal") + (const "requesttime") + (const "verbose"))) + +(defcustom lsp-clients-typescript-max-ts-server-memory nil + "The maximum size of the V8's old memory section in megabytes. +\(for example 4096 means 4GB). The default value is dynamically configured +by Node so can differ per system. Increase for very big projects that +exceed allowed memory usage." + :group 'lsp-typescript + :type 'integer) + +(defcustom lsp-clients-typescript-npm-location nil + "Specifies the path to the NPM exec used for Automatic Type Acquisition." + :group 'lsp-typescript + :type 'string) + +(defcustom lsp-clients-typescript-prefer-use-project-ts-server nil + "When set, prefers using the tsserver.js from your project. This +can allow loading plugins configured in your tsconfig.json." + :group 'lsp-typescript + :type 'boolean) + +(defcustom lsp-clients-typescript-plugins (vector) + "The list of plugins to load. +It should be a vector of plist with keys `:location' and `:name' +where `:name' is the name of the package and `:location' is the +directory containing the package. Example: +\(vector + \(list :name \"@vsintellicode/typescript-intellicode-plugin\" + :location \"<path>.vscode/extensions/visualstudioexptteam. + vscodeintellicode-1.1.9/\"))" + :group 'lsp-typescript + :type '(restricted-sexp :tag "Vector" + :match-alternatives + (lambda (xs) + (and (vectorp xs) (seq-every-p + (-lambda ((&plist :name :location)) + (and name location)) + xs))))) + +(defcustom lsp-clients-typescript-preferences nil + "Preferences passed to the Typescript (tsserver) process. +See https://github.com/typescript-language-server/typescript-language-server#initializationoptions for the list of preferences available in the latest version of TypeScript." + :group 'lsp-typescript + :type 'plist) + +(defcustom lsp-clients-typescript-tsserver nil + "Options related to the tsserver process. See below for more info. +See https://github.com/typescript-language-server/typescript-language-server#initializationoptions for the list of tsserver available in the latest version of TypeScript." + :group 'lsp-typescript + :type 'plist) + +(defcustom lsp-typescript-tsdk nil + "Specifies the folder path containing tsserver and lib*.d.ts files to use." + :type '(repeat string) + :group 'lsp-vetur + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-disable-automatic-type-acquisition nil + "Disables automatic type acquisition. +Automatic type acquisition fetches `@types` packages from npm to improve +IntelliSense for external libraries." + :type 'boolean + :group 'lsp-vetur + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-npm nil + "Specifies the path to the NPM exec used for Automatic Type Acquisition. +Requires using TypeScript 2.3.4 or newer in the +workspace." + :type '(repeat string) + :group 'lsp-vetur + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-check-npm-is-installed t + "Check if NPM is installed for Automatic Type Acquisition." + :type 'boolean + :group 'lsp-vetur + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-references-code-lens-enabled nil + "Enable/disable references CodeLens in JavaScript files." + :type 'boolean + :group 'lsp-vetur + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-references-code-lens-enabled nil + "Enable/disable references CodeLens in TypeScript files." + :type 'boolean + :group 'lsp-vetur + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-implementations-code-lens-enabled nil + "Enable/disable implementations CodeLens. +This CodeLens shows the implementers of an interface." + :type 'boolean + :group 'lsp-vetur + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-tsserver-log "off" + "Enables logging of the TS server to a file. +This log can be used to diagnose TS Server issues. The log may contain file +paths, source code, and other potentially sensitive information +from your project." + :type '(choice + (const "off") + (const "terse") + (const "normal") + (const "verbose")) + :group 'lsp-vetur + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-tsserver-plugin-paths nil + "Additional paths to discover Typescript Language Service plugins. +Requires using TypeScript 2.3.0 or newer in the +workspace." + :type '(repeat string) + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-tsserver-trace "off" + "Enables tracing of messages sent to the TS server. +This trace can be used to diagnose TS Server issues. The trace may contain +file paths, source code, and other potentially sensitive +information from your project." + :type '(choice + (const "off") + (const "messages") + (const "verbose")) + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-suggest-complete-function-calls nil + "Complete functions with their parameter signature." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-suggest-complete-function-calls nil + "Complete functions with their parameter signature." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-report-style-checks-as-warnings t + "Report style checks as warnings." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-validate-enable t + "Enable/disable TypeScript validation." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-format-enable t + "Enable/disable default TypeScript formatter." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-format-insert-space-after-comma-delimiter t + "Defines space handling after a comma delimiter." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-format-insert-space-after-constructor nil + "Defines space handling after the constructor keyword. +Requires using TypeScript 2.3.0 or newer in the workspace." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-format-insert-space-after-semicolon-in-for-statements t + "Defines space handling after a semicolon in a for statement." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-format-insert-space-before-and-after-binary-operators t + "Defines space handling after a binary operator." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-format-insert-space-after-keywords-in-control-flow-statements t + "Defines space handling after keywords in a control flow statement." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-format-insert-space-after-function-keyword-for-anonymous-functions t + "Defines space handling after function keyword for anonymous functions." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-format-insert-space-before-function-parenthesis nil + "Defines space handling before function argument parentheses." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-format-insert-space-after-opening-and-before-closing-empty-braces nil + "Defines space handling after opening/before closing empty braces." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-format-insert-space-after-opening-and-before-closing-nonempty-parenthesis nil + "Defines space handling after opening/before closing non-empty parenthesis." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-format-insert-space-after-opening-and-before-closing-nonempty-brackets nil + "Defines space handling after opening and before closing non-empty brackets." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-format-insert-space-after-opening-and-before-closing-nonempty-braces t + "Defines space handling after opening and before closing non-empty braces. +Requires using TypeScript 2.3.0 or newer in the workspace." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-format-insert-space-after-opening-and-before-closing-template-string-braces nil + "Defines space handling after opening/before closing template string braces." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-format-insert-space-after-opening-and-before-closing-jsx-expression-braces nil + "Defines space handling after opening/before closing JSX expression braces." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-format-insert-space-after-type-assertion nil + "Defines space handling after type assertions in TypeScript. +Requires using TypeScript 2.4 or newer in the workspace." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-format-place-open-brace-on-new-line-for-functions nil + "Defines whether an open brace is put onto a new line for functions or not." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-format-place-open-brace-on-new-line-for-control-blocks nil + "Defines whether an open brace is put onto a newline for control blocks." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-validate-enable t + "Enable/disable JavaScript validation." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-format-enable t + "Enable/disable default JavaScript formatter." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-format-insert-space-after-comma-delimiter t + "Defines space handling after a comma delimiter." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-format-insert-space-after-constructor nil + "Defines space handling after the constructor keyword. +Requires using TypeScript 2.3.0 or newer in the workspace." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-format-insert-space-after-semicolon-in-for-statements t + "Defines space handling after a semicolon in a for statement." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-format-insert-space-before-and-after-binary-operators t + "Defines space handling after a binary operator." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-format-insert-space-after-keywords-in-control-flow-statements t + "Defines space handling after keywords in a control flow statement." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-format-insert-space-after-function-keyword-for-anonymous-functions t + "Defines space handling after function keyword for anonymous functions." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-format-insert-space-before-function-parenthesis nil + "Defines space handling before function argument parentheses." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-format-insert-space-after-opening-and-before-closing-empty-braces nil + "Defines space handling after opening/before closing empty braces." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-format-insert-space-after-opening-and-before-closing-nonempty-parenthesis nil + "Defines space handling after opening and before closing non-empty parenthesis." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-format-insert-space-after-opening-and-before-closing-nonempty-brackets nil + "Defines space handling after opening and before closing non-empty brackets." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-format-insert-space-after-opening-and-before-closing-nonempty-braces t + "Defines space handling after opening and before closing non-empty braces. +Requires using TypeScript 2.3.0 or newer in the workspace." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-format-insert-space-after-opening-and-before-closing-template-string-braces nil + "Defines space handling after opening/before closing template string braces." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-format-insert-space-after-opening-and-before-closing-jsx-expression-braces nil + "Defines space handling after opening/before closing JSX expression braces." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-format-place-open-brace-on-new-line-for-functions nil + "Defines whether an open brace is put onto a new line for functions or not." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-format-place-open-brace-on-new-line-for-control-blocks nil + "Defines whether an open brace is put onto a new line for control blocks or not." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-implicit-project-config-check-js nil + "Enable/disable semantic checking of JavaScript files. +Existing jsconfig.json or tsconfig.json files override this setting. +Requires using TypeScript 2.3.1 or newer in the workspace." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-implicit-project-config-experimental-decorators nil + nil + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-suggest-names t + "Enable/disable including unique names from the file in JavaScript suggestions." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-tsc-auto-detect "on" + "Controls auto detection of tsc tasks." + :type '(choice + (const "on") + (const "off") + (const "build") + (const "watch")) + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-suggest-paths t + "Enable/disable suggestions for paths in import statements and require calls." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-suggest-paths t + "Enable/disable suggestions for paths in import statements and require calls." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-suggest-auto-imports t + "Enable/disable auto import suggestions. +Requires using TypeScript 2.6.1 or newer in the workspace." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-suggest-auto-imports t + "Enable/disable auto import suggestions. Requires using +TypeScript 2.6.1 or newer in the workspace." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-suggest-complete-js-docs t + "Enable/disable suggestion to complete JSDoc comments." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-suggest-complete-js-docs t + "Enable/disable suggestion to complete JSDoc comments." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-locale nil + nil + :type '(choice + (const "de") + (const "es") + (const "en") + (const "fr") + (const "it") + (const "ja") + (const "ko") + (const "ru") + (const "zh-CN") + (const "zh-TW") + (const :tag "default" nil)) + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-suggestion-actions-enabled t + "Enable/disable suggestion diagnostics for JavaScript files in +the editor. Requires using TypeScript 2.8 or newer in the +workspace." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-suggestion-actions-enabled t + "Enable/disable suggestion diagnostics for TypeScript files in +the editor. Requires using TypeScript 2.8 or newer in the +workspace." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-preferences-quote-style "auto" nil + :type '(choice + (const "auto") + (const "single") + (const "double")) + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-preferences-quote-style "auto" nil + :type '(choice + (const "auto") + (const "single") + (const "double")) + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-preferences-import-module-specifier "auto" + "Preferred path style for auto imports." + :type '(choice + (const "auto") + (const "relative") + (const "non-relative")) + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-preferences-import-module-specifier "auto" + "Infer the shortest path type." + :type '(choice + (const "auto") + (const "relative") + (const "non-relative")) + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-preferences-rename-shorthand-properties t + "Enable/disable introducing aliases for object shorthand +properties during renames. Requires using TypeScript 3.4 or newer +in the workspace." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-preferences-rename-shorthand-properties t + "Enable/disable introducing aliases for object shorthand +properties during renames. Requires using TypeScript 3.4 or newer +in the workspace." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-update-imports-on-file-move-enabled "prompt" + "Enable/disable automatic updating of import paths when you +rename or move a file in VS Code. Requires using TypeScript 2.9 +or newer in the workspace." + :type '(choice + (const "prompt") + (const "always") + (const "never")) + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-update-imports-on-file-move-enabled "prompt" + "Prompt on each rename." + :type '(choice + (const "prompt") + (const "always") + (const "never")) + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-auto-closing-tags t + "Enable/disable automatic closing of JSX tags. Requires using +TypeScript 3.0 or newer in the workspace." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-auto-closing-tags t + "Enable/disable automatic closing of JSX tags. Requires using +TypeScript 3.0 or newer in the workspace." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-suggest-enabled t + "Enabled/disable autocomplete suggestions." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-suggest-enabled t + "Enabled/disable autocomplete suggestions." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-typescript-surveys-enabled t + "Enabled/disable occasional surveys that help us improve VS +Code's JavaScript and TypeScript support." + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-javascript-display-enum-member-value-hints nil + "Show inlay hints for enum member values." + :type 'boolean + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-javascript-display-return-type-hints nil + "Show inlay hints for function return types." + :type 'boolean + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-javascript-display-parameter-type-hints nil + "Show inlay hints for function parameters." + :type 'boolean + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-javascript-display-parameter-name-hints "none" + "Level of hinting for parameter types." + :type '(choice (const :tag "none" "none") + (const :tag "literals" "literals") + (const :tag "all" "all")) + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-javascript-display-parameter-name-hints-when-argument-matches-name nil + "Show inlay hints for function parameters even when argument matches +name (e.g. `data' variable passed as `data' parameter)." + :type 'boolean + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-javascript-display-property-declaration-type-hints nil + "Show inlay hints for property declaration types." + :type 'boolean + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-javascript-display-variable-type-hints nil + "Show inlay hints for variable types." + :type 'boolean + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-javascript-completions-complete-function-calls t + "Complete function calls." + :type 'boolean + :package-version '(lsp-mode . "9.0.0")) + +(lsp-register-custom-settings + '(("javascript.autoClosingTags" lsp-javascript-auto-closing-tags t) + ("javascript.implicitProjectConfig.checkJs" lsp-javascript-implicit-project-config-check-js t) + ("javascript.implicitProjectConfig.experimentalDecorators" lsp-javascript-implicit-project-config-experimental-decorators t) + ("javascript.preferences.importModuleSpecifier" lsp-javascript-preferences-import-module-specifier) + ("javascript.preferences.quoteStyle" lsp-javascript-preferences-quote-style) + ("javascript.preferences.renameShorthandProperties" lsp-javascript-preferences-rename-shorthand-properties t) + ("javascript.referencesCodeLens.enabled" lsp-javascript-references-code-lens-enabled t) + ("javascript.suggest.autoImports" lsp-javascript-suggest-auto-imports t) + ("javascript.suggest.completeFunctionCalls" lsp-javascript-suggest-complete-function-calls t) + ("javascript.suggest.completeJSDocs" lsp-javascript-suggest-complete-js-docs t) + ("javascript.suggest.enabled" lsp-javascript-suggest-enabled t) + ("javascript.suggest.names" lsp-javascript-suggest-names t) + ("javascript.suggest.paths" lsp-javascript-suggest-paths t) + ("javascript.suggestionActions.enabled" lsp-javascript-suggestion-actions-enabled t) + ("javascript.updateImportsOnFileMove.enabled" lsp-javascript-update-imports-on-file-move-enabled) + ("javascript.validate.enable" lsp-javascript-validate-enable t) + ("javascript.format.enable" lsp-javascript-format-enable t) + ("javascript.format.insertSpaceAfterCommaDelimiter" lsp-javascript-format-insert-space-after-comma-delimiter t) + ("javascript.format.insertSpaceAfterConstructor" lsp-javascript-format-insert-space-after-constructor t) + ("javascript.format.insertSpaceAfterFunctionKeywordForAnonymousFunctions" lsp-javascript-format-insert-space-after-function-keyword-for-anonymous-functions t) + ("javascript.format.insertSpaceAfterKeywordsInControlFlowStatements" lsp-javascript-format-insert-space-after-keywords-in-control-flow-statements t) + ("javascript.format.insertSpaceAfterOpeningAndBeforeClosingJsxExpressionBraces" lsp-javascript-format-insert-space-after-opening-and-before-closing-jsx-expression-braces t) + ("javascript.format.insertSpaceAfterOpeningAndBeforeClosingEmptyBraces" lsp-javascript-format-insert-space-after-opening-and-before-closing-empty-braces t) + ("javascript.format.insertSpaceAfterOpeningAndBeforeClosingNonemptyBraces" lsp-javascript-format-insert-space-after-opening-and-before-closing-nonempty-braces t) + ("javascript.format.insertSpaceAfterOpeningAndBeforeClosingNonemptyBrackets" lsp-javascript-format-insert-space-after-opening-and-before-closing-nonempty-brackets t) + ("javascript.format.insertSpaceAfterOpeningAndBeforeClosingNonemptyParenthesis" lsp-javascript-format-insert-space-after-opening-and-before-closing-nonempty-parenthesis t) + ("javascript.format.insertSpaceAfterOpeningAndBeforeClosingTemplateStringBraces" lsp-javascript-format-insert-space-after-opening-and-before-closing-template-string-braces t) + ("javascript.format.insertSpaceAfterSemicolonInForStatements" lsp-javascript-format-insert-space-after-semicolon-in-for-statements t) + ("javascript.format.insertSpaceBeforeAndAfterBinaryOperators" lsp-javascript-format-insert-space-before-and-after-binary-operators t) + ("javascript.format.insertSpaceBeforeFunctionParenthesis" lsp-javascript-format-insert-space-before-function-parenthesis t) + ("javascript.format.placeOpenBraceOnNewLineForControlBlocks" lsp-javascript-format-place-open-brace-on-new-line-for-control-blocks t) + ("javascript.format.placeOpenBraceOnNewLineForFunctions" lsp-javascript-format-place-open-brace-on-new-line-for-functions t) + ("typescript.autoClosingTags" lsp-typescript-auto-closing-tags t) + ("typescript.check.npmIsInstalled" lsp-typescript-check-npm-is-installed t) + ("typescript.disableAutomaticTypeAcquisition" lsp-typescript-disable-automatic-type-acquisition t) + ("typescript.implementationsCodeLens.enabled" lsp-typescript-implementations-code-lens-enabled t) + ("typescript.locale" lsp-typescript-locale) + ("typescript.npm" lsp-typescript-npm) + ("typescript.preferences.importModuleSpecifier" lsp-typescript-preferences-import-module-specifier) + ("typescript.preferences.quoteStyle" lsp-typescript-preferences-quote-style) + ("typescript.preferences.renameShorthandProperties" lsp-typescript-preferences-rename-shorthand-properties t) + ("typescript.referencesCodeLens.enabled" lsp-typescript-references-code-lens-enabled t) + ("typescript.reportStyleChecksAsWarnings" lsp-typescript-report-style-checks-as-warnings t) + ("typescript.suggest.autoImports" lsp-typescript-suggest-auto-imports t) + ("typescript.suggest.completeFunctionCalls" lsp-typescript-suggest-complete-function-calls t) + ("typescript.suggest.completeJSDocs" lsp-typescript-suggest-complete-js-docs t) + ("typescript.suggest.enabled" lsp-typescript-suggest-enabled t) + ("typescript.suggest.paths" lsp-typescript-suggest-paths t) + ("typescript.suggestionActions.enabled" lsp-typescript-suggestion-actions-enabled t) + ("typescript.surveys.enabled" lsp-typescript-surveys-enabled t) + ("typescript.tsc.autoDetect" lsp-typescript-tsc-auto-detect) + ("typescript.tsdk" lsp-typescript-tsdk) + ("typescript.tsserver.log" lsp-typescript-tsserver-log) + ("typescript.tsserver.pluginPaths" lsp-typescript-tsserver-plugin-paths) + ("typescript.tsserver.trace" lsp-typescript-tsserver-trace) + ("typescript.updateImportsOnFileMove.enabled" lsp-typescript-update-imports-on-file-move-enabled) + ("typescript.validate.enable" lsp-typescript-validate-enable t) + ("typescript.format.enable" lsp-typescript-format-enable t) + ("typescript.format.insertSpaceAfterCommaDelimiter" lsp-typescript-format-insert-space-after-comma-delimiter t) + ("typescript.format.insertSpaceAfterConstructor" lsp-typescript-format-insert-space-after-constructor t) + ("typescript.format.insertSpaceAfterFunctionKeywordForAnonymousFunctions" lsp-typescript-format-insert-space-after-function-keyword-for-anonymous-functions t) + ("typescript.format.insertSpaceAfterKeywordsInControlFlowStatements" lsp-typescript-format-insert-space-after-keywords-in-control-flow-statements t) + ("typescript.format.insertSpaceAfterOpeningAndBeforeClosingJsxExpressionBraces" lsp-typescript-format-insert-space-after-opening-and-before-closing-jsx-expression-braces t) + ("typescript.format.insertSpaceAfterOpeningAndBeforeClosingEmptyBraces" lsp-typescript-format-insert-space-after-opening-and-before-closing-empty-braces t) + ("typescript.format.insertSpaceAfterOpeningAndBeforeClosingNonemptyBraces" lsp-typescript-format-insert-space-after-opening-and-before-closing-nonempty-braces t) + ("typescript.format.insertSpaceAfterOpeningAndBeforeClosingNonemptyBrackets" lsp-typescript-format-insert-space-after-opening-and-before-closing-nonempty-brackets t) + ("typescript.format.insertSpaceAfterOpeningAndBeforeClosingNonemptyParenthesis" lsp-typescript-format-insert-space-after-opening-and-before-closing-nonempty-parenthesis t) + ("typescript.format.insertSpaceAfterOpeningAndBeforeClosingTemplateStringBraces" lsp-typescript-format-insert-space-after-opening-and-before-closing-template-string-braces t) + ("typescript.format.insertSpaceAfterSemicolonInForStatements" lsp-typescript-format-insert-space-after-semicolon-in-for-statements t) + ("typescript.format.insertSpaceAfterTypeAssertion" lsp-typescript-format-insert-space-after-type-assertion t) + ("typescript.format.insertSpaceBeforeAndAfterBinaryOperators" lsp-typescript-format-insert-space-before-and-after-binary-operators t) + ("typescript.format.insertSpaceBeforeFunctionParenthesis" lsp-typescript-format-insert-space-before-function-parenthesis t) + ("typescript.format.placeOpenBraceOnNewLineForControlBlocks" lsp-typescript-format-place-open-brace-on-new-line-for-control-blocks t) + ("typescript.format.placeOpenBraceOnNewLineForFunctions" lsp-typescript-format-place-open-brace-on-new-line-for-functions t) + ("typescript.inlayHints.includeInlayEnumMemberValueHints" lsp-javascript-display-enum-member-value-hints t) + ("typescript.inlayHints.includeInlayFunctionLikeReturnTypeHints" lsp-javascript-display-return-type-hints t) + ("typescript.inlayHints.includeInlayFunctionParameterTypeHints" lsp-javascript-display-parameter-type-hints t) + ("typescript.inlayHints.includeInlayParameterNameHints" lsp-javascript-display-parameter-name-hints nil) + ("typescript.inlayHints.includeInlayParameterNameHintsWhenArgumentMatchesName" lsp-javascript-display-parameter-name-hints-when-argument-matches-name t) + ("typescript.inlayHints.includeInlayPropertyDeclarationTypeHints" lsp-javascript-display-property-declaration-type-hints t) + ("typescript.inlayHints.includeInlayVariableTypeHints" lsp-javascript-display-variable-type-hints t) + ("javascript.inlayHints.includeInlayEnumMemberValueHints" lsp-javascript-display-enum-member-value-hints t) + ("javascript.inlayHints.includeInlayFunctionLikeReturnTypeHints" lsp-javascript-display-return-type-hints t) + ("javascript.inlayHints.includeInlayFunctionParameterTypeHints" lsp-javascript-display-parameter-type-hints t) + ("javascript.inlayHints.includeInlayParameterNameHints" lsp-javascript-display-parameter-name-hints nil) + ("javascript.inlayHints.includeInlayParameterNameHintsWhenArgumentMatchesName" lsp-javascript-display-parameter-name-hints-when-argument-matches-name t) + ("javascript.inlayHints.includeInlayPropertyDeclarationTypeHints" lsp-javascript-display-property-declaration-type-hints t) + ("javascript.inlayHints.includeInlayVariableTypeHints" lsp-javascript-display-variable-type-hints t) + ("completions.completeFunctionCalls" lsp-javascript-completions-complete-function-calls t))) + +(lsp-dependency 'typescript-language-server + '(:system lsp-clients-typescript-tls-path) + '(:npm :package "typescript-language-server" + :path "typescript-language-server")) + +(lsp-dependency 'typescript + '(:system "tsserver") + '(:npm :package "typescript" + :path "tsserver")) + +(defun lsp-javascript--rename (_workspace args) + (let ((path (lsp--uri-to-path (lsp-get (lsp-get args :textDocument) :uri)))) + (if (f-exists? path) + (with-current-buffer (find-file path) + (goto-char (lsp--position-to-point + (lsp-get args :position)))) + (error "There is no file %s" path))) + (call-interactively #'lsp-rename) + nil) + +(defun lsp-javascript-rename-file () + "Rename current file and all it's references in other files." + (interactive) + (let* ((name (buffer-name)) + (old (buffer-file-name)) + (basename (file-name-nondirectory old))) + (unless (and old (file-exists-p old)) + (error "Buffer '%s' is not visiting a file." name)) + (let ((new (read-file-name "New name: " (file-name-directory old) basename nil basename))) + (when (get-file-buffer new) + (error "A buffer named '%s' already exists." new)) + (when (file-exists-p new) + (error "A file named '%s' already exists." new)) + (lsp--send-execute-command + "_typescript.applyRenameFile" + (vector (list :sourceUri (lsp--buffer-uri) + :targetUri (lsp--path-to-uri new)))) + (mkdir (file-name-directory new) t) + (rename-file old new) + (rename-buffer new) + (set-visited-file-name new) + (set-buffer-modified-p nil) + (lsp-disconnect) + (setq-local lsp-buffer-uri nil) + (lsp) + (lsp--info "Renamed '%s' to '%s'." name (file-name-nondirectory new))))) + +(defun lsp-javascript-initialized? () + (when-let* ((workspace (lsp-find-workspace 'ts-ls (buffer-file-name)))) + (eq 'initialized (lsp--workspace-status workspace)))) + +(defun lsp-clients-typescript-require-resolve (&optional dir) + "Get the location of the typescript. +Use Node.js require. +The node_modules directory structure is suspect +and should be trusted as little as possible. +If you call require in Node.js, +it should take into account the various hooks. +For example, yarn PnP. + +Optional argument DIR specifies the working directory +to run the command in." + (when-let* + ((default-directory (or dir default-directory)) + (output + (string-trim-right + (shell-command-to-string + "node -e \"console.log(require.resolve('typescript'))\""))) + (not-empty (not (string-empty-p output)))) + (f-parent output))) + +(defun lsp-clients-typescript-server-path () + "Return the TS server path based on settings." + (if-let* ((use-project-ts lsp-clients-typescript-prefer-use-project-ts-server) + (server-path (lsp-clients-typescript-require-resolve)) + (server-path-exist (f-exists? server-path))) + server-path + (if (memq system-type '(cygwin windows-nt ms-dos)) + ;; The Windows environment does not recognize the top-level PATH returned by `lsp-package-path', + ;; so the real PATH is returned through Node.js. + (lsp-clients-typescript-require-resolve (f-parent (lsp-package-path 'typescript))) + (lsp-package-path 'typescript)))) + +(lsp-register-client + (make-lsp-client :new-connection (lsp-stdio-connection (lambda () + `(,(lsp-package-path 'typescript-language-server) + ,@lsp-clients-typescript-server-args))) + :activation-fn 'lsp-typescript-javascript-tsx-jsx-activate-p + :priority -2 + :completion-in-comments? t + :initialization-options (lambda () + (append + (when lsp-clients-typescript-disable-automatic-typing-acquisition + (list :disableAutomaticTypingAcquisition lsp-clients-typescript-disable-automatic-typing-acquisition)) + (when lsp-clients-typescript-log-verbosity + (list :logVerbosity lsp-clients-typescript-log-verbosity)) + (when lsp-clients-typescript-max-ts-server-memory + (list :maxTsServerMemory lsp-clients-typescript-max-ts-server-memory)) + (when lsp-clients-typescript-npm-location + (list :npmLocation lsp-clients-typescript-npm-location)) + (when lsp-clients-typescript-plugins + (list :plugins lsp-clients-typescript-plugins)) + (when lsp-clients-typescript-preferences + (list :preferences lsp-clients-typescript-preferences)) + `(:tsserver ( :path ,(lsp-clients-typescript-server-path) + ,@lsp-clients-typescript-tsserver)))) + :initialized-fn (lambda (workspace) + (with-lsp-workspace workspace + (lsp--set-configuration + (ht-merge (lsp-configuration-section "javascript") + (lsp-configuration-section "typescript") + (lsp-configuration-section "completions") + (lsp-configuration-section "diagnostics")))) + (let ((caps (lsp--workspace-server-capabilities workspace)) + (format-enable (or lsp-javascript-format-enable lsp-typescript-format-enable))) + (lsp:set-server-capabilities-document-formatting-provider? caps format-enable) + (lsp:set-server-capabilities-document-range-formatting-provider? caps format-enable))) + :ignore-messages '("readFile .*? requested by TypeScript but content not available") + :server-id 'ts-ls + :request-handlers (ht ("_typescript.rename" #'lsp-javascript--rename)) + :download-server-fn (lambda (_client callback error-callback _update?) + (lsp-package-ensure + 'typescript + (-partial #'lsp-package-ensure + 'typescript-language-server + callback + error-callback) + error-callback)))) + + +(defgroup lsp-flow nil + "LSP support for the Flow Javascript type checker." + :group 'lsp-mode + :link '(url-link "https://flow.org")) + +(defcustom lsp-clients-flow-server "flow" + "The Flow executable to use. +Leave as just the executable name to use the default behavior of +finding the executable with variable `exec-path'." + :group 'lsp-flow + :risky t + :type 'file) + +(defcustom lsp-clients-flow-server-args '("lsp") + "Extra arguments for starting the Flow language server." + :group 'lsp-flow + :risky t + :type '(repeat string)) + +(defun lsp-clients-flow-tag-file-present-p (file-name) + "Check if the '// @flow' or `/* @flow */' tag is present in +the contents of FILE-NAME." + (if-let* ((buffer (find-buffer-visiting file-name))) + (with-current-buffer buffer + (lsp-clients-flow-tag-string-present-p)) + (with-temp-buffer + (insert-file-contents file-name) + (lsp-clients-flow-tag-string-present-p)))) + +(defun lsp-clients-flow-tag-string-present-p () + "Helper for `lsp-clients-flow-tag-file-present-p' that works +with the file contents." + (save-excursion + (goto-char (point-min)) + (let (stop found) + (while (not stop) + (unless (re-search-forward "[^\n[:space:]]" nil t) + (setq stop t)) + (if (= (point) (point-min)) (setq stop t) (backward-char)) + (cond ((or (looking-at-p "//+[ ]*@flow") + (looking-at-p "/\\**[ ]*@flow") + (looking-at-p "[ ]*\\*[ ]*@flow")) + (setq found t) (setq stop t)) + ((or (looking-at-p "//") (looking-at-p "*")) + (forward-line)) + ((looking-at-p "/\\*") + (save-excursion + (unless (re-search-forward "*/" nil t) (setq stop t))) + (forward-line)) + (t (setq stop t)))) + found))) + +(defun lsp-clients-flow-project-p (file-name) + "Check if FILE-NAME is part of a Flow project, that is, if +there is a .flowconfig file in the folder hierarchy." + (locate-dominating-file file-name ".flowconfig")) + +(defun lsp-clients-flow-activate-p (file-name _mode) + "Check if the Flow language server should be enabled for a +particular FILE-NAME and MODE." + (and (derived-mode-p 'js-mode 'web-mode 'js2-mode 'flow-js2-mode 'rjsx-mode) + (not (derived-mode-p 'json-mode)) + (or (lsp-clients-flow-project-p file-name) + (lsp-clients-flow-tag-file-present-p file-name)))) + +(lsp-register-client + (make-lsp-client :new-connection + (lsp-stdio-connection (lambda () + (cons lsp-clients-flow-server + lsp-clients-flow-server-args))) + :priority -1 + :activation-fn 'lsp-clients-flow-activate-p + :server-id 'flow-ls)) + +(defgroup lsp-deno nil + "LSP support for the Deno language server." + :group 'lsp-mode + :link '(url-link "https://deno.land/")) + +(defcustom lsp-clients-deno-server "deno" + "The Deno executable to use. +Leave as just the executable name to use the default behavior of +finding the executable with variable `exec-path'." + :group 'lsp-deno + :risky t + :type 'file + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-clients-deno-server-args '("lsp") + "Extra arguments for starting the Deno language server." + :group 'lsp-deno + :risky t + :type '(repeat string) + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-clients-deno-enable-lint t + "Controls if linting information will be provided by the Deno Language Server." + :group 'lsp-deno + :risky t + :type 'boolean + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-clients-deno-enable-code-lens-references t + "Enables or disables the display of code lens information." + :group 'lsp-deno + :risky t + :type 'boolean + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-clients-deno-enable-code-lens-references-all-functions t + "Enables or disables the display of code lens information for all functions. +Setting this variable to `non-nil' implicitly enables +`lsp-clients-deno-enable-code-lens-references'." + :group 'lsp-deno + :risky t + :type 'boolean + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-clients-deno-enable-code-lens-implementations t + "Enables or disables the display of code lens information for implementations." + :group 'lsp-deno + :risky t + :type 'boolean + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-clients-deno-config nil + "The file path to a tsconfig.json file. +The path can be either be relative to the workspace, or an +absolute path. + +Examples: `./tsconfig.json', +`/path/to/tsconfig.json', `C:\\path\\to\\tsconfig.json'" + :group 'lsp-deno + :risky t + :type 'file + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-clients-deno-import-map nil + "The file path to an import map. +Import maps provide a way to relocate modules based on their +specifiers. The path can either be relative to the workspace, or +an absolute path. + +Examples: `./import-map.json', +`/path/to/import-map.json', `C:\\path\\to\\import-map.json'." + :group 'lsp-deno + :risky t + :type 'file + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-clients-deno-enable-unstable nil + "Controls if code will be type checked with Deno's unstable APIs." + :group 'lsp-deno + :risky t + :type 'boolean + :package-version '(lsp-mode . "8.0.0")) + +(defun lsp-clients-deno--make-init-options () + "Initialization options for the Deno language server." + `( :enable t + :config ,lsp-clients-deno-config + :importMap ,lsp-clients-deno-import-map + :lint ,(lsp-json-bool lsp-clients-deno-enable-lint) + :unstable ,(lsp-json-bool lsp-clients-deno-enable-unstable) + :codeLens ( :implementations ,(lsp-json-bool lsp-clients-deno-enable-code-lens-implementations) + :references ,(lsp-json-bool (or lsp-clients-deno-enable-code-lens-references + lsp-clients-deno-enable-code-lens-references-all-functions)) + :referencesAllFunctions ,(lsp-json-bool lsp-clients-deno-enable-code-lens-references-all-functions)))) + +(lsp-register-client + (make-lsp-client :new-connection + (lsp-stdio-connection (lambda () + (cons lsp-clients-deno-server + lsp-clients-deno-server-args))) + :initialization-options #'lsp-clients-deno--make-init-options + :priority -5 + :activation-fn #'lsp-typescript-javascript-tsx-jsx-activate-p + :server-id 'deno-ls)) + +(lsp-consistency-check lsp-javascript) + +(provide 'lsp-javascript) +;;; lsp-javascript.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-javascript.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-javascript.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-jq.el b/emacs/elpa/lsp-mode-20241119.828/lsp-jq.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-jq.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-jq.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-json.el b/emacs/elpa/lsp-mode-20241119.828/lsp-json.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-json.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-json.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-jsonnet.el b/emacs/elpa/lsp-mode-20241119.828/lsp-jsonnet.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-jsonnet.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-jsonnet.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-kotlin.el b/emacs/elpa/lsp-mode-20241119.828/lsp-kotlin.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-kotlin.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-kotlin.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-lens.el b/emacs/elpa/lsp-mode-20241119.828/lsp-lens.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-lens.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-lens.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-lisp.el b/emacs/elpa/lsp-mode-20241119.828/lsp-lisp.el @@ -0,0 +1,92 @@ +;;; lsp-lisp.el --- LSP client for Lisp -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Shen, Jen-Chieh + +;; 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 this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; LSP client for Lisp. +;; + +;;; Code: + +(require 'lsp-mode) + +(defgroup lsp-lisp nil + "LSP support for Lisp." + :group 'lsp-mode + :package-version `(lsp-mode . "9.0.0")) + +(defcustom lsp-lisp-active-modes + '( lisp-mode) + "List of major mode that work with lisp." + :type '(list symbol) + :group 'lsp-lisp) + +(defcustom lsp-lisp-alive-port 8006 + "Port to connect server to." + :type 'integer + :group 'lsp-lisp) + +;; +;;; Server + +;;;###autoload +(defun lsp-lisp-alive-start-ls () + "Start the alive-lsp." + (interactive) + (when-let* ((exe (executable-find "sbcl")) + ((lsp--port-available "localhost" lsp-lisp-alive-port))) + (lsp-async-start-process #'ignore #'ignore + exe + "--noinform" + "--eval" + "(ql:quickload \"alive-lsp\")" + "--eval" + (format "(alive/server::start :port %s)" + lsp-lisp-alive-port)))) + +;; +;;; Core + +(defun lsp-lisp-alive--tcp-connect-to-port () + "Define a TCP connection to language server." + (list + :connect + (lambda (filter sentinel name _environment-fn _workspace) + (let* ((host "localhost") + (port lsp-lisp-alive-port) + (tcp-proc (lsp--open-network-stream host port (concat name "::tcp")))) + + ;; TODO: Same :noquery issue (see above) + (set-process-query-on-exit-flag tcp-proc nil) + (set-process-filter tcp-proc filter) + (set-process-sentinel tcp-proc sentinel) + (cons tcp-proc tcp-proc))) + :test? (lambda () t))) + +(lsp-register-client + (make-lsp-client + :new-connection (lsp-lisp-alive--tcp-connect-to-port) + :major-modes lsp-lisp-active-modes + :priority -1 + :server-id 'alive-lsp)) + +(lsp-consistency-check lsp-lisp) + +(provide 'lsp-lisp) +;;; lsp-lisp.el ends here diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-lisp.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-lisp.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-lua.el b/emacs/elpa/lsp-mode-20241119.828/lsp-lua.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-lua.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-lua.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-magik.el b/emacs/elpa/lsp-mode-20241119.828/lsp-magik.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-magik.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-magik.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-markdown.el b/emacs/elpa/lsp-mode-20241119.828/lsp-markdown.el @@ -0,0 +1,102 @@ +;;; lsp-markdown.el --- lsp-mode markdown integration -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 lsp-mode maintainers + +;; Author: lsp-mode maintainers +;; Keywords: languages + +;; 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: + +;; LSP client for unified-language-server + +;;; Code: + +(require 'lsp-mode) + +;;; Markdown +(defgroup lsp-markdown nil + "Settings for the markdown language server client." + :group 'lsp-mode + :link '(url-link "https://github.com/unifiedjs/unified-language-server") + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-markdown-server-command "unified-language-server" + "The binary (or full path to binary) which executes the server." + :type 'string + :group 'lsp-markdown + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-markdown-server-command-args '("--parser=remark-parse" "--stdio") + "Command-line arguments for the markdown lsp server." + :type '(repeat string) + :group 'lsp-markdown + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-markdown-remark-plugins [["#remark-preset-lint-markdown-style-guide"]] + "The JSON configuration object for plugins. + +For a complete list of plugins, check: + https://github.com/unifiedjs/unified-language-server/blob/main/CONFIGURATION.md#re-using-settings" + :type 'lsp-string-vector + :group 'lsp-markdown + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-markdown-remark-check-text-with-setting "retext-english" + "Configure `checkTextWith' subproperty. + +For a complete list of plugins, check: + https://github.com/unifiedjs/unified-language-server/blob/main/CONFIGURATION.md#re-using-settings" + :type '(choice (const "retext-english") + (const "remark-parse")) + :group 'lsp-markdown + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-markdown-remark-check-text-with-mutator ["#remark-retext" "#parse-latin"] + "Vector of additional mutators. + +For a complete list of plugins, check: + https://github.com/unifiedjs/unified-language-server/blob/main/CONFIGURATION.md#re-using-settings" + :type 'lsp-string-vector + :group 'lsp-markdown + :package-version '(lsp-mode . "8.0.0")) + +(lsp-dependency 'unified-language-server + '(:system "unified-language-server") + '(:npm :package "unified-language-server" + :path "unified-language-server")) + +(lsp-register-custom-settings + `(("unified-language-server.remark-parse.plugins" lsp-markdown-remark-plugins) + ("unified-language-server.remark-parse.checkTextWith.setting" lsp-markdown-remark-check-text-with-setting) + ("unified-language-server.remark-parse.checkTextWith.mutator" lsp-markdown-remark-check-text-with-mutator))) + +(lsp-register-client + (make-lsp-client :new-connection (lsp-stdio-connection + (lambda () + (cons (or (executable-find lsp-markdown-server-command) + (lsp-package-path 'unified-language-server)) + lsp-markdown-server-command-args))) + :activation-fn (lsp-activate-on "markdown") + :initialized-fn (lambda (workspace) + (with-lsp-workspace workspace + (lsp--set-configuration (lsp-configuration-section "unified-language-server")))) + :priority -1 + :server-id 'unified)) + +(lsp-consistency-check lsp-markdown) + +(provide 'lsp-markdown) +;;; lsp-markdown.el ends here diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-markdown.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-markdown.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-marksman.el b/emacs/elpa/lsp-mode-20241119.828/lsp-marksman.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-marksman.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-marksman.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-mdx.el b/emacs/elpa/lsp-mode-20241119.828/lsp-mdx.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-mdx.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-mdx.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-meson.el b/emacs/elpa/lsp-mode-20241119.828/lsp-meson.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-meson.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-meson.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-mint.el b/emacs/elpa/lsp-mode-20241119.828/lsp-mint.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-mint.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-mint.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-mode-autoloads.el b/emacs/elpa/lsp-mode-20241119.828/lsp-mode-autoloads.el diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-mode-pkg.el b/emacs/elpa/lsp-mode-20241119.828/lsp-mode-pkg.el @@ -0,0 +1,15 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "lsp-mode" "20241119.828" + "LSP mode." + '((emacs "27.1") + (dash "2.18.0") + (f "0.20.0") + (ht "2.3") + (spinner "1.7.3") + (markdown-mode "2.3") + (lv "0") + (eldoc "1.11")) + :url "https://github.com/emacs-lsp/lsp-mode" + :commit "620bbd7163fa9d9281cd315ffa3ee29d83be8686" + :revdesc "620bbd7163fa" + :keywords '("languages")) diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-mode.el b/emacs/elpa/lsp-mode-20241119.828/lsp-mode.el @@ -0,0 +1,9958 @@ +;;; lsp-mode.el --- LSP mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2020-2024 emacs-lsp maintainers + +;; Author: Vibhav Pant, Fangrui Song, Ivan Yonchovski +;; Keywords: languages +;; Package-Requires: ((emacs "27.1") (dash "2.18.0") (f "0.20.0") (ht "2.3") (spinner "1.7.3") (markdown-mode "2.3") (lv "0") (eldoc "1.11")) +;; Package-Version: 20241119.828 +;; Package-Revision: 620bbd7163fa + +;; URL: https://github.com/emacs-lsp/lsp-mode +;; 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: + +;; Emacs client/library for the Language Server Protocol + +;;; Code: + +(require 'cl-generic) +(require 'cl-lib) +(require 'compile) +(require 'dash) +(require 'epg) +(require 'ewoc) +(require 'f) +(require 'filenotify) +(require 'files) +(require 'ht) +(require 'imenu) +(require 'inline) +(require 'json) +(require 'lv) +(require 'markdown-mode) +(require 'network-stream) +(require 'pcase) +(require 'rx) +(require 's) +(require 'seq) +(require 'spinner) +(require 'subr-x) +(require 'tree-widget) +(require 'url-parse) +(require 'url-util) +(require 'widget) +(require 'xref) +(require 'minibuffer) +(require 'help-mode) +(require 'lsp-protocol) + +(defgroup lsp-mode nil + "Language Server Protocol client." + :group 'tools + :tag "Language Server (lsp-mode)") + +(declare-function evil-set-command-property "ext:evil-common") +(declare-function projectile-project-root "ext:projectile") +(declare-function yas-expand-snippet "ext:yasnippet") +(declare-function dap-mode "ext:dap-mode") +(declare-function dap-auto-configure-mode "ext:dap-mode") + +(defvar yas-inhibit-overlay-modification-protection) +(defvar yas-indent-line) +(defvar yas-wrap-around-region) +(defvar yas-also-auto-indent-first-line) +(defvar dap-auto-configure-mode) +(defvar dap-ui-menu-items) +(defvar company-minimum-prefix-length) + +(defconst lsp--message-type-face + `((1 . ,compilation-error-face) + (2 . ,compilation-warning-face) + (3 . ,compilation-message-face) + (4 . ,compilation-info-face))) + +(defconst lsp--errors + '((-32700 "Parse Error") + (-32600 "Invalid Request") + (-32601 "Method not Found") + (-32602 "Invalid Parameters") + (-32603 "Internal Error") + (-32099 "Server Start Error") + (-32000 "Server End Error") + (-32002 "Server Not Initialized") + (-32001 "Unknown Error Code") + (-32800 "Request Cancelled")) + "Alist of error codes to user friendly strings.") + +(defconst lsp--empty-ht (make-hash-table)) + +(eval-and-compile + (defun dash-expand:&lsp-wks (key source) + `(,(intern-soft (format "lsp--workspace-%s" (eval key))) ,source)) + + (defun dash-expand:&lsp-cln (key source) + `(,(intern-soft (format "lsp--client-%s" (eval key))) ,source))) + +(define-obsolete-variable-alias 'lsp-print-io 'lsp-log-io "lsp-mode 6.1") + +(defcustom lsp-log-io nil + "If non-nil, log all messages from the language server to a *lsp-log* buffer." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-log-io-allowlist-methods '() + "The methods to filter before print to lsp-log-io." + :group 'lsp-mode + :type '(repeat string) + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-log-max message-log-max + "Maximum number of lines to keep in the log buffer. +If nil, disable message logging. If t, log messages but don’t truncate +the buffer when it becomes large." + :group 'lsp-mode + :type '(choice (const :tag "Disable" nil) + (integer :tag "lines") + (const :tag "Unlimited" t)) + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-io-messages-max t + "Maximum number of messages that can be locked in a `lsp-io' buffer." + :group 'lsp-mode + :type '(choice (const :tag "Unlimited" t) + (integer :tag "Messages")) + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-keep-workspace-alive t + "If non nil keep workspace alive when the last workspace buffer is closed." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-enable-snippet t + "Enable/disable snippet completion support." + :group 'lsp-completion + :type 'boolean) + +(defcustom lsp-enable-folding t + "Enable/disable code folding support." + :group 'lsp-mode + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(define-obsolete-variable-alias 'lsp-enable-semantic-highlighting 'lsp-semantic-tokens-enable "lsp-mode 8.0.0") + +(defcustom lsp-semantic-tokens-enable nil + "Enable/disable support for semantic tokens. +As defined by the Language Server Protocol 3.16." + :group 'lsp-semantic-tokens + :type 'boolean) + +(defcustom lsp-folding-range-limit nil + "The maximum number of folding ranges to receive from the language server." + :group 'lsp-mode + :type '(choice (const :tag "No limit." nil) + (integer :tag "Number of lines.")) + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-folding-line-folding-only nil + "If non-nil, only fold complete lines." + :group 'lsp-mode + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-client-packages + '( ccls lsp-actionscript lsp-ada lsp-angular lsp-ansible lsp-asm lsp-astro + lsp-autotools lsp-awk lsp-bash lsp-beancount lsp-bufls lsp-clangd + lsp-clojure lsp-cmake lsp-cobol lsp-credo lsp-crystal lsp-csharp lsp-css + lsp-cucumber lsp-cypher lsp-d lsp-dart lsp-dhall lsp-docker lsp-dockerfile + lsp-earthly lsp-elixir lsp-elm lsp-emmet lsp-erlang lsp-eslint lsp-fortran lsp-futhark + lsp-fsharp lsp-gdscript lsp-gleam lsp-glsl lsp-go lsp-golangci-lint lsp-grammarly + lsp-graphql lsp-groovy lsp-hack lsp-haskell lsp-haxe lsp-idris lsp-java + lsp-javascript lsp-jq lsp-json lsp-kotlin lsp-latex lsp-lisp lsp-ltex + lsp-lua lsp-fennel lsp-magik lsp-markdown lsp-marksman lsp-mdx lsp-meson lsp-metals lsp-mint + lsp-mojo lsp-move lsp-mssql lsp-nextflow lsp-nginx lsp-nim lsp-nix lsp-nushell lsp-ocaml + lsp-openscad lsp-pascal lsp-perl lsp-perlnavigator lsp-php lsp-pls + lsp-purescript lsp-pwsh lsp-pyls lsp-pylsp lsp-pyright lsp-python-ms + lsp-qml lsp-r lsp-racket lsp-remark lsp-rf lsp-roslyn lsp-rubocop lsp-ruby-lsp + lsp-ruby-syntax-tree lsp-ruff lsp-rust lsp-semgrep lsp-shader + lsp-solargraph lsp-solidity lsp-sonarlint lsp-sorbet lsp-sourcekit + lsp-sql lsp-sqls lsp-steep lsp-svelte lsp-tailwindcss lsp-terraform + lsp-tex lsp-tilt lsp-toml lsp-trunk lsp-ttcn3 lsp-typeprof lsp-typespec lsp-v + lsp-vala lsp-verilog lsp-vetur lsp-vhdl lsp-vimscript lsp-volar lsp-wgsl + lsp-xml lsp-yaml lsp-yang lsp-zig) + "List of the clients to be automatically required." + :group 'lsp-mode + :type '(repeat symbol)) + +(defcustom lsp-progress-via-spinner t + "If non-nil, display LSP $/progress reports via a spinner in the modeline." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-progress-spinner-type 'progress-bar + "Holds the type of spinner to be used in the mode-line. +Takes a value accepted by `spinner-start'." + :group 'lsp-mode + :type `(choice :tag "Choose a spinner by name" + ,@(mapcar (lambda (c) (list 'const (car c))) + spinner-types))) + +(defvar-local lsp-use-workspace-root-for-server-default-directory nil + "Use `lsp-workspace-root' for `default-directory' when starting LSP process.") + +(defvar-local lsp--cur-workspace nil) + +(defvar-local lsp--cur-version 0) +(defvar-local lsp--virtual-buffer-connections nil) +(defvar-local lsp--virtual-buffer nil) +(defvar lsp--virtual-buffer-mappings (ht)) + +(defvar lsp--uri-file-prefix (pcase system-type + (`windows-nt "file:///") + (_ "file://")) + "Prefix for a file-uri.") + +(defvar-local lsp-buffer-uri nil + "If set, return it instead of calculating it using `buffer-file-name'.") + +(define-error 'lsp-error "Unknown lsp-mode error") +(define-error 'lsp-empty-response-error + "Empty response from the language server" 'lsp-error) +(define-error 'lsp-timed-out-error + "Timed out while waiting for a response from the language server" 'lsp-error) +(define-error 'lsp-capability-not-supported + "Capability not supported by the language server" 'lsp-error) +(define-error 'lsp-file-scheme-not-supported + "Unsupported file scheme" 'lsp-error) +(define-error 'lsp-client-already-exists-error + "A client with this server-id already exists" 'lsp-error) +(define-error 'lsp-no-code-actions + "No code actions" 'lsp-error) + +(defcustom lsp-auto-guess-root nil + "Automatically guess the project root using projectile/project. +Do *not* use this setting unless you are familiar with `lsp-mode' +internals and you are sure that all of your projects are +following `projectile'/`project.el' conventions." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-guess-root-without-session nil + "Ignore the session file when calculating the project root. +You almost always want to set lsp-auto-guess-root too. +Do *not* use this setting unless you are familiar with `lsp-mode' +internals and you are sure that all of your projects are +following `projectile'/`project.el' conventions." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-restart 'interactive + "Defines how server-exited events must be handled." + :group 'lsp-mode + :type '(choice (const interactive) + (const auto-restart) + (const ignore))) + +(defcustom lsp-session-file (expand-file-name (locate-user-emacs-file ".lsp-session-v1")) + "File where session information is stored." + :group 'lsp-mode + :type 'file) + +(defcustom lsp-auto-configure t + "Auto configure `lsp-mode' main features. +When set to t `lsp-mode' will auto-configure completion, +code-actions, breadcrumb, `flycheck', `flymake', `imenu', symbol highlighting, +lenses, links, and so on. + +For finer granularity you may use `lsp-enable-*' properties." + :group 'lsp-mode + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-disabled-clients nil + "A list of disabled/blocklisted clients. +Each entry in the list can be either: +a symbol, the server-id for the LSP client, or +a cons pair (MAJOR-MODE . CLIENTS), where MAJOR-MODE is the major-mode, +and CLIENTS is either a client or a list of clients. + +This option can also be used as a file- or directory-local variable to +disable a language server for individual files or directories/projects +respectively." + :group 'lsp-mode + :type '(repeat (symbol)) + :safe 'listp + :package-version '(lsp-mode . "6.1")) + +(defvar lsp-clients (make-hash-table :test 'eql) + "Hash table server-id -> client. +It contains all of the clients that are currently registered.") + +(defvar lsp-enabled-clients nil + "List of clients allowed to be used for projects. +When nil, all registered clients are considered candidates.") + +(defvar lsp-last-id 0 + "Last request id.") + +(defcustom lsp-before-initialize-hook nil + "List of functions to be called before a Language Server has been initialized +for a new workspace." + :type 'hook + :group 'lsp-mode) + +(defcustom lsp-after-initialize-hook nil + "List of functions to be called after a Language Server has been initialized +for a new workspace." + :type 'hook + :group 'lsp-mode) + +(defcustom lsp-before-open-hook nil + "List of functions to be called before a new file with LSP support is opened." + :type 'hook + :group 'lsp-mode) + +(defcustom lsp-after-open-hook nil + "List of functions to be called after a new file with LSP support is opened." + :type 'hook + :group 'lsp-mode) + +(defcustom lsp-enable-file-watchers t + "If non-nil lsp-mode will watch the files in the workspace if +the server has requested that." + :type 'boolean + :group 'lsp-mode + :package-version '(lsp-mode . "6.1")) +;;;###autoload(put 'lsp-enable-file-watchers 'safe-local-variable #'booleanp) + +(define-obsolete-variable-alias 'lsp-file-watch-ignored 'lsp-file-watch-ignored-directories "8.0.0") + +(defcustom lsp-file-watch-ignored-directories + '(; SCM tools + "[/\\\\]\\.git\\'" + "[/\\\\]\\.github\\'" + "[/\\\\]\\.gitlab\\'" + "[/\\\\]\\.circleci\\'" + "[/\\\\]\\.hg\\'" + "[/\\\\]\\.bzr\\'" + "[/\\\\]_darcs\\'" + "[/\\\\]\\.svn\\'" + "[/\\\\]_FOSSIL_\\'" + ;; IDE or build tools + "[/\\\\]\\.idea\\'" + "[/\\\\]\\.ensime_cache\\'" + "[/\\\\]\\.eunit\\'" + "[/\\\\]node_modules" + "[/\\\\]\\.yarn\\'" + "[/\\\\]\\.fslckout\\'" + "[/\\\\]\\.tox\\'" + "[/\\\\]\\.nox\\'" + "[/\\\\]dist\\'" + "[/\\\\]dist-newstyle\\'" + "[/\\\\]\\.stack-work\\'" + "[/\\\\]\\.bloop\\'" + "[/\\\\]\\.metals\\'" + "[/\\\\]target\\'" + "[/\\\\]\\.ccls-cache\\'" + "[/\\\\]\\.vs\\'" + "[/\\\\]\\.vscode\\'" + "[/\\\\]\\.venv\\'" + "[/\\\\]\\.mypy_cache\\'" + "[/\\\\]\\.pytest_cache\\'" + ;; Swift Package Manager + "[/\\\\]\\.build\\'" + ;; Python + "[/\\\\]__pycache__\\'" + "[/\\\\]site-packages\\'" + "[/\\\\].pyenv\\'" + ;; Autotools output + "[/\\\\]\\.deps\\'" + "[/\\\\]build-aux\\'" + "[/\\\\]autom4te.cache\\'" + "[/\\\\]\\.reference\\'" + ;; Bazel + "[/\\\\]bazel-[^/\\\\]+\\'" + ;; CSharp + "[/\\\\]\\.cache[/\\\\]lsp-csharp\\'" + "[/\\\\]\\.meta\\'" + "[/\\\\]\\.nuget\\'" + ;; Unity + "[/\\\\]Library\\'" + ;; Clojure + "[/\\\\]\\.lsp\\'" + "[/\\\\]\\.clj-kondo\\'" + "[/\\\\]\\.shadow-cljs\\'" + "[/\\\\]\\.babel_cache\\'" + "[/\\\\]\\.cpcache\\'" + "[/\\\\]\\checkouts\\'" + ;; Gradle + "[/\\\\]\\.gradle\\'" + ;; Maven + "[/\\\\]\\.m2\\'" + ;; .Net Core build-output + "[/\\\\]bin/Debug\\'" + "[/\\\\]obj\\'" + ;; OCaml and Dune + "[/\\\\]_opam\\'" + "[/\\\\]_build\\'" + ;; Elixir + "[/\\\\]\\.elixir_ls\\'" + ;; Elixir Credo + "[/\\\\]\\.elixir-tools\\'" + ;; terraform and terragrunt + "[/\\\\]\\.terraform\\'" + "[/\\\\]\\.terragrunt-cache\\'" + ;; nix-direnv + "[/\\\\]\\result" + "[/\\\\]\\result-bin" + "[/\\\\]\\.direnv\\'") + "List of regexps matching directory paths which won't be monitored when +creating file watches. Customization of this variable is only honored at +the global level or at a root of an lsp workspace." + :group 'lsp-mode + :type '(repeat string) + :package-version '(lsp-mode . "8.0.0")) + +(define-obsolete-function-alias 'lsp-file-watch-ignored 'lsp-file-watch-ignored-directories "7.0.1") + +(defun lsp-file-watch-ignored-directories () + lsp-file-watch-ignored-directories) + +;; Allow lsp-file-watch-ignored-directories as a file or directory-local variable +;;;###autoload(put 'lsp-file-watch-ignored-directories 'safe-local-variable 'lsp--string-listp) + +(defcustom lsp-file-watch-ignored-files + '( + ;; Flycheck tempfiles + "[/\\\\]flycheck_[^/\\\\]+\\'" + ;; lockfiles + "[/\\\\]\\.#[^/\\\\]+\\'" + ;; backup files + "[/\\\\][^/\\\\]+~\\'" ) + "List of regexps matching files for which change events will +not be sent to the server. + +This setting has no impact on whether a file-watch is created for +a directory; it merely prevents notifications pertaining to +matched files from being sent to the server. To prevent a +file-watch from being created for a directory, customize +`lsp-file-watch-ignored-directories' + +Customization of this variable is only honored at the global +level or at a root of an lsp workspace." + :group 'lsp-mode + :type '(repeat string) + :package-version '(lsp-mode . "8.0.0")) + +;; Allow lsp-file-watch-ignored-files as a file or directory-local variable +;;;###autoload(put 'lsp-file-watch-ignored-files 'safe-local-variable 'lsp--string-listp) + +(defcustom lsp-after-uninitialized-functions nil + "List of functions to be called after a Language Server has been uninitialized." + :type 'hook + :group 'lsp-mode + :package-version '(lsp-mode . "6.3")) + +(defconst lsp--sync-full 1) +(defconst lsp--sync-incremental 2) + +(defcustom lsp-debounce-full-sync-notifications t + "If non-nil debounce full sync events. +This flag affects only servers which do not support incremental updates." + :type 'boolean + :group 'lsp-mode + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-debounce-full-sync-notifications-interval 1.0 + "Time to wait before sending full sync synchronization after buffer modification." + :type 'float + :group 'lsp-mode + :package-version '(lsp-mode . "6.1")) + +(defvar lsp--stderr-index 0) + +(defvar lsp--delayed-requests nil) +(defvar lsp--delay-timer nil) + +(defcustom lsp-document-sync-method nil + "How to sync the document with the language server." + :type '(choice (const :tag "Documents are synced by always sending the full content of the document." lsp--sync-full) + (const :tag "Documents are synced by always sending incremental changes to the document." lsp--sync-incremental) + (const :tag "Use the method recommended by the language server." nil)) + :group 'lsp-mode) + +(defcustom lsp-auto-execute-action t + "Auto-execute single action." + :type 'boolean + :group 'lsp-mode) + +(defcustom lsp-enable-links t + "If non-nil, all references to links in a file will be made clickable, if +supported by the language server." + :type 'boolean + :group 'lsp-mode + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-enable-imenu t + "If non-nil, automatically enable `imenu' integration when server provides +`textDocument/documentSymbol'." + :type 'boolean + :group 'lsp-mode + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-enable-dap-auto-configure t + "If non-nil, enable `dap-auto-configure-mode`." + :type 'boolean + :group 'lsp-mode + :package-version '(lsp-mode . "7.0")) + +(defcustom lsp-eldoc-enable-hover t + "If non-nil, `eldoc' will display hover info when it is present." + :type 'boolean + :group 'lsp-mode) + +(defcustom lsp-eldoc-render-all nil + "Display all of the info returned by document/onHover. +If this is set to nil, `eldoc' will show only the symbol information." + :type 'boolean + :group 'lsp-mode) + +(define-obsolete-variable-alias 'lsp-enable-completion-at-point + 'lsp-completion-enable "lsp-mode 7.0.1") + +(defcustom lsp-completion-enable t + "Enable `completion-at-point' integration." + :type 'boolean + :group 'lsp-completion) + +(defcustom lsp-enable-symbol-highlighting t + "Highlight references of the symbol at point." + :type 'boolean + :group 'lsp-mode) + +(defcustom lsp-enable-xref t + "Enable xref integration." + :type 'boolean + :group 'lsp-mode) + +(define-obsolete-variable-alias + 'lsp-references-exclude-definition + 'lsp-references-exclude-declaration + "9.0.1") + +(defcustom lsp-references-exclude-declaration nil + "If non-nil, exclude declarations when finding references." + :type 'boolean + :group 'lsp-mode) + +(defcustom lsp-enable-indentation t + "Indent regions using the file formatting functionality provided by the +language server." + :type 'boolean + :group 'lsp-mode) + +(defcustom lsp-enable-on-type-formatting t + "Enable `textDocument/onTypeFormatting' integration." + :type 'boolean + :group 'lsp-mode) + +(defcustom lsp-enable-text-document-color t + "Enable `textDocument/documentColor' integration." + :type 'boolean + :group 'lsp-mode) + +(defcustom lsp-before-save-edits t + "If non-nil, `lsp-mode' will apply edits suggested by the language server +before saving a document." + :type 'boolean + :group 'lsp-mode) + +(defcustom lsp-after-apply-edits-hook nil + "Hooks to run when text edit is applied. +It contains the operation source." + :type 'hook + :group 'lsp-mode + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-apply-edits-after-file-operations t + "Whether to apply edits returned by server after file operations if any. +Applicable only if server supports workspace.fileOperations for operations: +`workspace/willRenameFiles', `workspace/willCreateFiles' and +`workspace/willDeleteFiles'." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-modeline-code-actions-enable t + "Whether to show code actions on modeline." + :type 'boolean + :group 'lsp-modeline) + +(defcustom lsp-modeline-diagnostics-enable t + "Whether to show diagnostics on modeline." + :type 'boolean + :group 'lsp-modeline) + +(defcustom lsp-modeline-workspace-status-enable t + "Whether to show workspace status on modeline." + :type 'boolean + :group 'lsp-modeline + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-headerline-breadcrumb-enable t + "Whether to enable breadcrumb on headerline." + :type 'boolean + :group 'lsp-headerline) + +(defcustom lsp-configure-hook nil + "Hooks to run when `lsp-configure-buffer' is called." + :type 'hook + :group 'lsp-mode) + +(defcustom lsp-unconfigure-hook nil + "Hooks to run when `lsp-unconfig-buffer' is called." + :type 'hook + :group 'lsp-mode) + +(defcustom lsp-after-diagnostics-hook nil + "Hooks to run after diagnostics are received. +Note: it runs only if the receiving buffer is open. Use +`lsp-diagnostics-updated-hook'if you want to be notified when +diagnostics have changed." + :type 'hook + :group 'lsp-mode) + +(define-obsolete-variable-alias 'lsp-after-diagnostics-hook + 'lsp-diagnostics-updated-hook "lsp-mode 6.4") + +(defcustom lsp-diagnostics-updated-hook nil + "Hooks to run after diagnostics are received." + :type 'hook + :group 'lsp-mode) + +(define-obsolete-variable-alias 'lsp-workspace-folders-changed-hook + 'lsp-workspace-folders-changed-functions "lsp-mode 6.3") + +(defcustom lsp-workspace-folders-changed-functions nil + "Hooks to run after the folders has changed. +The hook will receive two parameters list of added and removed folders." + :type 'hook + :group 'lsp-mode) + +(define-obsolete-variable-alias 'lsp-eldoc-hook 'eldoc-documentation-functions "lsp-mode 9.0.0") + +(defcustom lsp-before-apply-edits-hook nil + "Hooks to run before applying edits." + :type 'hook + :group 'lsp-mode) + +(defgroup lsp-imenu nil + "LSP Imenu." + :group 'lsp-mode + :tag "LSP Imenu") + +(defcustom lsp-imenu-show-container-name t + "Display the symbol's container name in an imenu entry." + :type 'boolean + :group 'lsp-imenu) + +(defcustom lsp-imenu-container-name-separator "/" + "Separator string to use to separate the container name from the symbol while +displaying imenu entries." + :type 'string + :group 'lsp-imenu) + +(defcustom lsp-imenu-sort-methods '(kind name) + "How to sort the imenu items. + +The value is a list of `kind' `name' or `position'. Priorities +are determined by the index of the element." + :type '(repeat (choice (const name) + (const position) + (const kind))) + :group 'lsp-imenu) + +(defcustom lsp-imenu-index-symbol-kinds nil + "Which symbol kinds to show in imenu." + :type '(repeat (choice (const :tag "Miscellaneous" nil) + (const :tag "File" File) + (const :tag "Module" Module) + (const :tag "Namespace" Namespace) + (const :tag "Package" Package) + (const :tag "Class" Class) + (const :tag "Method" Method) + (const :tag "Property" Property) + (const :tag "Field" Field) + (const :tag "Constructor" Constructor) + (const :tag "Enum" Enum) + (const :tag "Interface" Interface) + (const :tag "Function" Function) + (const :tag "Variable" Variable) + (const :tag "Constant" Constant) + (const :tag "String" String) + (const :tag "Number" Number) + (const :tag "Boolean" Boolean) + (const :tag "Array" Array) + (const :tag "Object" Object) + (const :tag "Key" Key) + (const :tag "Null" Null) + (const :tag "Enum Member" EnumMember) + (const :tag "Struct" Struct) + (const :tag "Event" Event) + (const :tag "Operator" Operator) + (const :tag "Type Parameter" TypeParameter))) + :group 'lsp-imenu) + +;; vibhavp: Should we use a lower value (5)? +(defcustom lsp-response-timeout 10 + "Number of seconds to wait for a response from the language server before +timing out. Nil if no timeout." + :type '(choice + (number :tag "Seconds") + (const :tag "No timeout" nil)) + :group 'lsp-mode) + +(defcustom lsp-tcp-connection-timeout 2 + "The timeout for tcp connection in seconds." + :type 'number + :group 'lsp-mode + :package-version '(lsp-mode . "6.2")) + +(defconst lsp--imenu-compare-function-alist + (list (cons 'name #'lsp--imenu-compare-name) + (cons 'kind #'lsp--imenu-compare-kind) + (cons 'position #'lsp--imenu-compare-line-col)) + "An alist of (METHOD . FUNCTION). +METHOD is one of the symbols accepted by +`lsp-imenu-sort-methods'. + +FUNCTION takes two hash tables representing DocumentSymbol. It +returns a negative number, 0, or a positive number indicating +whether the first parameter is less than, equal to, or greater +than the second parameter.") + +(defcustom lsp-diagnostic-clean-after-change nil + "When non-nil, clean the diagnostics on change. + +Note that when that setting is nil, `lsp-mode' will show stale +diagnostics until server publishes the new set of diagnostics" + :type 'boolean + :group 'lsp-diagnostics + :package-version '(lsp-mode . "7.0.1")) + +(defcustom lsp-server-trace nil + "Request tracing on the server side. +The actual trace output at each level depends on the language server in use. +Changes take effect only when a new session is started." + :type '(choice (const :tag "Disabled" "off") + (const :tag "Messages only" "messages") + (const :tag "Verbose" "verbose") + (const :tag "Default (disabled)" nil)) + :group 'lsp-mode + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-auto-touch-files t + "If non-nil ensure the files exist before sending +`textDocument/didOpen' notification." + :type 'boolean + :group 'lsp-mode + :package-version '(lsp-mode . "9.0.0")) + +(defvar lsp-language-id-configuration + '(("\\(^CMakeLists\\.txt\\|\\.cmake\\)\\'" . "cmake") + ("\\(^Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'" . "dockerfile") + ("\\.astro$" . "astro") + ("\\.cs\\'" . "csharp") + ("\\.css$" . "css") + ("\\.cypher$" . "cypher") + ("Earthfile" . "earthfile") + ("\\.ebuild$" . "shellscript") + ("\\.go\\'" . "go") + ("\\.html$" . "html") + ("\\.hx$" . "haxe") + ("\\.hy$" . "hy") + ("\\.java\\'" . "java") + ("\\.jq$" . "jq") + ("\\.js$" . "javascript") + ("\\.json$" . "json") + ("\\.jsonc$" . "jsonc") + ("\\.jsonnet$" . "jsonnet") + ("\\.jsx$" . "javascriptreact") + ("\\.lua$" . "lua") + ("\\.fnl$" . "fennel") + ("\\.mdx\\'" . "mdx") + ("\\.nu$" . "nushell") + ("\\.php$" . "php") + ("\\.ps[dm]?1\\'" . "powershell") + ("\\.rs\\'" . "rust") + ("\\.spec\\'" . "rpm-spec") + ("\\.sql$" . "sql") + ("\\.svelte$" . "svelte") + ("\\.toml\\'" . "toml") + ("\\.ts$" . "typescript") + ("\\.tsp$" . "typespec") + ("\\.tsx$" . "typescriptreact") + ("\\.ttcn3$" . "ttcn3") + ("\\.vue$" . "vue") + ("\\.xml$" . "xml") + ("\\ya?ml$" . "yaml") + ("^PKGBUILD$" . "shellscript") + ("^go\\.mod\\'" . "go.mod") + ("^settings\\.json$" . "jsonc") + ("^yang\\.settings$" . "jsonc") + ("^meson\\(_options\\.txt\\|\\.\\(build\\|format\\)\\)\\'" . "meson") + (ada-mode . "ada") + (ada-ts-mode . "ada") + (gpr-mode . "gpr") + (gpr-ts-mode . "gpr") + (awk-mode . "awk") + (awk-ts-mode . "awk") + (nxml-mode . "xml") + (sql-mode . "sql") + (vimrc-mode . "vim") + (vimscript-ts-mode . "vim") + (sh-mode . "shellscript") + (bash-ts-mode . "shellscript") + (ebuild-mode . "shellscript") + (pkgbuild-mode . "shellscript") + (envrc-file-mode . "shellscript") + (scala-mode . "scala") + (scala-ts-mode . "scala") + (julia-mode . "julia") + (julia-ts-mode . "julia") + (clojure-mode . "clojure") + (clojurec-mode . "clojure") + (clojurescript-mode . "clojurescript") + (clojure-ts-mode . "clojure") + (clojure-ts-clojurec-mode . "clojure") + (clojure-ts-clojurescript-mode . "clojurescript") + (java-mode . "java") + (java-ts-mode . "java") + (jdee-mode . "java") + (groovy-mode . "groovy") + (nextflow-mode . "nextflow") + (python-mode . "python") + (python-ts-mode . "python") + (cython-mode . "python") + ("\\(\\.mojo\\|\\.🔥\\)\\'" . "mojo") + (lsp--render-markdown . "markdown") + (move-mode . "move") + (rust-mode . "rust") + (rust-ts-mode . "rust") + (rustic-mode . "rust") + (kotlin-mode . "kotlin") + (kotlin-ts-mode . "kotlin") + (css-mode . "css") + (css-ts-mode . "css") + (less-mode . "less") + (less-css-mode . "less") + (lua-mode . "lua") + (lua-ts-mode . "lua") + (sass-mode . "sass") + (ssass-mode . "sass") + (scss-mode . "scss") + (scad-mode . "openscad") + (xml-mode . "xml") + (c-mode . "c") + (c-ts-mode . "c") + (c++-mode . "cpp") + (c++-ts-mode . "cpp") + (cuda-mode . "cuda") + (objc-mode . "objective-c") + (html-mode . "html") + (html-ts-mode . "html") + (sgml-mode . "html") + (mhtml-mode . "html") + (mint-mode . "mint") + (go-dot-mod-mode . "go.mod") + (go-mod-ts-mode . "go.mod") + (go-mode . "go") + (go-ts-mode . "go") + (graphql-mode . "graphql") + (haskell-mode . "haskell") + (haskell-ts-mode . "haskell") + (hack-mode . "hack") + (php-mode . "php") + (php-ts-mode . "php") + (powershell-mode . "powershell") + (powershell-mode . "PowerShell") + (powershell-ts-mode . "powershell") + (json-mode . "json") + (json-ts-mode . "json") + (jsonc-mode . "jsonc") + (rjsx-mode . "javascript") + (js2-mode . "javascript") + (js-mode . "javascript") + (js-ts-mode . "javascript") + (typescript-mode . "typescript") + (typescript-ts-mode . "typescript") + (typespec-mode . "typespec") + (tsx-ts-mode . "typescriptreact") + (svelte-mode . "svelte") + (fsharp-mode . "fsharp") + (reason-mode . "reason") + (caml-mode . "ocaml") + (tuareg-mode . "ocaml") + (futhark-mode . "futhark") + (swift-mode . "swift") + (elixir-mode . "elixir") + (elixir-ts-mode . "elixir") + (heex-ts-mode . "elixir") + (conf-javaprop-mode . "spring-boot-properties") + (yaml-mode . "yaml") + (yaml-ts-mode . "yaml") + (ruby-mode . "ruby") + (enh-ruby-mode . "ruby") + (ruby-ts-mode . "ruby") + (feature-mode . "cucumber") + (fortran-mode . "fortran") + (f90-mode . "fortran") + (elm-mode . "elm") + (dart-mode . "dart") + (erlang-mode . "erlang") + (dockerfile-mode . "dockerfile") + (dockerfile-ts-mode . "dockerfile") + (csharp-mode . "csharp") + (csharp-tree-sitter-mode . "csharp") + (csharp-ts-mode . "csharp") + (plain-tex-mode . "plaintex") + (context-mode . "context") + (cypher-mode . "cypher") + (latex-mode . "latex") + (LaTeX-mode . "latex") + (v-mode . "v") + (vhdl-mode . "vhdl") + (vhdl-ts-mode . "vhdl") + (verilog-mode . "verilog") + (terraform-mode . "terraform") + (ess-julia-mode . "julia") + (ess-r-mode . "r") + (crystal-mode . "crystal") + (nim-mode . "nim") + (dhall-mode . "dhall") + (cmake-mode . "cmake") + (cmake-ts-mode . "cmake") + (purescript-mode . "purescript") + (gdscript-mode . "gdscript") + (gdscript-ts-mode . "gdscript") + (perl-mode . "perl") + (cperl-mode . "perl") + (robot-mode . "robot") + (racket-mode . "racket") + (nix-mode . "nix") + (nix-ts-mode . "nix") + (prolog-mode . "prolog") + (vala-mode . "vala") + (actionscript-mode . "actionscript") + (d-mode . "d") + (zig-mode . "zig") + (zig-ts-mode . "zig") + (text-mode . "plaintext") + (markdown-mode . "markdown") + (gfm-mode . "markdown") + (beancount-mode . "beancount") + (conf-toml-mode . "toml") + (toml-ts-mode . "toml") + (org-mode . "org") + (org-journal-mode . "org") + (nginx-mode . "nginx") + (magik-mode . "magik") + (magik-ts-mode . "magik") + (idris-mode . "idris") + (idris2-mode . "idris2") + (gleam-mode . "gleam") + (gleam-ts-mode . "gleam") + (graphviz-dot-mode . "dot") + (tiltfile-mode . "tiltfile") + (solidity-mode . "solidity") + (bibtex-mode . "bibtex") + (rst-mode . "restructuredtext") + (glsl-mode . "glsl") + (shader-mode . "shaderlab") + (wgsl-mode . "wgsl") + (jq-mode . "jq") + (jq-ts-mode . "jq") + (protobuf-mode . "protobuf") + (nushell-mode . "nushell") + (nushell-ts-mode . "nushell") + (meson-mode . "meson") + (yang-mode . "yang")) + "Language id configuration.") + +(defvar lsp--last-active-workspaces nil + "Keep track of last active workspace. +We want to try the last workspace first when jumping into a library +directory") + +(defvar lsp-method-requirements + '(("textDocument/callHierarchy" :capability :callHierarchyProvider) + ("textDocument/codeAction" :capability :codeActionProvider) + ("codeAction/resolve" + :check-command (lambda (workspace) + (with-lsp-workspace workspace + (lsp:code-action-options-resolve-provider? + (lsp--capability-for-method "textDocument/codeAction"))))) + ("textDocument/codeLens" :capability :codeLensProvider) + ("textDocument/completion" :capability :completionProvider) + ("completionItem/resolve" + :check-command (lambda (wk) + (with-lsp-workspace wk + (lsp:completion-options-resolve-provider? + (lsp--capability-for-method "textDocument/completion"))))) + ("textDocument/declaration" :capability :declarationProvider) + ("textDocument/definition" :capability :definitionProvider) + ("textDocument/documentColor" :capability :colorProvider) + ("textDocument/documentLink" :capability :documentLinkProvider) + ("textDocument/inlayHint" :capability :inlayHintProvider) + ("textDocument/documentHighlight" :capability :documentHighlightProvider) + ("textDocument/documentSymbol" :capability :documentSymbolProvider) + ("textDocument/foldingRange" :capability :foldingRangeProvider) + ("textDocument/formatting" :capability :documentFormattingProvider) + ("textDocument/hover" :capability :hoverProvider) + ("textDocument/implementation" :capability :implementationProvider) + ("textDocument/linkedEditingRange" :capability :linkedEditingRangeProvider) + ("textDocument/onTypeFormatting" :capability :documentOnTypeFormattingProvider) + ("textDocument/prepareRename" + :check-command (lambda (workspace) + (with-lsp-workspace workspace + (lsp:rename-options-prepare-provider? + (lsp--capability-for-method "textDocument/rename"))))) + ("textDocument/rangeFormatting" :capability :documentRangeFormattingProvider) + ("textDocument/references" :capability :referencesProvider) + ("textDocument/rename" :capability :renameProvider) + ("textDocument/selectionRange" :capability :selectionRangeProvider) + ("textDocument/semanticTokens" :capability :semanticTokensProvider) + ("textDocument/semanticTokensFull" + :check-command (lambda (workspace) + (with-lsp-workspace workspace + (lsp-get (lsp--capability :semanticTokensProvider) :full)))) + ("textDocument/semanticTokensFull/Delta" + :check-command (lambda (workspace) + (with-lsp-workspace workspace + (let ((capFull (lsp-get (lsp--capability :semanticTokensProvider) :full))) + (and (not (booleanp capFull)) (lsp-get capFull :delta)))))) + ("textDocument/semanticTokensRangeProvider" + :check-command (lambda (workspace) + (with-lsp-workspace workspace + (lsp-get (lsp--capability :semanticTokensProvider) :range)))) + ("textDocument/signatureHelp" :capability :signatureHelpProvider) + ("textDocument/typeDefinition" :capability :typeDefinitionProvider) + ("textDocument/typeHierarchy" :capability :typeHierarchyProvider) + ("textDocument/diagnostic" :capability :diagnosticProvider) + ("workspace/executeCommand" :capability :executeCommandProvider) + ("workspace/symbol" :capability :workspaceSymbolProvider)) + + "Map methods to requirements. +It is used by request-sending functions to determine which server +must be used for handling a particular message.") + +(defconst lsp--file-change-type + `((created . 1) + (changed . 2) + (deleted . 3))) + +(defconst lsp--watch-kind + `((create . 1) + (change . 2) + (delete . 4))) + +(defvar lsp-window-body-width 40 + "Window body width when rendering doc.") + +(defface lsp-face-highlight-textual + '((t :inherit highlight)) + "Face used for textual occurrences of symbols." + :group 'lsp-mode) + +(defface lsp-face-highlight-read + '((t :inherit highlight :underline t)) + "Face used for highlighting symbols being read." + :group 'lsp-mode) + +(defface lsp-face-highlight-write + '((t :inherit highlight :weight bold)) + "Face used for highlighting symbols being written to." + :group 'lsp-mode) + +(define-obsolete-variable-alias 'lsp-lens-auto-enable + 'lsp-lens-enable "lsp-mode 7.0.1") + +(defcustom lsp-lens-enable t + "Auto enable lenses if server supports." + :group 'lsp-lens + :type 'boolean + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-symbol-highlighting-skip-current nil + "If non-nil skip current symbol when setting symbol highlights." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-file-watch-threshold 1000 + "Show warning if the files to watch are more than. +Set to nil to disable the warning." + :type 'number + :group 'lsp-mode) +;;;###autoload(put 'lsp-file-watch-threshold 'safe-local-variable (lambda (i) (or (numberp i) (not i)))) + +(defvar lsp-custom-markup-modes + '((rust-mode "no_run" "rust,no_run" "rust,ignore" "rust,should_panic")) + "Mode to uses with markdown code blocks. +They are added to `markdown-code-lang-modes'") + +(defcustom lsp-signature-render-documentation t + "Display signature documentation in `eldoc'." + :type 'boolean + :group 'lsp-mode + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-signature-auto-activate '(:on-trigger-char :on-server-request) + "Auto activate signature conditions." + :type '(repeat (choice (const :tag "On trigger chars pressed." :on-trigger-char) + (const :tag "After selected completion." :after-completion) + (const :tag "When the server has sent show signature help." :on-server-request))) + :group 'lsp-mode + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-signature-doc-lines 20 + "If number, limit the number of lines to show in the docs." + :type 'number + :group 'lsp-mode + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-signature-function 'lsp-lv-message + "The function used for displaying signature info. +It will be called with one param - the signature info. When +called with nil the signature info must be cleared." + :type 'function + :group 'lsp-mode + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-keymap-prefix "s-l" + "LSP-mode keymap prefix." + :group 'lsp-mode + :type 'string + :package-version '(lsp-mode . "6.3")) + +(defvar-local lsp--buffer-workspaces () + "List of the buffer workspaces.") + +(defvar-local lsp--buffer-deferred nil + "Whether buffer was loaded via `lsp-deferred'.") + +(defvar lsp--session nil + "Contain the `lsp-session' for the current Emacs instance.") + +(defvar lsp--tcp-port 10000) + +(defvar lsp--client-packages-required nil + "If nil, `lsp-client-packages' are yet to be required.") + +(defvar lsp--tcp-server-port 0 + "The server socket which is opened when using `lsp-tcp-server' (a server +socket is opened in Emacs and the language server connects to it). The +default value of 0 ensures that a random high port is used. Set it to a positive +integer to use a specific port.") + +(defvar lsp--tcp-server-wait-seconds 10 + "Wait this amount of time for the client to connect to our server socket +when using `lsp-tcp-server'.") + +(defvar-local lsp--document-symbols nil + "The latest document symbols.") + +(defvar-local lsp--document-selection-range-cache nil + "The document selection cache.") + +(defvar-local lsp--document-symbols-request-async nil + "If non-nil, request document symbols asynchronously.") + +(defvar-local lsp--document-symbols-tick -1 + "The value of `buffer-chars-modified-tick' when document + symbols were last retrieved.") + +(defvar-local lsp--have-document-highlights nil + "Set to `t' on symbol highlighting, cleared on +`lsp--cleanup-highlights-if-needed'. Checking a separately +defined flag is substantially faster than unconditionally +calling `remove-overlays'.") + +;; Buffer local variable for storing number of lines. +(defvar lsp--log-lines) + +(defvar-local lsp--eldoc-saved-message nil) + +(defvar lsp--on-change-timer nil) +(defvar lsp--on-idle-timer nil) + +(defvar-local lsp--signature-last nil) +(defvar-local lsp--signature-last-index nil) +(defvar lsp--signature-last-buffer nil) + +(defvar-local lsp--virtual-buffer-point-max nil) + +(cl-defmethod lsp-execute-command (_server _command _arguments) + "Ask SERVER to execute COMMAND with ARGUMENTS.") + +(defun lsp-elt (sequence n) + "Return Nth element of SEQUENCE or nil if N is out of range." + (cond + ((listp sequence) (elt sequence n)) + ((arrayp sequence) + (and (> (length sequence) n) (aref sequence n))) + (t (and (> (length sequence) n) (elt sequence n))))) + +;; define seq-first and seq-rest for older emacs +(defun lsp-seq-first (sequence) + "Return the first element of SEQUENCE." + (lsp-elt sequence 0)) + +(defun lsp-seq-rest (sequence) + "Return a sequence of the elements of SEQUENCE except the first one." + (seq-drop sequence 1)) + +;;;###autoload +(defun lsp--string-listp (sequence) + "Return t if all elements of SEQUENCE are strings, else nil." + (not (seq-find (lambda (x) (not (stringp x))) sequence))) + +(defun lsp--string-vector-p (candidate) + "Returns true if CANDIDATE is a vector data structure and +every element of it is of type string, else nil." + (and + (vectorp candidate) + (seq-every-p #'stringp candidate))) + +(make-obsolete 'lsp--string-vector-p nil "lsp-mode 8.0.0") + +(defun lsp--editable-vector-match (widget value) + "Function for `lsp-editable-vector' :match." + ;; Value must be a list or a vector and all the members must match the type. + (and (or (listp value) (vectorp value)) + (length (cdr (lsp--editable-vector-match-inline widget value))))) + +(defun lsp--editable-vector-match-inline (widget value) + "Value for `lsp-editable-vector' :match-inline." + (let ((type (nth 0 (widget-get widget :args))) + (ok t) + found) + (while (and value ok) + (let ((answer (widget-match-inline type value))) + (if answer + (let ((head (if (vectorp answer) (aref answer 0) (car answer))) + (tail (if (vectorp answer) (seq-drop 1 answer) (cdr answer)))) + (setq found (append found head) + value tail)) + (setq ok nil)))) + (cons found value))) + +(defun lsp--editable-vector-value-to-external (_widget internal-value) + "Convert the internal list value to a vector." + (if (listp internal-value) + (apply 'vector internal-value) + internal-value)) + +(defun lsp--editable-vector-value-to-internal (_widget external-value) + "Convert the external vector value to a list." + (if (vectorp external-value) + (append external-value nil) + external-value)) + +(define-widget 'lsp--editable-vector 'editable-list + "A subclass of `editable-list' that accepts and returns a +vector instead of a list." + :value-to-external 'lsp--editable-vector-value-to-external + :value-to-internal 'lsp--editable-vector-value-to-internal + :match 'lsp--editable-vector-match + :match-inline 'lsp--editable-vector-match-inline) + +(define-widget 'lsp-repeatable-vector 'lsp--editable-vector + "A variable length homogeneous vector." + :tag "Repeat" + :format "%{%t%}:\n%v%i\n") + +(define-widget 'lsp-string-vector 'lazy + "A vector of zero or more elements, every element of which is a string. +Appropriate for any language-specific `defcustom' that needs to +serialize as a JSON array of strings. + +Deprecated. Use `lsp-repeatable-vector' instead. " + :offset 4 + :tag "Vector" + :type '(lsp-repeatable-vector string)) + +(make-obsolete 'lsp-string-vector nil "lsp-mode 8.0.0") + +(defvar lsp--show-message t + "If non-nil, show debug message from `lsp-mode'.") + +(defun lsp--message (format &rest args) + "Wrapper for `message' + +We `inhibit-message' the message when the cursor is in the +minibuffer and when emacs version is before emacs 27 due to the +fact that we often use `lsp--info', `lsp--warn' and `lsp--error' +in async context and the call to these function is removing the +minibuffer prompt. The issue with async messages is already fixed +in emacs 27. + +See #2049" + (when lsp--show-message + (let ((inhibit-message (or inhibit-message + (and (minibufferp) + (version< emacs-version "27.0"))))) + (apply #'message format args)))) + +(defun lsp--info (format &rest args) + "Display lsp info message with FORMAT with ARGS." + (lsp--message "%s :: %s" (propertize "LSP" 'face 'success) (apply #'format format args))) + +(defun lsp--warn (format &rest args) + "Display lsp warn message with FORMAT with ARGS." + (lsp--message "%s :: %s" (propertize "LSP" 'face 'warning) (apply #'format format args))) + +(defun lsp--error (format &rest args) + "Display lsp error message with FORMAT with ARGS." + (lsp--message "%s :: %s" (propertize "LSP" 'face 'error) (apply #'format format args))) + +(defun lsp-log (format &rest args) + "Log message to the ’*lsp-log*’ buffer. + +FORMAT and ARGS i the same as for `message'." + (when lsp-log-max + (let ((log-buffer (get-buffer "*lsp-log*")) + (inhibit-read-only t)) + (unless log-buffer + (setq log-buffer (get-buffer-create "*lsp-log*")) + (with-current-buffer log-buffer + (buffer-disable-undo) + (view-mode 1) + (set (make-local-variable 'lsp--log-lines) 0))) + (with-current-buffer log-buffer + (save-excursion + (let* ((message (apply 'format format args)) + ;; Count newlines in message. + (newlines (1+ (cl-loop with start = 0 + for count from 0 + while (string-match "\n" message start) + do (setq start (match-end 0)) + finally return count)))) + (goto-char (point-max)) + + ;; in case the buffer is not empty insert before last \n to preserve + ;; the point position(in case it is in the end) + (if (eq (point) (point-min)) + (progn + (insert "\n") + (backward-char)) + (backward-char) + (insert "\n")) + (insert message) + + (setq lsp--log-lines (+ lsp--log-lines newlines)) + + (when (and (integerp lsp-log-max) (> lsp--log-lines lsp-log-max)) + (let ((to-delete (- lsp--log-lines lsp-log-max))) + (goto-char (point-min)) + (forward-line to-delete) + (delete-region (point-min) (point)) + (setq lsp--log-lines lsp-log-max))))))))) + +(defalias 'lsp-message 'lsp-log) + +(defalias 'lsp-ht 'ht) + +(defalias 'lsp-file-local-name 'file-local-name) + +(defun lsp-f-canonical (file-name) + "Return the canonical FILE-NAME, without a trailing slash." + (directory-file-name (expand-file-name file-name))) + +(defalias 'lsp-canonical-file-name 'lsp-f-canonical) + +(defun lsp-f-same? (path-a path-b) + "Return t if PATH-A and PATH-B are references to the same file. +Symlinks are not followed." + (when (and (f-exists? path-a) + (f-exists? path-b)) + (equal + (lsp-f-canonical (directory-file-name (f-expand path-a))) + (lsp-f-canonical (directory-file-name (f-expand path-b)))))) + +(defun lsp-f-parent (path) + "Return the parent directory to PATH. +Symlinks are not followed." + (let ((parent (file-name-directory + (directory-file-name (f-expand path default-directory))))) + (unless (lsp-f-same? path parent) + (if (f-relative? path) + (f-relative parent) + (directory-file-name parent))))) + +(defun lsp-f-ancestor-of? (path-a path-b) + "Return t if PATH-A is an ancestor of PATH-B. +Symlinks are not followed." + (unless (lsp-f-same? path-a path-b) + (s-prefix? (concat (lsp-f-canonical path-a) (f-path-separator)) + (lsp-f-canonical path-b)))) + +(defun lsp--merge-results (results method) + "Merge RESULTS by filtering the empty hash-tables and merging +the lists according to METHOD." + (pcase (--map (if (vectorp it) + (append it nil) it) + (-filter #'identity results)) + (`() ()) + ;; only one result - simply return it + (`(,fst) fst) + ;; multiple results merge it based on strategy + (results + (pcase method + ("textDocument/hover" (pcase (seq-filter + (-compose #'not #'lsp-empty?) + results) + (`(,hover) hover) + (hovers (lsp-make-hover + :contents + (-mapcat + (-lambda ((&Hover :contents)) + (if (and (sequencep contents) + (not (stringp contents))) + (append contents ()) + (list contents))) + hovers))))) + ("textDocument/completion" + (lsp-make-completion-list + :is-incomplete (seq-some + #'lsp:completion-list-is-incomplete + results) + :items (cl-mapcan (lambda (it) (append (if (lsp-completion-list? it) + (lsp:completion-list-items it) + it) + nil)) + results))) + ("completionItem/resolve" + (let ((item (cl-first results))) + (when-let* ((details (seq-filter #'identity + (seq-map #'lsp:completion-item-detail? results)))) + (lsp:set-completion-item-detail? + item + (string-join details " "))) + (when-let* ((docs (seq-filter #'identity + (seq-map #'lsp:completion-item-documentation? results)))) + (lsp:set-completion-item-documentation? + item + (lsp-make-markup-content + :kind (or (seq-some (lambda (it) + (when (equal (lsp:markup-content-kind it) + lsp/markup-kind-markdown) + lsp/markup-kind-markdown)) + docs) + lsp/markup-kind-plain-text) + :value (string-join (seq-map (lambda (doc) + (or (lsp:markup-content-value doc) + (and (stringp doc) doc))) + docs) + "\n")))) + (when-let* ((edits (seq-filter #'identity + (seq-map #'lsp:completion-item-additional-text-edits? results)))) + (lsp:set-completion-item-additional-text-edits? + item + (cl-mapcan (lambda (it) (if (seqp it) it (list it))) edits))) + item)) + (_ (cl-mapcan (lambda (it) (if (seqp it) it (list it))) results)))))) + +(defun lsp--spinner-start () + "Start spinner indication." + (condition-case _err (spinner-start (lsp-progress-spinner-type)) (error))) + +(defun lsp--propertize (str type) + "Propertize STR as per TYPE." + (propertize str 'face (alist-get type lsp--message-type-face))) + +(defun lsp-workspaces () + "Return the lsp workspaces associated with the current project." + (if lsp--cur-workspace (list lsp--cur-workspace) lsp--buffer-workspaces)) + +(defun lsp--completing-read (prompt collection transform-fn &optional predicate + require-match initial-input + hist def inherit-input-method) + "Wrap `completing-read' to provide transformation function and disable sort. + +TRANSFORM-FN will be used to transform each of the items before displaying. + +PROMPT COLLECTION PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF +INHERIT-INPUT-METHOD will be proxied to `completing-read' without changes." + (let* ((col (--map (cons (funcall transform-fn it) it) collection)) + (completion (completing-read prompt + (lambda (string pred action) + (if (eq action 'metadata) + `(metadata (display-sort-function . identity)) + (complete-with-action action col string pred))) + predicate require-match initial-input hist + def inherit-input-method))) + (cdr (assoc completion col)))) + +(defconst lsp--system-arch (lambda () + (setq lsp--system-arch + (pcase system-type + ('windows-nt + (pcase system-configuration + ((rx bol "x86_64-") 'x64) + (_ 'x86))) + ('darwin + (pcase system-configuration + ((rx "aarch64-") 'arm64) + (_ 'x64))) + ('gnu/linux + (pcase system-configuration + ((rx bol "aarch64-") 'arm64) + ((rx bol "x86_64") 'x64) + ((rx bol (| "i386" "i886")) 'x32))) + (_ + (pcase system-configuration + ((rx bol "x86_64") 'x64) + ((rx bol (| "i386" "i886")) 'x32)))))) + "Return the system architecture of `Emacs'. +Special values: + `x64' 64bit + `x32' 32bit + `arm64' ARM 64bit") + +(defmacro lsp-with-current-buffer (buffer-id &rest body) + (declare (indent 1) (debug t)) + `(if-let* ((wcb (plist-get ,buffer-id :with-current-buffer))) + (with-lsp-workspaces (plist-get ,buffer-id :workspaces) + (funcall wcb (lambda () ,@body))) + (with-current-buffer ,buffer-id + ,@body))) + +(defvar lsp--throw-on-input nil + "Make `lsp-*-while-no-input' throws `input' on interrupted.") + +(defmacro lsp--catch (tag bodyform &rest handlers) + "Catch TAG thrown in BODYFORM. +The return value from TAG will be handled in HANDLERS by `pcase'." + (declare (debug (form form &rest (pcase-PAT body))) (indent 2)) + (let ((re-sym (make-symbol "re"))) + `(let ((,re-sym (catch ,tag ,bodyform))) + (pcase ,re-sym + ,@handlers)))) + +(defmacro lsp--while-no-input (&rest body) + "Wrap BODY in `while-no-input' and respecting `non-essential'. +If `lsp--throw-on-input' is set, will throw if input is pending, else +return value of `body' or nil if interrupted." + (declare (debug t) (indent 0)) + `(if non-essential + (let ((res (while-no-input ,@body))) + (cond + ((and lsp--throw-on-input (equal res t)) + (throw 'input :interrupted)) + ((booleanp res) nil) + (t res))) + ,@body)) + +;; A ‘lsp--client’ object describes the client-side behavior of a language +;; server. It is used to start individual server processes, each of which is +;; represented by a ‘lsp--workspace’ object. Client objects are normally +;; created using ‘lsp-define-stdio-client’ or ‘lsp-define-tcp-client’. Each +;; workspace refers to exactly one client, but there can be multiple workspaces +;; for a single client. +(cl-defstruct lsp--client + ;; ‘language-id’ is a function that receives a buffer as a single argument + ;; and should return the language identifier for that buffer. See + ;; https://microsoft.github.io/language-server-protocol/specification#textdocumentitem + ;; for a list of language identifiers. Also consult the documentation for + ;; the language server represented by this client to find out what language + ;; identifiers it supports or expects. + (language-id nil) + + ;; ‘add-on?’ when set to t the server will be started no matter whether there + ;; is another server handling the same mode. + (add-on? nil) + ;; ‘new-connection’ is a function that should start a language server process + ;; and return a cons (COMMAND-PROCESS . COMMUNICATION-PROCESS). + ;; COMMAND-PROCESS must be a process object representing the server process + ;; just started. COMMUNICATION-PROCESS must be a process (including pipe and + ;; network processes) that ‘lsp-mode’ uses to communicate with the language + ;; server using the language server protocol. COMMAND-PROCESS and + ;; COMMUNICATION-PROCESS may be the same process; in that case + ;; ‘new-connection’ may also return that process as a single + ;; object. ‘new-connection’ is called with two arguments, FILTER and + ;; SENTINEL. FILTER should be used as process filter for + ;; COMMUNICATION-PROCESS, and SENTINEL should be used as process sentinel for + ;; COMMAND-PROCESS. + (new-connection nil) + + ;; ‘ignore-regexps’ is a list of regexps. When a data packet from the + ;; language server matches any of these regexps, it will be ignored. This is + ;; intended for dealing with language servers that output non-protocol data. + (ignore-regexps nil) + + ;; ‘ignore-messages’ is a list of regexps. When a message from the language + ;; server matches any of these regexps, it will be ignored. This is useful + ;; for filtering out unwanted messages; such as servers that send nonstandard + ;; message types, or extraneous log messages. + (ignore-messages nil) + + ;; ‘notification-handlers’ is a hash table mapping notification method names + ;; (strings) to functions handling the respective notifications. Upon + ;; receiving a notification, ‘lsp-mode’ will call the associated handler + ;; function passing two arguments, the ‘lsp--workspace’ object and the + ;; deserialized notification parameters. + (notification-handlers (make-hash-table :test 'equal)) + + ;; ‘request-handlers’ is a hash table mapping request method names + ;; (strings) to functions handling the respective notifications. Upon + ;; receiving a request, ‘lsp-mode’ will call the associated handler function + ;; passing two arguments, the ‘lsp--workspace’ object and the deserialized + ;; request parameters. + (request-handlers (make-hash-table :test 'equal)) + + ;; ‘response-handlers’ is a hash table mapping integral JSON-RPC request + ;; identifiers for pending asynchronous requests to functions handling the + ;; respective responses. Upon receiving a response from the language server, + ;; ‘lsp-mode’ will call the associated response handler function with a + ;; single argument, the deserialized response parameters. + (response-handlers (make-hash-table :test 'eql)) + + ;; ‘prefix-function’ is called for getting the prefix for completion. + ;; The function takes no parameter and returns a cons (start . end) representing + ;; the start and end bounds of the prefix. If it's not set, the client uses a + ;; default prefix function." + (prefix-function nil) + + ;; Contains mapping of scheme to the function that is going to be used to load + ;; the file. + (uri-handlers (make-hash-table :test #'equal)) + + ;; ‘action-handlers’ is a hash table mapping action to a handler function. It + ;; can be used in `lsp-execute-code-action' to determine whether the action + ;; current client is interested in executing the action instead of sending it + ;; to the server. + (action-handlers (make-hash-table :test 'equal)) + + ;; `action-filter' can be set to a function that modifies any incoming + ;; `CodeAction' in place before it is executed. The return value is ignored. + ;; This can be used to patch up broken code action requests before they are + ;; sent back to the LSP server. See `lsp-fix-code-action-booleans' for an + ;; example of a function that can be useful here. + (action-filter nil) + + ;; major modes supported by the client. + major-modes + ;; Function that will be called to decide if this language client + ;; should manage a particular buffer. The function will be passed + ;; the file name and major mode to inform the decision. Setting + ;; `activation-fn' will override `major-modes', if + ;; present. + activation-fn + ;; Break the tie when major-mode is supported by multiple clients. + (priority 0) + ;; Unique identifier for representing the client object. + server-id + ;; defines whether the client supports multi root workspaces. + multi-root + ;; Initialization options or a function that returns initialization options. + initialization-options + ;; `semantic-tokens-faces-overrides’ is a plist that can be used to extend, or + ;; completely replace, the faces used for semantic highlighting on a + ;; client-by-client basis. + ;; + ;; It recognizes four members, all of which are optional: `:types’ and + ;; `:modifiers’, respectively, should be face definition lists akin to + ;; `:lsp-semantic-token-faces’. If specified, each of these face lists will be + ;; merged with the default face definition list. + ;; + ;; Alternatively, if the plist members `:discard-default-types’ or + ;; `:discard-default-modifiers' are non-nil, the default `:type' or `:modifiers' + ;; face definitions will be replaced entirely by their respective overrides. + ;; + ;; For example, setting `:semantic-tokens-faces-overrides' to + ;; `(:types (("macro" . font-lock-keyword-face)))' will remap "macro" tokens from + ;; their default face `lsp-face-semhl-macro' to `font-lock-keyword-face'. + ;; + ;; `(:types (("macro" . font-lock-keyword-face) ("not-quite-a-macro" . some-face)))' + ;; will also remap "macro", but on top of that associate the fictional token type + ;; "not-quite-a-macro" with the face named `some-face'. + ;; + ;; `(:types (("macro" . font-lock-keyword-face)) + ;; :modifiers (("declaration" . lsp-face-semhl-interface)) + ;; :discard-default-types t + ;; :discard-default-modifiers t)' + ;; will discard all default face definitions, hence leaving the client with + ;; only one token type "macro", mapped to `font-lock-keyword-face', and one + ;; modifier type "declaration", mapped to `lsp-face-semhl-interface'. + semantic-tokens-faces-overrides + ;; Provides support for registering LSP Server specific capabilities. + custom-capabilities + ;; Function which returns the folders that are considered to be not projects but library files. + ;; The function accepts one parameter currently active workspace. + ;; See: https://github.com/emacs-lsp/lsp-mode/issues/225. + library-folders-fn + ;; function which will be called when opening file in the workspace to perform + ;; client specific initialization. The function accepts one parameter + ;; currently active workspace. + before-file-open-fn + ;; Function which will be called right after a workspace has been initialized. + initialized-fn + ;; ‘remote?’ indicate whether the client can be used for LSP server over TRAMP. + (remote? nil) + + ;; ‘completion-in-comments?’ t if the client supports completion in comments. + (completion-in-comments? nil) + + ;; ‘path->uri-fn’ the function to use for path->uri conversion for the client. + (path->uri-fn nil) + + ;; ‘uri->path-fn’ the function to use for uri->path conversion for the client. + (uri->path-fn nil) + ;; Function that returns an environment structure that will be used + ;; to set some environment variables when starting the language + ;; server process. These environment variables enable some + ;; additional features in the language server. The environment + ;; structure is an alist of the form (KEY . VALUE), where KEY is a + ;; string (regularly in all caps), and VALUE may be a string, a + ;; boolean, or a sequence of strings. + environment-fn + + ;; ‘after-open-fn’ workspace after open specific hooks. + (after-open-fn nil) + + ;; ‘async-request-handlers’ is a hash table mapping request method names + ;; (strings) to functions handling the respective requests that may take + ;; time to finish. Upon receiving a request, ‘lsp-mode’ will call the + ;; associated handler function passing three arguments, the ‘lsp--workspace’ + ;; object, the deserialized request parameters and the callback which accept + ;; result as its parameter. + (async-request-handlers (make-hash-table :test 'equal)) + download-server-fn + download-in-progress? + buffers + synchronize-sections) + +(defun lsp-clients-executable-find (find-command &rest args) + "Finds an executable by invoking a search command. + +FIND-COMMAND is the executable finder that searches for the +actual language server executable. ARGS is a list of arguments to +give to FIND-COMMAND to find the language server. Returns the +output of FIND-COMMAND if it exits successfully, nil otherwise. + +Typical uses include finding an executable by invoking `find' in +a project, finding LLVM commands on macOS with `xcrun', or +looking up project-specific language servers for projects written +in the various dynamic languages, e.g. `nvm', `pyenv' and `rbenv' +etc." + (when-let* ((find-command-path (executable-find find-command)) + (executable-path + (with-temp-buffer + (when (zerop (apply 'call-process find-command-path nil t nil args)) + (buffer-substring-no-properties (point-min) (point-max)))))) + (string-trim executable-path))) + +(defvar lsp--already-widened nil) + +(defmacro lsp-save-restriction-and-excursion (&rest form) + (declare (indent 0) (debug t)) + `(if lsp--already-widened + (save-excursion ,@form) + (-let [lsp--already-widened t] + (save-restriction + (widen) + (save-excursion ,@form))))) + +;; from http://emacs.stackexchange.com/questions/8082/how-to-get-buffer-position-given-line-number-and-column-number +(defun lsp--line-character-to-point (line character) + "Return the point for character CHARACTER on line LINE." + (or (lsp-virtual-buffer-call :line/character->point line character) + (let ((inhibit-field-text-motion t)) + (lsp-save-restriction-and-excursion + (goto-char (point-min)) + (forward-line line) + ;; server may send character position beyond the current line and we + ;; should fallback to line end. + (-let [line-end (line-end-position)] + (if (> character (- line-end (point))) + line-end + (forward-char character) + (point))))))) + +(lsp-defun lsp--position-to-point ((&Position :line :character)) + "Convert `Position' object in PARAMS to a point." + (lsp--line-character-to-point line character)) + +(lsp-defun lsp--range-to-region ((&RangeToPoint :start :end)) + (cons start end)) + +(lsp-defun lsp--range-text ((&RangeToPoint :start :end)) + (buffer-substring start end)) + +(lsp-defun lsp--find-wrapping-range ((&SelectionRange :parent? :range (&RangeToPoint :start :end))) + (cond + ((and + (region-active-p) + (<= start (region-beginning) end) + (<= start (region-end) end) + (or (not (= start (region-beginning))) + (not (= end (region-end))))) + (cons start end)) + ((and (<= start (point) end) + (not (region-active-p))) + (cons start end)) + (parent? (lsp--find-wrapping-range parent?)))) + +(defun lsp--get-selection-range () + (or + (-when-let ((cache . cache-tick) lsp--document-selection-range-cache) + (when (= cache-tick (buffer-modified-tick)) cache)) + (let ((response (cl-first + (lsp-request + "textDocument/selectionRange" + (list :textDocument (lsp--text-document-identifier) + :positions (vector (lsp--cur-position))))))) + (setq lsp--document-selection-range-cache + (cons response (buffer-modified-tick))) + response))) + +(defun lsp-extend-selection () + "Extend selection." + (interactive) + (unless (lsp-feature? "textDocument/selectionRange") + (signal 'lsp-capability-not-supported (list "selectionRangeProvider"))) + (-when-let ((start . end) (lsp--find-wrapping-range (lsp--get-selection-range))) + (goto-char start) + (set-mark (point)) + (goto-char end) + (exchange-point-and-mark))) + +(defun lsp-warn (message &rest args) + "Display a warning message made from (`format-message' MESSAGE ARGS...). +This is equivalent to `display-warning', using `lsp-mode' as the type and +`:warning' as the level." + (display-warning 'lsp-mode (apply #'format-message message args))) + +(defun lsp--get-uri-handler (scheme) + "Get uri handler for SCHEME in the current workspace." + (--some (gethash scheme (lsp--client-uri-handlers (lsp--workspace-client it))) + (or (lsp-workspaces) (lsp--session-workspaces (lsp-session))))) + +(defun lsp--fix-path-casing (path) + "On windows, downcases path because the windows file system is +case-insensitive. + +On other systems, returns path without change." + (if (eq system-type 'windows-nt) (downcase path) path)) + +(defun lsp--uri-to-path (uri) + "Convert URI to a file path." + (if-let* ((fn (->> (lsp-workspaces) + (-keep (-compose #'lsp--client-uri->path-fn #'lsp--workspace-client)) + (cl-first)))) + (funcall fn uri) + (lsp--uri-to-path-1 uri))) + +(defun lsp-remap-path-if-needed (file-name) + (-if-let ((virtual-buffer &as &plist :buffer) (gethash file-name lsp--virtual-buffer-mappings)) + (propertize (buffer-local-value 'buffer-file-name buffer) + 'lsp-virtual-buffer virtual-buffer) + file-name)) + +(defun lsp--uri-to-path-1 (uri) + "Convert URI to a file path." + (let* ((url (url-generic-parse-url (url-unhex-string uri))) + (type (url-type url)) + (target (url-target url)) + (file + (concat (decode-coding-string (url-filename url) + (or locale-coding-system 'utf-8)) + (when (and target + (not (s-match + (rx "#" (group (1+ num)) (or "," "#") + (group (1+ num)) + string-end) + uri))) + (concat "#" target)))) + (file-name (if (and type (not (string= type "file"))) + (if-let* ((handler (lsp--get-uri-handler type))) + (funcall handler uri) + uri) + ;; `url-generic-parse-url' is buggy on windows: + ;; https://github.com/emacs-lsp/lsp-mode/pull/265 + (or (and (eq system-type 'windows-nt) + (eq (elt file 0) ?\/) + (substring file 1)) + file)))) + (->> file-name + (concat (-some #'lsp--workspace-host-root (lsp-workspaces))) + (lsp-remap-path-if-needed)))) + +(defun lsp--buffer-uri () + "Return URI of the current buffer." + (or lsp-buffer-uri + (plist-get lsp--virtual-buffer :buffer-uri) + (lsp--path-to-uri + (or (buffer-file-name) (buffer-file-name (buffer-base-buffer)))))) + +(defun lsp-register-client-capabilities (&rest _args) + "Implemented only to make `company-lsp' happy. +DELETE when `lsp-mode.el' is deleted.") + +(defconst lsp--url-path-allowed-chars + (url--allowed-chars (append '(?/) url-unreserved-chars)) + "`url-unreserved-chars' with additional delim ?/. +This set of allowed chars is enough for hexifying local file paths.") + +(defun lsp--path-to-uri-1 (path) + (concat lsp--uri-file-prefix + (--> path + (expand-file-name it) + (or (file-remote-p it 'localname t) it) + (url-hexify-string it lsp--url-path-allowed-chars)))) + +(defun lsp--path-to-uri (path) + "Convert PATH to a uri." + (if-let* ((uri-fn (->> (lsp-workspaces) + (-keep (-compose #'lsp--client-path->uri-fn #'lsp--workspace-client)) + (cl-first)))) + (funcall uri-fn path) + (lsp--path-to-uri-1 path))) + +(defun lsp--string-match-any (regex-list str) + "Return the first regex, if any, within REGEX-LIST matching STR." + (--first (string-match it str) regex-list)) + +(cl-defstruct lsp-watch + (descriptors (make-hash-table :test 'equal)) + root-directory) + +(defun lsp--folder-watch-callback (event callback watch ignored-files ignored-directories) + (let ((file-name (cl-third event)) + (event-type (cl-second event))) + (cond + ((and (file-directory-p file-name) + (equal 'created event-type) + (not (lsp--string-match-any ignored-directories file-name))) + + (lsp-watch-root-folder (file-truename file-name) callback ignored-files ignored-directories watch) + + ;; process the files that are already present in + ;; the directory. + (->> (directory-files-recursively file-name ".*" t) + (seq-do (lambda (f) + (unless (file-directory-p f) + (funcall callback (list nil 'created f))))))) + ((and (memq event-type '(created deleted changed)) + (not (file-directory-p file-name)) + (not (lsp--string-match-any ignored-files file-name))) + (funcall callback event)) + ((and (memq event-type '(renamed)) + (not (file-directory-p file-name)) + (not (lsp--string-match-any ignored-files file-name))) + (funcall callback `(,(cl-first event) deleted ,(cl-third event))) + (funcall callback `(,(cl-first event) created ,(cl-fourth event))))))) + +(defun lsp--ask-about-watching-big-repo (number-of-directories dir) + "Ask the user if they want to watch NUMBER-OF-DIRECTORIES from a repository DIR. +This is useful when there is a lot of files in a repository, as +that may slow Emacs down. Returns t if the user wants to watch +the entire repository, nil otherwise." + (prog1 + (yes-or-no-p + (format + "Watching all the files in %s would require adding watches to %s directories, so watching the repo may slow Emacs down. +Do you want to watch all files in %s? " + dir + number-of-directories + dir)) + (lsp--info + (concat "You can configure this warning with the `lsp-enable-file-watchers' " + "and `lsp-file-watch-threshold' variables")))) + + +(defun lsp--path-is-watchable-directory (path dir ignored-directories) + "Figure out whether PATH (inside of DIR) is meant to have a file watcher set. +IGNORED-DIRECTORIES is a list of regexes to filter out directories we don't +want to watch." + (let + ((full-path (f-join dir path))) + (and (file-accessible-directory-p full-path) + (not (equal path ".")) + (not (equal path "..")) + (not (lsp--string-match-any ignored-directories full-path))))) + + +(defun lsp--all-watchable-directories (dir ignored-directories &optional visited) + "Traverse DIR recursively returning a list of paths that should have watchers. +IGNORED-DIRECTORIES will be used for exclusions. +VISITED is used to track already-visited directories to avoid infinite loops." + (let* ((dir (if (f-symlink? dir) + (file-truename dir) + dir)) + ;; Initialize visited directories if not provided + (visited (or visited (make-hash-table :test 'equal)))) + (if (gethash dir visited) + ;; If the directory has already been visited, skip it + nil + ;; Mark the current directory as visited + (puthash dir t visited) + (apply #'nconc + ;; the directory itself is assumed to be part of the set + (list dir) + ;; collect all subdirectories that are watchable + (-map + (lambda (path) (lsp--all-watchable-directories (f-join dir path) ignored-directories visited)) + ;; but only look at subdirectories that are watchable + (-filter (lambda (path) (lsp--path-is-watchable-directory path dir ignored-directories)) + (directory-files dir))))))) + +(defun lsp-watch-root-folder (dir callback ignored-files ignored-directories &optional watch warn-big-repo?) + "Create recursive file notification watch in DIR. +CALLBACK will be called when there are changes in any of +the monitored files. WATCHES is a hash table directory->file +notification handle which contains all of the watch that +already have been created. Watches will not be created for +any directory that matches any regex in IGNORED-DIRECTORIES. +Watches will not be created for any file that matches any +regex in IGNORED-FILES." + (let* ((dir (if (f-symlink? dir) + (file-truename dir) + dir)) + (watch (or watch (make-lsp-watch :root-directory dir))) + (dirs-to-watch (lsp--all-watchable-directories dir ignored-directories))) + (lsp-log "Creating watchers for following %s folders:\n %s" + (length dirs-to-watch) + (s-join "\n " dirs-to-watch)) + (when (or + (not warn-big-repo?) + (not lsp-file-watch-threshold) + (let ((number-of-directories (length dirs-to-watch))) + (or + (< number-of-directories lsp-file-watch-threshold) + (condition-case nil + (lsp--ask-about-watching-big-repo number-of-directories dir) + (quit))))) + (dolist (current-dir dirs-to-watch) + (condition-case err + (progn + (puthash + current-dir + (file-notify-add-watch current-dir + '(change) + (lambda (event) + (lsp--folder-watch-callback event callback watch ignored-files ignored-directories))) + (lsp-watch-descriptors watch))) + (error (lsp-log "Failed to create a watch for %s: message" (error-message-string err))) + (file-missing (lsp-log "Failed to create a watch for %s: message" (error-message-string err)))))) + watch)) + +(defun lsp-kill-watch (watch) + "Delete WATCH." + (-> watch lsp-watch-descriptors hash-table-values (-each #'file-notify-rm-watch)) + (ht-clear! (lsp-watch-descriptors watch))) + +(defun lsp-json-bool (val) + "Convert VAL to JSON boolean." + (if val t :json-false)) + +(defmacro with-lsp-workspace (workspace &rest body) + "Helper macro for invoking BODY in WORKSPACE context." + (declare (debug (form body)) + (indent 1)) + `(let ((lsp--cur-workspace ,workspace)) ,@body)) + +(defmacro with-lsp-workspaces (workspaces &rest body) + "Helper macro for invoking BODY against multiple WORKSPACES." + (declare (debug (form body)) + (indent 1)) + `(let ((lsp--buffer-workspaces ,workspaces)) ,@body)) + + + +(defmacro lsp-consistency-check (package) + `(defconst ,(intern (concat (symbol-name package) + "-plist-value-when-compiled")) + (eval-when-compile lsp-use-plists))) + + +;; loading code-workspace files + +;;;###autoload +(defun lsp-load-vscode-workspace (file) + "Load vscode workspace from FILE" + (interactive "fSelect file to import: ") + (mapc #'lsp-workspace-folders-remove (lsp-session-folders (lsp-session))) + + (let ((dir (f-dirname file))) + (->> file + (json-read-file) + (alist-get 'folders) + (-map (-lambda ((&alist 'path)) + (lsp-workspace-folders-add (expand-file-name path dir))))))) + +;;;###autoload +(defun lsp-save-vscode-workspace (file) + "Save vscode workspace to FILE" + (interactive "FSelect file to save to: ") + + (let ((json-encoding-pretty-print t)) + (f-write-text (json-encode + `((folders . ,(->> (lsp-session) + (lsp-session-folders) + (--map `((path . ,it))))))) + 'utf-8 + file))) + + +(defmacro lsp-foreach-workspace (&rest body) + "Execute BODY for each of the current workspaces." + (declare (debug (form body))) + `(--map (with-lsp-workspace it ,@body) (lsp-workspaces))) + +(defmacro when-lsp-workspace (workspace &rest body) + "Helper macro for invoking BODY in WORKSPACE context if present." + (declare (debug (form body)) + (indent 1)) + `(when-let* ((lsp--cur-workspace ,workspace)) ,@body)) + +(lsp-defun lsp--window-show-quick-pick (_workspace (&ShowQuickPickParams :place-holder :can-pick-many :items)) + (if-let* ((selectfunc (if can-pick-many #'completing-read-multiple #'completing-read)) + (itemLabels (seq-map (-lambda ((item &as &QuickPickItem :label)) (format "%s" label)) + items)) + (result (funcall-interactively + selectfunc + (format "%s%s " place-holder (if can-pick-many " (* for all)" "")) itemLabels)) + (choices (if (listp result) + (if (equal result '("*")) + itemLabels + result) + (list result)))) + (vconcat (seq-filter #'identity (seq-map (-lambda ((item &as &QuickPickItem :label :user-data)) + (if (member label choices) + (lsp-make-quick-pick-item :label label :picked t :user-data user-data) + nil)) + items))))) + +(lsp-defun lsp--window-show-input-box (_workspace (&ShowInputBoxParams :prompt :value?)) + (read-string (format "%s: " prompt) (or value? ""))) + +(lsp-defun lsp--window-show-message (_workspace (&ShowMessageRequestParams :message :type)) + "Send the server's messages to log. +PARAMS - the data sent from _WORKSPACE." + (funcall (cl-case type + (1 'lsp--error) + (2 'lsp--warn) + (t 'lsp--info)) + "%s" + message)) + +(lsp-defun lsp--window-log-message (workspace (&ShowMessageRequestParams :message :type)) + "Send the server's messages to log. +PARAMS - the data sent from WORKSPACE." + (ignore + (let ((client (lsp--workspace-client workspace))) + (when (or (not client) + (cl-notany (-rpartial #'string-match-p message) + (lsp--client-ignore-messages client))) + (lsp-log "%s" (lsp--propertize message type)))))) + +(lsp-defun lsp--window-log-message-request ((&ShowMessageRequestParams :message :type :actions?)) + "Display a message request to user sending the user selection back to server." + (let* ((message (lsp--propertize message type)) + (choices (seq-map #'lsp:message-action-item-title actions?))) + (if choices + (completing-read (concat message " ") (seq-into choices 'list) nil t) + (lsp-log message)))) + +(lsp-defun lsp--window-show-document ((&ShowDocumentParams :uri :selection?)) + "Show document URI in a buffer and go to SELECTION if any." + (let ((path (lsp--uri-to-path uri))) + (when (f-exists? path) + (with-current-buffer (find-file path) + (when selection? + (goto-char (lsp--position-to-point (lsp:range-start selection?)))) + t)))) + +(defcustom lsp-progress-prefix "⌛ " + "Progress prefix." + :group 'lsp-mode + :type 'string + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-progress-function #'lsp-on-progress-modeline + "Function for handling the progress notifications." + :group 'lsp-mode + :type '(choice + (const :tag "Use modeline" lsp-on-progress-modeline) + (const :tag "Legacy(uses either `progress-reporter' or `spinner' based on `lsp-progress-via-spinner')" + lsp-on-progress-legacy) + (const :tag "Ignore" ignore) + (function :tag "Other function")) + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-request-while-no-input-may-block nil + "Have `lsp-request-while-no-input` block unless `non-essential` is t." + :group 'lsp-mode + :type 'boolean) + +(defun lsp--progress-status () + "Returns the status of the progress for the current workspaces." + (-let ((progress-status + (s-join + "|" + (-keep + (lambda (workspace) + (let ((tokens (lsp--workspace-work-done-tokens workspace))) + (unless (ht-empty? tokens) + (mapconcat + (-lambda ((&WorkDoneProgressBegin :message? :title :percentage?)) + (concat (if percentage? + (if (numberp percentage?) + (format "%.0f%%%% " percentage?) + (format "%s%%%% " percentage?)) + "") + (or message? title))) + (ht-values tokens) + "|")))) + (lsp-workspaces))))) + (unless (s-blank? progress-status) + (concat lsp-progress-prefix progress-status " ")))) + +(lsp-defun lsp-on-progress-modeline (workspace (&ProgressParams :token :value + (value &as &WorkDoneProgress :kind))) + "PARAMS contains the progress data. +WORKSPACE is the workspace that contains the progress token." + (add-to-list 'global-mode-string '(t (:eval (lsp--progress-status)))) + (pcase kind + ("begin" (lsp-workspace-set-work-done-token token value workspace)) + ("report" (lsp-workspace-set-work-done-token token value workspace)) + ("end" (lsp-workspace-rem-work-done-token token workspace))) + (force-mode-line-update)) + +(lsp-defun lsp-on-progress-legacy (workspace (&ProgressParams :token :value + (value &as &WorkDoneProgress :kind))) + "PARAMS contains the progress data. +WORKSPACE is the workspace that contains the progress token." + (pcase kind + ("begin" + (-let* (((&WorkDoneProgressBegin :title :percentage?) value) + (reporter + (if lsp-progress-via-spinner + (let* ((spinner-strings (alist-get (lsp-progress-spinner-type) spinner-types)) + ;; Set message as a tooltip for the spinner strings + (propertized-strings + (seq-map (lambda (string) (propertize string 'help-echo title)) + spinner-strings)) + (spinner-type (vconcat propertized-strings))) + ;; The progress relates to the server as a whole, + ;; display it on all buffers. + (mapcar (lambda (buffer) + (lsp-with-current-buffer buffer + (spinner-start spinner-type)) + buffer) + (lsp--workspace-buffers workspace))) + (if percentage? + (make-progress-reporter title 0 100 percentage?) + ;; No percentage, just progress + (make-progress-reporter title nil nil))))) + (lsp-workspace-set-work-done-token token reporter workspace))) + ("report" + (when-let* ((reporter (lsp-workspace-get-work-done-token token workspace))) + (unless lsp-progress-via-spinner + (progress-reporter-update reporter (lsp:work-done-progress-report-percentage? value))))) + + ("end" + (when-let* ((reporter (lsp-workspace-get-work-done-token token workspace))) + (if lsp-progress-via-spinner + (mapc (lambda (buffer) + (when (lsp-buffer-live-p buffer) + (lsp-with-current-buffer buffer + (spinner-stop)))) + reporter) + (progress-reporter-done reporter)) + (lsp-workspace-rem-work-done-token token workspace))))) + + +;; diagnostics + +(defvar lsp-diagnostic-filter nil + "A a function which will be called with + `&PublishDiagnosticsParams' and `workspace' which can be used + to filter out the diagnostics. The function should return + `&PublishDiagnosticsParams'. + +Common usecase are: +1. Filter the diagnostics for a particular language server. +2. Filter out the diagnostics under specific level.") + +(defvar lsp-diagnostic-stats (ht)) + +(defun lsp-diagnostics (&optional current-workspace?) + "Return the diagnostics from all workspaces." + (or (pcase (if current-workspace? + (lsp-workspaces) + (lsp--session-workspaces (lsp-session))) + (`() ()) + (`(,workspace) (lsp--workspace-diagnostics workspace)) + (`,workspaces (let ((result (make-hash-table :test 'equal))) + (mapc (lambda (workspace) + (->> workspace + (lsp--workspace-diagnostics) + (maphash (lambda (file-name diagnostics) + (puthash file-name + (append (gethash file-name result) diagnostics) + result))))) + workspaces) + result))) + (ht))) + +(defun lsp-diagnostics-stats-for (path) + "Get diagnostics statistics for PATH. +The result format is vector [_ errors warnings infos hints] or nil." + (gethash (lsp--fix-path-casing path) lsp-diagnostic-stats)) + +(defun lsp-diagnostics--request-pull-diagnostics (workspace) + "Request new diagnostics for the current file within WORKSPACE. +This is only executed if the server supports pull diagnostics." + (when (lsp-feature? "textDocument/diagnostic") + (let ((path (lsp--fix-path-casing (buffer-file-name)))) + (lsp-request-async "textDocument/diagnostic" + (list :textDocument (lsp--text-document-identifier)) + (-lambda ((&DocumentDiagnosticReport :kind :items?)) + (lsp-diagnostics--apply-pull-diagnostics workspace path kind items?)) + :mode 'tick)))) + +(defun lsp-diagnostics--update-path (path new-stats) + (let ((new-stats (copy-sequence new-stats)) + (path (lsp--fix-path-casing (directory-file-name path)))) + (if-let* ((old-data (gethash path lsp-diagnostic-stats))) + (dotimes (idx 5) + (cl-callf + (aref old-data idx) + (aref new-stats idx))) + (puthash path new-stats lsp-diagnostic-stats)))) + +(defun lsp-diagnostics--convert-and-update-path-stats (workspace path diagnostics) + (let ((path (lsp--fix-path-casing path)) + (new-stats (make-vector 5 0))) + (mapc (-lambda ((&Diagnostic :severity?)) + (cl-incf (aref new-stats (or severity? 1)))) + diagnostics) + (when-let* ((old-diags (gethash path (lsp--workspace-diagnostics workspace)))) + (mapc (-lambda ((&Diagnostic :severity?)) + (cl-decf (aref new-stats (or severity? 1)))) + old-diags)) + (lsp-diagnostics--update-path path new-stats) + (while (not (string= path (setf path (file-name-directory + (directory-file-name path))))) + (lsp-diagnostics--update-path path new-stats)))) + +(lsp-defun lsp--on-diagnostics-update-stats (workspace + (&PublishDiagnosticsParams :uri :diagnostics)) + (lsp-diagnostics--convert-and-update-path-stats workspace (lsp--uri-to-path uri) diagnostics)) + +(defun lsp-diagnostics--apply-pull-diagnostics (workspace path kind diagnostics?) + "Update WORKSPACE diagnostics at PATH with DIAGNOSTICS?. +Depends on KIND being a \\='full\\=' update." + (cond + ((equal kind "full") + ;; TODO support `lsp-diagnostic-filter' + ;; (the params types differ from the published diagnostics response) + (lsp-diagnostics--convert-and-update-path-stats workspace path diagnostics?) + (-let* ((lsp--virtual-buffer-mappings (ht)) + (workspace-diagnostics (lsp--workspace-diagnostics workspace))) + (if (seq-empty-p diagnostics?) + (remhash path workspace-diagnostics) + (puthash path (append diagnostics? nil) workspace-diagnostics)) + (run-hooks 'lsp-diagnostics-updated-hook))) + ((equal kind "unchanged") t) + (t (lsp--error "Unknown pull diagnostic result kind '%s'" kind)))) + +(defun lsp--on-diagnostics (workspace params) + "Callback for textDocument/publishDiagnostics. +interface PublishDiagnosticsParams { + uri: string; + diagnostics: Diagnostic[]; +} +PARAMS contains the diagnostics data. +WORKSPACE is the workspace that contains the diagnostics." + (when lsp-diagnostic-filter + (setf params (funcall lsp-diagnostic-filter params workspace))) + + (lsp--on-diagnostics-update-stats workspace params) + + (-let* (((&PublishDiagnosticsParams :uri :diagnostics) params) + (lsp--virtual-buffer-mappings (ht)) + (file (lsp--fix-path-casing (lsp--uri-to-path uri))) + (workspace-diagnostics (lsp--workspace-diagnostics workspace))) + + (if (seq-empty-p diagnostics) + (remhash file workspace-diagnostics) + (puthash file (append diagnostics nil) workspace-diagnostics)) + + (run-hooks 'lsp-diagnostics-updated-hook))) + +(defun lsp-diagnostics--workspace-cleanup (workspace) + (->> workspace + (lsp--workspace-diagnostics) + (maphash (lambda (key _) + (lsp--on-diagnostics-update-stats + workspace + (lsp-make-publish-diagnostics-params + :uri (lsp--path-to-uri key) + :diagnostics []))))) + (clrhash (lsp--workspace-diagnostics workspace))) + + + +;; textDocument/foldingRange support + +(cl-defstruct lsp--folding-range beg end kind children) + +(defvar-local lsp--cached-folding-ranges nil) +(defvar-local lsp--cached-nested-folding-ranges nil) + +(defun lsp--folding-range-width (range) + (- (lsp--folding-range-end range) + (lsp--folding-range-beg range))) + +(defun lsp--get-folding-ranges () + "Get the folding ranges for the current buffer." + (unless (eq (buffer-chars-modified-tick) (car lsp--cached-folding-ranges)) + (let* ((ranges (lsp-request "textDocument/foldingRange" + `(:textDocument ,(lsp--text-document-identifier)))) + (sorted-line-col-pairs (->> ranges + (cl-mapcan (-lambda ((&FoldingRange :start-line + :start-character? + :end-line + :end-character?)) + (list (cons start-line start-character?) + (cons end-line end-character?)))) + (-sort #'lsp--line-col-comparator))) + (line-col-to-point-map (lsp--convert-line-col-to-points-batch + sorted-line-col-pairs))) + (setq lsp--cached-folding-ranges + (cons (buffer-chars-modified-tick) + (--> ranges + (seq-map (-lambda ((range &as + &FoldingRange :start-line + :start-character? + :end-line + :end-character? + :kind?)) + (make-lsp--folding-range + :beg (ht-get line-col-to-point-map + (cons start-line start-character?)) + :end (ht-get line-col-to-point-map + (cons end-line end-character?)) + :kind kind?)) + it) + (seq-filter (lambda (folding-range) + (< (lsp--folding-range-beg folding-range) + (lsp--folding-range-end folding-range))) + it) + (seq-into it 'list) + (delete-dups it)))))) + (cdr lsp--cached-folding-ranges)) + +(defun lsp--get-nested-folding-ranges () + "Get a list of nested folding ranges for the current buffer." + (-let [(tick . _) lsp--cached-folding-ranges] + (if (and (eq tick (buffer-chars-modified-tick)) + lsp--cached-nested-folding-ranges) + lsp--cached-nested-folding-ranges + (setq lsp--cached-nested-folding-ranges + (lsp--folding-range-build-trees (lsp--get-folding-ranges)))))) + +(defun lsp--folding-range-build-trees (ranges) + (setq ranges (seq-sort #'lsp--range-before-p ranges)) + (let* ((dummy-node (make-lsp--folding-range + :beg most-negative-fixnum + :end most-positive-fixnum)) + (stack (list dummy-node))) + (dolist (range ranges) + (while (not (lsp--range-inside-p range (car stack))) + (pop stack)) + (push range (lsp--folding-range-children (car stack))) + (push range stack)) + (lsp--folding-range-children dummy-node))) + +(defun lsp--range-inside-p (r1 r2) + "Return non-nil if folding range R1 lies inside R2" + (and (>= (lsp--folding-range-beg r1) (lsp--folding-range-beg r2)) + (<= (lsp--folding-range-end r1) (lsp--folding-range-end r2)))) + +(defun lsp--range-before-p (r1 r2) + "Return non-nil if folding range R1 ends before R2" + ;; Ensure r1 comes before r2 + (or (< (lsp--folding-range-beg r1) + (lsp--folding-range-beg r2)) + ;; If beg(r1) == beg(r2) make sure r2 ends first + (and (= (lsp--folding-range-beg r1) + (lsp--folding-range-beg r2)) + (< (lsp--folding-range-end r2) + (lsp--folding-range-end r1))))) + +(defun lsp--point-inside-range-p (point range) + "Return non-nil if POINT lies inside folding range RANGE." + (and (>= point (lsp--folding-range-beg range)) + (<= point (lsp--folding-range-end range)))) + +(cl-defun lsp--get-current-innermost-folding-range (&optional (point (point))) + "Return the innermost folding range POINT lies in." + (seq-reduce (lambda (innermost-range curr-range) + (if (and (lsp--point-inside-range-p point curr-range) + (or (null innermost-range) + (lsp--range-inside-p curr-range innermost-range))) + curr-range + innermost-range)) + (lsp--get-folding-ranges) + nil)) + +(cl-defun lsp--get-current-outermost-folding-range (&optional (point (point))) + "Return the outermost folding range POINT lies in." + (cdr (seq-reduce (-lambda ((best-pair &as outermost-width . _) curr-range) + (let ((curr-width (lsp--folding-range-width curr-range))) + (if (and (lsp--point-inside-range-p point curr-range) + (or (null best-pair) + (> curr-width outermost-width))) + (cons curr-width curr-range) + best-pair))) + (lsp--get-folding-ranges) + nil))) + +(defun lsp--folding-range-at-point-bounds () + (when (and lsp-enable-folding + (lsp-feature? "textDocument/foldingRange")) + (if-let* ((range (lsp--get-current-innermost-folding-range))) + (cons (lsp--folding-range-beg range) + (lsp--folding-range-end range))))) +(put 'lsp--folding-range 'bounds-of-thing-at-point + #'lsp--folding-range-at-point-bounds) + +(defun lsp--get-nearest-folding-range (&optional backward) + (let ((point (point)) + (found nil)) + (while (not + (or found + (if backward + (<= point (point-min)) + (>= point (point-max))))) + (if backward (cl-decf point) (cl-incf point)) + (setq found (lsp--get-current-innermost-folding-range point))) + found)) + +(defun lsp--folding-range-at-point-forward-op (n) + (when (and lsp-enable-folding + (not (zerop n)) + (lsp-feature? "textDocument/foldingRange")) + (cl-block break + (dotimes (_ (abs n)) + (if-let* ((range (lsp--get-nearest-folding-range (< n 0)))) + (goto-char (if (< n 0) + (lsp--folding-range-beg range) + (lsp--folding-range-end range))) + (cl-return-from break)))))) +(put 'lsp--folding-range 'forward-op + #'lsp--folding-range-at-point-forward-op) + +(defun lsp--folding-range-at-point-beginning-op () + (goto-char (car (lsp--folding-range-at-point-bounds)))) +(put 'lsp--folding-range 'beginning-op + #'lsp--folding-range-at-point-beginning-op) + +(defun lsp--folding-range-at-point-end-op () + (goto-char (cdr (lsp--folding-range-at-point-bounds)))) +(put 'lsp--folding-range 'end-op + #'lsp--folding-range-at-point-end-op) + +(defun lsp--range-at-point-bounds () + (or (lsp--folding-range-at-point-bounds) + (when-let* ((range (and + (lsp-feature? "textDocument/hover") + (->> (lsp--text-document-position-params) + (lsp-request "textDocument/hover") + (lsp:hover-range?))))) + (lsp--range-to-region range)))) + +;; A more general purpose "thing", useful for applications like focus.el +(put 'lsp--range 'bounds-of-thing-at-point + #'lsp--range-at-point-bounds) + +(defun lsp--log-io-p (method) + "Return non nil if should log for METHOD." + (and lsp-log-io + (or (not lsp-log-io-allowlist-methods) + (member method lsp-log-io-allowlist-methods)))) + + +;; toggles + +(defun lsp-toggle-trace-io () + "Toggle client-server protocol logging." + (interactive) + (setq lsp-log-io (not lsp-log-io)) + (lsp--info "Server logging %s." (if lsp-log-io "enabled" "disabled"))) + +(defun lsp-toggle-signature-auto-activate () + "Toggle signature auto activate." + (interactive) + (setq lsp-signature-auto-activate + (unless lsp-signature-auto-activate '(:on-trigger-char))) + (lsp--info "Signature autoactivate %s." (if lsp-signature-auto-activate "enabled" "disabled")) + (lsp--update-signature-help-hook)) + +(defun lsp-toggle-on-type-formatting () + "Toggle on type formatting." + (interactive) + (setq lsp-enable-on-type-formatting (not lsp-enable-on-type-formatting)) + (lsp--info "On type formatting is %s." (if lsp-enable-on-type-formatting "enabled" "disabled")) + (lsp--update-on-type-formatting-hook)) + +(defun lsp-toggle-symbol-highlight () + "Toggle symbol highlighting." + (interactive) + (setq lsp-enable-symbol-highlighting (not lsp-enable-symbol-highlighting)) + + (cond + ((and lsp-enable-symbol-highlighting + (lsp-feature? "textDocument/documentHighlight")) + (add-hook 'lsp-on-idle-hook #'lsp--document-highlight nil t) + (lsp--info "Symbol highlighting enabled in current buffer.")) + ((not lsp-enable-symbol-highlighting) + (remove-hook 'lsp-on-idle-hook #'lsp--document-highlight t) + (lsp--remove-overlays 'lsp-highlight) + (lsp--info "Symbol highlighting disabled in current buffer.")))) + + +;; keybindings +(defvar lsp--binding-descriptions nil + "List of key binding/short description pair.") + +(defmacro lsp-define-conditional-key (keymap key def desc cond &rest bindings) + "In KEYMAP, define key sequence KEY as DEF conditionally. +This is like `define-key', except the definition disappears +whenever COND evaluates to nil. +DESC is the short-description for the binding. +BINDINGS is a list of (key def desc cond)." + (declare (indent defun) + (debug (form form form form form &rest sexp))) + (->> (cl-list* key def desc cond bindings) + (-partition 4) + (-mapcat (-lambda ((key def desc cond)) + `((define-key ,keymap ,key + '(menu-item + ,(format "maybe-%s" def) + ,def + :filter + (lambda (item) + (when (with-current-buffer (or (when (buffer-live-p lsp--describe-buffer) + lsp--describe-buffer) + (current-buffer)) + ,cond) + item)))) + (when (stringp ,key) + (setq lsp--binding-descriptions + (append lsp--binding-descriptions '(,key ,desc))))))) + macroexp-progn)) + +(defvar lsp--describe-buffer nil) + +(defun lsp-describe-buffer-bindings-advice (fn buffer &optional prefix menus) + (let ((lsp--describe-buffer buffer)) + (funcall fn buffer prefix menus))) + +(advice-add 'describe-buffer-bindings + :around + #'lsp-describe-buffer-bindings-advice) + +(defun lsp--prepend-prefix (mappings) + (->> mappings + (-partition 2) + (-mapcat (-lambda ((key description)) + (list (concat lsp-keymap-prefix " " key) + description))))) + +(defvar lsp-command-map + (-doto (make-sparse-keymap) + (lsp-define-conditional-key + ;; workspaces + "wD" lsp-disconnect "disconnect" (lsp-workspaces) + "wd" lsp-describe-session "describe session" t + "wq" lsp-workspace-shutdown "shutdown server" (lsp-workspaces) + "wr" lsp-workspace-restart "restart server" (lsp-workspaces) + "ws" lsp "start server" t + + ;; formatting + "==" lsp-format-buffer "format buffer" (or (lsp-feature? "textDocument/rangeFormatting") + (lsp-feature? "textDocument/formatting")) + "=r" lsp-format-region "format region" (lsp-feature? "textDocument/rangeFormatting") + + ;; folders + "Fa" lsp-workspace-folders-add "add folder" t + "Fb" lsp-workspace-blocklist-remove "un-blocklist folder" t + "Fr" lsp-workspace-folders-remove "remove folder" t + + ;; toggles + "TD" lsp-modeline-diagnostics-mode "toggle modeline diagnostics" (lsp-feature? + "textDocument/publishDiagnostics") + "TL" lsp-toggle-trace-io "toggle log io" t + "TS" lsp-ui-sideline-mode "toggle sideline" (featurep 'lsp-ui-sideline) + "TT" lsp-treemacs-sync-mode "toggle treemacs integration" (featurep 'lsp-treemacs) + "Ta" lsp-modeline-code-actions-mode "toggle modeline code actions" (lsp-feature? + "textDocument/codeAction") + "Tb" lsp-headerline-breadcrumb-mode "toggle breadcrumb" (lsp-feature? + "textDocument/documentSymbol") + "Td" lsp-ui-doc-mode "toggle documentation popup" (featurep 'lsp-ui-doc) + "Tf" lsp-toggle-on-type-formatting "toggle on type formatting" (lsp-feature? + "textDocument/onTypeFormatting") + "Th" lsp-toggle-symbol-highlight "toggle highlighting" (lsp-feature? "textDocument/documentHighlight") + "Tl" lsp-lens-mode "toggle lenses" (lsp-feature? "textDocument/codeLens") + "Ts" lsp-toggle-signature-auto-activate "toggle signature" (lsp-feature? "textDocument/signatureHelp") + + ;; goto + "ga" xref-find-apropos "find symbol in workspace" (lsp-feature? "workspace/symbol") + "gd" lsp-find-declaration "find declarations" (lsp-feature? "textDocument/declaration") + "ge" lsp-treemacs-errors-list "show errors" (fboundp 'lsp-treemacs-errors-list) + "gg" lsp-find-definition "find definitions" (lsp-feature? "textDocument/definition") + "gh" lsp-treemacs-call-hierarchy "call hierarchy" (and (lsp-feature? "callHierarchy/incomingCalls") + (fboundp 'lsp-treemacs-call-hierarchy)) + "gi" lsp-find-implementation "find implementations" (lsp-feature? "textDocument/implementation") + "gr" lsp-find-references "find references" (lsp-feature? "textDocument/references") + "gt" lsp-find-type-definition "find type definition" (lsp-feature? "textDocument/typeDefinition") + + ;; help + "hg" lsp-ui-doc-glance "glance symbol" (and (featurep 'lsp-ui-doc) + (lsp-feature? "textDocument/hover")) + "hh" lsp-describe-thing-at-point "describe symbol at point" (lsp-feature? "textDocument/hover") + "hs" lsp-signature-activate "signature help" (lsp-feature? "textDocument/signatureHelp") + + ;; refactoring + "ro" lsp-organize-imports "organize imports" (lsp-feature? "textDocument/codeAction") + "rr" lsp-rename "rename" (lsp-feature? "textDocument/rename") + + ;; actions + "aa" lsp-execute-code-action "code actions" (lsp-feature? "textDocument/codeAction") + "ah" lsp-document-highlight "highlight symbol" (lsp-feature? "textDocument/documentHighlight") + "al" lsp-avy-lens "lens" (and (bound-and-true-p lsp-lens-mode) (featurep 'avy)) + + ;; peeks + "Gg" lsp-ui-peek-find-definitions "peek definitions" (and (lsp-feature? "textDocument/definition") + (fboundp 'lsp-ui-peek-find-definitions)) + "Gi" lsp-ui-peek-find-implementation "peek implementations" (and + (fboundp 'lsp-ui-peek-find-implementation) + (lsp-feature? "textDocument/implementation")) + "Gr" lsp-ui-peek-find-references "peek references" (and (fboundp 'lsp-ui-peek-find-references) + (lsp-feature? "textDocument/references")) + "Gs" lsp-ui-peek-find-workspace-symbol "peek workspace symbol" (and (fboundp + 'lsp-ui-peek-find-workspace-symbol) + (lsp-feature? "workspace/symbol"))))) + + +;; which-key integration + +(declare-function which-key-add-major-mode-key-based-replacements "ext:which-key") +(declare-function which-key-add-key-based-replacements "ext:which-key") + +(defun lsp-enable-which-key-integration (&optional all-modes) + "Adds descriptions for `lsp-mode-map' to `which-key-mode' for the current +active `major-mode', or for all major modes when ALL-MODES is t." + (cl-flet ((which-key-fn (if all-modes + 'which-key-add-key-based-replacements + (apply-partially 'which-key-add-major-mode-key-based-replacements major-mode)))) + (apply + #'which-key-fn + (lsp--prepend-prefix + (cl-list* + "" "lsp" + "w" "workspaces" + "F" "folders" + "=" "formatting" + "T" "toggle" + "g" "goto" + "h" "help" + "r" "refactor" + "a" "code actions" + "G" "peek" + lsp--binding-descriptions))))) + + +;; Globbing syntax + +;; We port VSCode's glob-to-regexp code +;; (https://github.com/Microsoft/vscode/blob/466da1c9013c624140f6d1473b23a870abc82d44/src/vs/base/common/glob.ts) +;; since the LSP globbing syntax seems to be the same as that of +;; VSCode. + +(defconst lsp-globstar "**" + "Globstar pattern.") + +(defconst lsp-glob-split ?/ + "The character by which we split path components in a glob +pattern.") + +(defconst lsp-path-regexp "[/\\\\]" + "Forward or backslash to be used as a path separator in +computed regexps.") + +(defconst lsp-non-path-regexp "[^/\\\\]" + "A regexp matching anything other than a slash.") + +(defconst lsp-globstar-regexp + (format "\\(?:%s\\|%s+%s\\|%s%s+\\)*?" + lsp-path-regexp + lsp-non-path-regexp lsp-path-regexp + lsp-path-regexp lsp-non-path-regexp) + "Globstar in regexp form.") + +(defun lsp-split-glob-pattern (pattern split-char) + "Split PATTERN at SPLIT-CHAR while respecting braces and brackets." + (when pattern + (let ((segments nil) + (in-braces nil) + (in-brackets nil) + (current-segment "")) + (dolist (char (string-to-list pattern)) + (cl-block 'exit-point + (if (eq char split-char) + (when (and (null in-braces) + (null in-brackets)) + (push current-segment segments) + (setq current-segment "") + (cl-return-from 'exit-point)) + (pcase char + (?{ + (setq in-braces t)) + (?} + (setq in-braces nil)) + (?\[ + (setq in-brackets t)) + (?\] + (setq in-brackets nil)))) + (setq current-segment (concat current-segment + (char-to-string char))))) + (unless (string-empty-p current-segment) + (push current-segment segments)) + (nreverse segments)))) + +(defun lsp--glob-to-regexp (pattern) + "Helper function to convert a PATTERN from LSP's glob syntax to +an Elisp regexp." + (if (string-empty-p pattern) + "" + (let ((current-regexp "") + (glob-segments (lsp-split-glob-pattern pattern lsp-glob-split))) + (if (-all? (lambda (segment) (eq segment lsp-globstar)) + glob-segments) + ".*" + (let ((prev-segment-was-globstar nil)) + (seq-do-indexed + (lambda (segment index) + (if (string-equal segment lsp-globstar) + (unless prev-segment-was-globstar + (setq current-regexp (concat current-regexp + lsp-globstar-regexp)) + (setq prev-segment-was-globstar t)) + (let ((in-braces nil) + (brace-val "") + (in-brackets nil) + (bracket-val "")) + (dolist (char (string-to-list segment)) + (cond + ((and (not (char-equal char ?\})) + in-braces) + (setq brace-val (concat brace-val + (char-to-string char)))) + ((and in-brackets + (or (not (char-equal char ?\])) + (string-empty-p bracket-val))) + (let ((curr (cond + ((char-equal char ?-) + "-") + ;; NOTE: ?\^ and ?^ are different characters + ((and (memq char '(?^ ?!)) + (string-empty-p bracket-val)) + "^") + ((char-equal char lsp-glob-split) + "") + (t + (regexp-quote (char-to-string char)))))) + (setq bracket-val (concat bracket-val curr)))) + (t + (cl-case char + (?{ + (setq in-braces t)) + (?\[ + (setq in-brackets t)) + (?} + (let* ((choices (lsp-split-glob-pattern brace-val ?\,)) + (brace-regexp (concat "\\(?:" + (mapconcat #'lsp--glob-to-regexp choices "\\|") + "\\)"))) + (setq current-regexp (concat current-regexp + brace-regexp)) + (setq in-braces nil) + (setq brace-val ""))) + (?\] + (setq current-regexp + (concat current-regexp + "[" bracket-val "]")) + (setq in-brackets nil) + (setq bracket-val "")) + (?? + (setq current-regexp + (concat current-regexp + lsp-non-path-regexp))) + (?* + (setq current-regexp + (concat current-regexp + lsp-non-path-regexp "*?"))) + (t + (setq current-regexp + (concat current-regexp + (regexp-quote (char-to-string char))))))))) + (when (and (< index (1- (length glob-segments))) + (or (not (string-equal (nth (1+ index) glob-segments) + lsp-globstar)) + (< (+ index 2) + (length glob-segments)))) + (setq current-regexp + (concat current-regexp + lsp-path-regexp))) + (setq prev-segment-was-globstar nil)))) + glob-segments) + current-regexp))))) + +;; See https://github.com/emacs-lsp/lsp-mode/issues/2365 +(defun lsp-glob-unbrace-at-top-level (glob-pattern) + "If GLOB-PATTERN does not start with a brace, return a singleton list +containing GLOB-PATTERN. + +If GLOB-PATTERN does start with a brace, return a list of the +comma-separated globs within the top-level braces." + (if (not (string-prefix-p "{" glob-pattern)) + (list glob-pattern) + (lsp-split-glob-pattern (substring glob-pattern 1 -1) ?\,))) + +(defun lsp-glob-convert-to-wrapped-regexp (glob-pattern) + "Convert GLOB-PATTERN to a regexp wrapped with the beginning- +and end-of-string meta-characters." + (concat "\\`" (lsp--glob-to-regexp (string-trim glob-pattern)) "\\'")) + +(defun lsp-glob-to-regexps (glob-pattern) + "Convert a GLOB-PATTERN to a list of Elisp regexps." + (when-let* + ((glob-pattern (cond ((hash-table-p glob-pattern) + (ht-get glob-pattern "pattern")) + ((stringp glob-pattern) glob-pattern) + (t (error "Unknown glob-pattern type: %s" glob-pattern)))) + (trimmed-pattern (string-trim glob-pattern)) + (top-level-unbraced-patterns (lsp-glob-unbrace-at-top-level trimmed-pattern))) + (seq-map #'lsp-glob-convert-to-wrapped-regexp + top-level-unbraced-patterns))) + + + +(defvar lsp-mode-menu) + +(defun lsp-mouse-click (event) + (interactive "e") + (let* ((ec (event-start event)) + (choice (x-popup-menu event lsp-mode-menu)) + (action (lookup-key lsp-mode-menu (apply 'vector choice)))) + + (select-window (posn-window ec)) + + (unless (and (region-active-p) (eq action 'lsp-execute-code-action)) + (goto-char (posn-point ec))) + (run-with-idle-timer + 0.001 nil + (lambda () + (cl-labels ((check (value) (not (null value)))) + (when choice + (call-interactively action))))))) + +(defvar lsp-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-<down-mouse-1>") #'lsp-find-definition-mouse) + (define-key map (kbd "C-<mouse-1>") #'ignore) + (define-key map (kbd "<mouse-3>") #'lsp-mouse-click) + (define-key map (kbd "C-S-SPC") #'lsp-signature-activate) + (when lsp-keymap-prefix + (define-key map (kbd lsp-keymap-prefix) lsp-command-map)) + map) + "Keymap for `lsp-mode'.") + +(define-minor-mode lsp-mode "Mode for LSP interaction." + :keymap lsp-mode-map + :lighter + (" LSP[" + (lsp--buffer-workspaces + (:eval (mapconcat #'lsp--workspace-print lsp--buffer-workspaces "][")) + (:propertize "Disconnected" face warning)) + "]") + :group 'lsp-mode + (when (and lsp-mode (not lsp--buffer-workspaces) (not lsp--buffer-deferred)) + ;; fire up `lsp' when someone calls `lsp-mode' instead of `lsp' + (lsp))) + +(defvar lsp-mode-menu + (easy-menu-create-menu + nil + `(["Go to definition" lsp-find-definition + :active (lsp-feature? "textDocument/definition")] + ["Find references" lsp-find-references + :active (lsp-feature? "textDocument/references")] + ["Find implementations" lsp-find-implementation + :active (lsp-feature? "textDocument/implementation")] + ["Find declarations" lsp-find-declaration + :active (lsp-feature? "textDocument/declaration")] + ["Go to type declaration" lsp-find-type-definition + :active (lsp-feature? "textDocument/typeDefinition")] + "--" + ["Describe" lsp-describe-thing-at-point] + ["Code action" lsp-execute-code-action] + ["Format" lsp-format-buffer] + ["Highlight references" lsp-document-highlight] + ["Type Hierarchy" lsp-java-type-hierarchy + :visible (lsp-can-execute-command? "java.navigate.resolveTypeHierarchy")] + ["Type Hierarchy" lsp-treemacs-type-hierarchy + :visible (and (not (lsp-can-execute-command? "java.navigate.resolveTypeHierarchy")) + (functionp 'lsp-treemacs-type-hierarchy) + (lsp-feature? "textDocument/typeHierarchy"))] + ["Call Hierarchy" lsp-treemacs-call-hierarchy + :visible (and (functionp 'lsp-treemacs-call-hierarchy) + (lsp-feature? "textDocument/callHierarchy"))] + ["Rename" lsp-rename + :active (lsp-feature? "textDocument/rename")] + "--" + ("Session" + ["View logs" lsp-workspace-show-log] + ["Describe" lsp-describe-session] + ["Shutdown" lsp-shutdown-workspace] + ["Restart" lsp-restart-workspace]) + ("Workspace Folders" + ["Add" lsp-workspace-folders-add] + ["Remove" lsp-workspace-folders-remove] + ["Open" lsp-workspace-folders-open]) + ("Toggle features" + ["Lenses" lsp-lens-mode] + ["Headerline breadcrumb" lsp-headerline-breadcrumb-mode] + ["Modeline code actions" lsp-modeline-code-actions-mode] + ["Modeline diagnostics" lsp-modeline-diagnostics-mode]) + "---" + ("Debug" + :active (bound-and-true-p dap-ui-mode) + :filter ,(lambda (_) + (and (boundp 'dap-ui-menu-items) + (nthcdr 3 dap-ui-menu-items)))))) + "Menu for lsp-mode.") + +(defalias 'make-lsp-client 'make-lsp--client) + +(cl-defstruct lsp--registered-capability + (id "") + (method " ") + (options nil)) + +;; A ‘lsp--workspace’ object represents exactly one language server process. +(cl-defstruct lsp--workspace + ;; the `ewoc' object for displaying I/O to and from the server + (ewoc nil) + + ;; ‘server-capabilities’ is a hash table of the language server capabilities. + ;; It is the hash table representation of a LSP ServerCapabilities structure; + ;; cf. https://microsoft.github.io/language-server-protocol/specification#initialize. + (server-capabilities nil) + + ;; ‘registered-server-capabilities’ is a list of hash tables that represent + ;; dynamically-registered Registration objects. See + ;; https://microsoft.github.io/language-server-protocol/specification#client_registerCapability. + (registered-server-capabilities nil) + + ;; ‘root’ is a directory name or a directory file name for the workspace + ;; root. ‘lsp-mode’ passes this directory to the ‘initialize’ method of the + ;; language server; see + ;; https://microsoft.github.io/language-server-protocol/specification#initialize. + (root nil) + + ;; ‘client’ is the ‘lsp--client’ object associated with this workspace. + (client nil) + + ;; ‘host-root’ contains the host root info as derived from `file-remote-p'. It + ;; used to derive the file path in `lsp--uri-to-path' when using tramp + ;; connection. + (host-root nil) + + ;; ‘proc’ is a process object; it may represent a regular process, a pipe, or + ;; a network connection. ‘lsp-mode’ communicates with ‘proc’ using the + ;; language server protocol. ‘proc’ corresponds to the COMMUNICATION-PROCESS + ;; element of the return value of the client’s ‘get-root’ field, which see. + (proc nil) + + ;; ‘proc’ is a process object; it must represent a regular process, not a + ;; pipe or network process. It represents the actual server process that + ;; corresponds to this workspace. ‘cmd-proc’ corresponds to the + ;; COMMAND-PROCESS element of the return value of the client’s ‘get-root’ + ;; field, which see. + (cmd-proc nil) + + ;; ‘buffers’ is a list of buffers associated with this workspace. + (buffers nil) + + ;; if semantic tokens is enabled, `semantic-tokens-faces' contains + ;; one face (or nil) for each token type supported by the language server. + (semantic-tokens-faces nil) + + ;; If semantic highlighting is enabled, `semantic-tokens-modifier-faces' + ;; contains one face (or nil) for each modifier type supported by the language + ;; server + (semantic-tokens-modifier-faces nil) + + ;; Extra client capabilities provided by third-party packages using + ;; `lsp-register-client-capabilities'. It's value is an alist of (PACKAGE-NAME + ;; . CAPS), where PACKAGE-NAME is a symbol of the third-party package name, + ;; and CAPS is either a plist of the client capabilities, or a function that + ;; takes no argument and returns a plist of the client capabilities or nil. + (extra-client-capabilities nil) + + ;; Workspace status + (status nil) + + ;; ‘metadata’ is a generic storage for workspace specific data. It is + ;; accessed via `lsp-workspace-set-metadata' and `lsp-workspace-set-metadata' + (metadata (make-hash-table :test 'equal)) + + ;; contains all the file notification watches that have been created for the + ;; current workspace in format filePath->file notification handle. + (watches (make-hash-table :test 'equal)) + + ;; list of workspace folders + (workspace-folders nil) + + ;; ‘last-id’ the last request id for the current workspace. + (last-id 0) + + ;; ‘status-string’ allows extensions to specify custom status string based on + ;; the Language Server specific messages. + (status-string nil) + + ;; ‘shutdown-action’ flag used to mark that workspace should not be restarted (e.g. it + ;; was stopped). + shutdown-action + + ;; ‘diagnostics’ a hashmap with workspace diagnostics. + (diagnostics (make-hash-table :test 'equal)) + + ;; contains all the workDone progress tokens that have been created + ;; for the current workspace. + (work-done-tokens (make-hash-table :test 'equal))) + + +(cl-defstruct lsp-session + ;; contains the folders that are part of the current session + folders + ;; contains the folders that must not be imported in the current workspace. + folders-blocklist + ;; contains the list of folders that must be imported in a project in case of + ;; multi root LSP server. + (server-id->folders (make-hash-table :test 'equal)) + ;; folder to list of the servers that are associated with the folder. + (folder->servers (make-hash-table :test 'equal)) + ;; ‘metadata’ is a generic storage for workspace specific data. It is + ;; accessed via `lsp-workspace-set-metadata' and `lsp-workspace-set-metadata' + (metadata (make-hash-table :test 'equal))) + +(defun lsp-workspace-status (status-string &optional workspace) + "Set current workspace status to STATUS-STRING. +If WORKSPACE is not specified defaults to lsp--cur-workspace." + (let ((status-string (when status-string (replace-regexp-in-string "%" "%%" status-string)))) + (setf (lsp--workspace-status-string (or workspace lsp--cur-workspace)) status-string))) + +(defun lsp-session-set-metadata (key value &optional _workspace) + "Associate KEY with VALUE in the WORKSPACE metadata. +If WORKSPACE is not provided current workspace will be used." + (puthash key value (lsp-session-metadata (lsp-session)))) + +(defalias 'lsp-workspace-set-metadata 'lsp-session-set-metadata) + +(defun lsp-session-get-metadata (key &optional _workspace) + "Lookup KEY in WORKSPACE metadata. +If WORKSPACE is not provided current workspace will be used." + (gethash key (lsp-session-metadata (lsp-session)))) + +(defalias 'lsp-workspace-get-metadata 'lsp-session-get-metadata) + +(defun lsp-workspace-set-work-done-token (token value workspace) + "Associate TOKEN with VALUE in the WORKSPACE work-done-tokens." + (puthash token value (lsp--workspace-work-done-tokens workspace))) + +(defun lsp-workspace-get-work-done-token (token workspace) + "Lookup TOKEN in the WORKSPACE work-done-tokens." + (gethash token (lsp--workspace-work-done-tokens workspace))) + +(defun lsp-workspace-rem-work-done-token (token workspace) + "Remove TOKEN from the WORKSPACE work-done-tokens." + (remhash token (lsp--workspace-work-done-tokens workspace))) + + +(defun lsp--make-notification (method &optional params) + "Create notification body for method METHOD and parameters PARAMS." + (list :jsonrpc "2.0" :method method :params params)) + +(defalias 'lsp--make-request 'lsp--make-notification) +(defalias 'lsp-make-request 'lsp--make-notification) + +(defun lsp--make-response (id result) + "Create response for REQUEST with RESULT." + `(:jsonrpc "2.0" :id ,id :result ,result)) + +(defun lsp-make-notification (method &optional params) + "Create notification body for method METHOD and parameters PARAMS." + (lsp--make-notification method params)) + +(defmacro lsp--json-serialize (params) + (if (progn + (require 'json) + (fboundp 'json-serialize)) + `(json-serialize ,params + :null-object nil + :false-object :json-false) + `(let ((json-false :json-false)) + (json-encode ,params)))) + +(defun lsp--make-message (params) + "Create a LSP message from PARAMS, after encoding it to a JSON string." + (let ((body (lsp--json-serialize params))) + (concat "Content-Length: " + (number-to-string (1+ (string-bytes body))) + "\r\n\r\n" + body + "\n"))) + +(cl-defstruct lsp--log-entry timestamp process-time type method id body) + +(defun lsp--make-log-entry (method id body type &optional process-time) + "Create an outgoing log object from BODY with method METHOD and id ID. +If ID is non-nil, then the body is assumed to be a notification. +TYPE can either be `incoming' or `outgoing'" + (cl-assert (memq type '(incoming-req outgoing-req incoming-notif + outgoing-notif incoming-resp + outgoing-resp))) + (make-lsp--log-entry + :timestamp (format-time-string "%I:%M:%S %p") + :process-time process-time + :method method + :id id + :type type + :body body)) + +(defun lsp--log-font-lock-json (body) + "Font lock JSON BODY." + (with-temp-buffer + (insert body) + ;; We set the temp buffer file-name extension to .json and call `set-auto-mode' + ;; so the users configured json mode is used which could be + ;; `json-mode', `json-ts-mode', `jsonian-mode', etc. + (let ((buffer-file-name "lsp-log.json")) + (delay-mode-hooks + (set-auto-mode) + (if (fboundp 'font-lock-ensure) + (font-lock-ensure) + (with-no-warnings + (font-lock-fontify-buffer))))) + (buffer-string))) + +(defun lsp--log-entry-pp (entry) + (cl-assert (lsp--log-entry-p entry)) + (pcase-let (((cl-struct lsp--log-entry timestamp method id type process-time + body) + entry) + (json-false :json-false) + (json-encoding-pretty-print t) + (str nil)) + (setq str + (concat (format "[Trace - %s] " timestamp) + (pcase type + ('incoming-req (format "Received request '%s - (%s)." method id)) + ('outgoing-req (format "Sending request '%s - (%s)'." method id)) + + ('incoming-notif (format "Received notification '%s'." method)) + ('outgoing-notif (format "Sending notification '%s'." method)) + + ('incoming-resp (format "Received response '%s - (%s)' in %dms." + method id process-time)) + ('outgoing-resp + (format + "Sending response '%s - (%s)'. Processing request took %dms" + method id process-time))) + "\n" + (if (memq type '(incoming-resp ougoing-resp)) + "Result: " + "Params: ") + (lsp--log-font-lock-json (json-encode body)) + "\n\n\n")) + (setq str (propertize str 'mouse-face 'highlight 'read-only t)) + (insert str))) + +(defvar-local lsp--log-io-ewoc nil) + +(defun lsp--get-create-io-ewoc (workspace) + (if (and (lsp--workspace-ewoc workspace) + (buffer-live-p (ewoc-buffer (lsp--workspace-ewoc workspace)))) + (lsp--workspace-ewoc workspace) + (with-current-buffer (lsp--get-log-buffer-create workspace) + (unless (eq 'lsp-log-io-mode major-mode) (lsp-log-io-mode)) + (setq-local window-point-insertion-type t) + (setq lsp--log-io-ewoc (ewoc-create #'lsp--log-entry-pp nil nil t)) + (setf (lsp--workspace-ewoc workspace) lsp--log-io-ewoc)) + (lsp--workspace-ewoc workspace))) + +(defun lsp--ewoc-count (ewoc) + (let* ((count 0) + (count-fn (lambda (_) (setq count (1+ count))))) + (ewoc-map count-fn ewoc) + count)) + +(defun lsp--log-entry-new (entry workspace) + (let* ((ewoc (lsp--get-create-io-ewoc workspace)) + (count (and (not (eq lsp-io-messages-max t)) (lsp--ewoc-count ewoc))) + (node (if (or (eq lsp-io-messages-max t) + (>= lsp-io-messages-max count)) + nil + (ewoc-nth ewoc (1- lsp-io-messages-max)))) + (prev nil) + (inhibit-read-only t)) + (while node + (setq prev (ewoc-prev ewoc node)) + (ewoc-delete ewoc node) + (setq node prev)) + (ewoc-enter-last ewoc entry))) + +(defun lsp--send-notification (body) + "Send BODY as a notification to the language server." + (lsp-foreach-workspace + (when (lsp--log-io-p (plist-get body :method)) + (lsp--log-entry-new (lsp--make-log-entry + (plist-get body :method) + nil (plist-get body :params) 'outgoing-notif) + lsp--cur-workspace)) + (lsp--send-no-wait body + (lsp--workspace-proc lsp--cur-workspace)))) + +(defalias 'lsp-send-notification 'lsp--send-notification) + +(defun lsp-notify (method params) + "Send notification METHOD with PARAMS." + (lsp--send-notification (lsp--make-notification method params))) + +(defun lsp--cur-workspace-check () + "Check whether buffer lsp workspace(s) are set." + (cl-assert (lsp-workspaces) nil + "No language server(s) is associated with this buffer.")) + +(defun lsp--send-request (body &optional no-wait no-merge) + "Send BODY as a request to the language server, get the response. +If NO-WAIT is non-nil, don't synchronously wait for a response. +If NO-MERGE is non-nil, don't merge the results but return an +alist mapping workspace->result." + (lsp-request (plist-get body :method) + (plist-get body :params) + :no-wait no-wait + :no-merge no-merge)) + +(defalias 'lsp-send-request 'lsp--send-request + "Send BODY as a request to the language server and return the response +synchronously. +\n(fn BODY)") + +(cl-defun lsp-request (method params &key no-wait no-merge) + "Send request METHOD with PARAMS. +If NO-MERGE is non-nil, don't merge the results but return alist +workspace->result. +If NO-WAIT is non-nil send the request as notification." + (if no-wait + (lsp-notify method params) + (let* ((send-time (float-time)) + ;; max time by which we must get a response + (expected-time + (and + lsp-response-timeout + (+ send-time lsp-response-timeout))) + resp-result resp-error done?) + (unwind-protect + (progn + (lsp-request-async method params + (lambda (res) (setf resp-result (or res :finished)) (throw 'lsp-done '_)) + :error-handler (lambda (err) (setf resp-error err) (throw 'lsp-done '_)) + :no-merge no-merge + :mode 'detached + :cancel-token :sync-request) + (while (not (or resp-error resp-result)) + (if (functionp 'json-rpc-connection) + (catch 'lsp-done (sit-for 0.01)) + (catch 'lsp-done + (accept-process-output + nil + (if expected-time (- expected-time send-time) 1)))) + (setq send-time (float-time)) + (when (and expected-time (< expected-time send-time)) + (error "Timeout while waiting for response. Method: %s" method))) + (setq done? t) + (cond + ((eq resp-result :finished) nil) + (resp-result resp-result) + ((lsp-json-error? resp-error) (error (lsp:json-error-message resp-error))) + ((lsp-json-error? (cl-first resp-error)) + (error (lsp:json-error-message (cl-first resp-error)))))) + (unless done? + (lsp-cancel-request-by-token :sync-request)))))) + +(cl-defun lsp-request-while-no-input (method params) + "Send request METHOD with PARAMS and waits until there is no input. +Return same value as `lsp--while-no-input' and respecting `non-essential'." + (if (or non-essential (not lsp-request-while-no-input-may-block)) + (let* ((send-time (float-time)) + ;; max time by which we must get a response + (expected-time + (and + lsp-response-timeout + (+ send-time lsp-response-timeout))) + resp-result resp-error done?) + (unwind-protect + (progn + (lsp-request-async method params + (lambda (res) (setf resp-result (or res :finished)) (throw 'lsp-done '_)) + :error-handler (lambda (err) (setf resp-error err) (throw 'lsp-done '_)) + :mode 'detached + :cancel-token :sync-request) + (while (not (or resp-error resp-result (input-pending-p))) + (catch 'lsp-done + (sit-for + (if expected-time (- expected-time send-time) 1))) + (setq send-time (float-time)) + (when (and expected-time (< expected-time send-time)) + (error "Timeout while waiting for response. Method: %s" method))) + (setq done? (or resp-error resp-result)) + (cond + ((eq resp-result :finished) nil) + (resp-result resp-result) + ((lsp-json-error? resp-error) (error (lsp:json-error-message resp-error))) + ((lsp-json-error? (cl-first resp-error)) + (error (lsp:json-error-message (cl-first resp-error)))))) + (unless done? + (lsp-cancel-request-by-token :sync-request)) + (when (and (input-pending-p) lsp--throw-on-input) + (throw 'input :interrupted)))) + (lsp-request method params))) + +(defvar lsp--cancelable-requests (ht)) + +(cl-defun lsp-request-async (method params callback + &key mode error-handler cancel-handler no-merge cancel-token) + "Send METHOD with PARAMS as a request to the language server. +Call CALLBACK with the response received from the server +asynchronously. +MODE determines when the callback will be called depending on the +condition of the original buffer. It could be: +- `detached' which means that the callback will be executed no +matter what has happened to the buffer. +- `alive' - the callback will be executed only if the buffer from +which the call was executed is still alive. +- `current' the callback will be executed only if the original buffer +is still selected. +- `tick' - the callback will be executed only if the buffer was not modified. +- `unchanged' - the callback will be executed only if the buffer hasn't +changed and if the buffer is not modified. + +ERROR-HANDLER will be called in case the request has failed. +CANCEL-HANDLER will be called in case the request is being canceled. +If NO-MERGE is non-nil, don't merge the results but return alist +workspace->result. +CANCEL-TOKEN is the token that can be used to cancel request." + (lsp--send-request-async `(:jsonrpc "2.0" :method ,method :params ,params) + callback mode error-handler cancel-handler no-merge cancel-token)) + +(defun lsp--create-request-cancel (id workspaces hook buf method cancel-callback) + (lambda (&rest _) + (unless (and (equal 'post-command-hook hook) + (equal (current-buffer) buf)) + (lsp--request-cleanup-hooks id) + (with-lsp-workspaces workspaces + (lsp--cancel-request id) + (when cancel-callback (funcall cancel-callback))) + (lsp-log "Cancelling %s(%s) in hook %s" method id hook)))) + +(defun lsp--create-async-callback + (callback method no-merge workspaces) + "Create async handler expecting COUNT results, merge them and call CALLBACK. +MODE determines when the callback will be called depending on the +condition of the original buffer. METHOD is the invoked method. +If NO-MERGE is non-nil, don't merge the results but return alist +workspace->result. ID is the request id." + (let (results errors) + (lambda (result) + (push (cons lsp--cur-workspace result) + (if (eq result :error) errors results)) + (when (and (not (eq (length errors) (length workspaces))) + (eq (+ (length errors) (length results)) (length workspaces))) + (funcall callback + (if no-merge + results + (lsp--merge-results (-map #'cl-rest results) method))))))) + +(defcustom lsp-default-create-error-handler-fn nil + "Default error handler customization. +Handler should give METHOD as argument and return function of one argument +ERROR." + :type 'function + :group 'lsp-mode + :package-version '(lsp-mode . "9.0.0")) + +(defun lsp--create-default-error-handler (method) + "Default error handler. +METHOD is the executed method." + (if lsp-default-create-error-handler-fn + (funcall lsp-default-create-error-handler-fn method) + (lambda (error) + (lsp--warn "%s" (or (lsp--error-string error) + (format "%s Request has failed" method)))))) + +(defvar lsp--request-cleanup-hooks (ht)) + +(defun lsp--request-cleanup-hooks (request-id) + (when-let* ((cleanup-function (gethash request-id lsp--request-cleanup-hooks))) + (funcall cleanup-function) + (remhash request-id lsp--request-cleanup-hooks))) + +(defun lsp-cancel-request-by-token (cancel-token) + "Cancel request using CANCEL-TOKEN." + (-when-let ((request-id . workspaces) (gethash cancel-token lsp--cancelable-requests)) + (with-lsp-workspaces workspaces + (lsp--cancel-request request-id)) + (remhash cancel-token lsp--cancelable-requests) + (lsp--request-cleanup-hooks request-id))) + +(defun lsp--send-request-async (body callback + &optional mode error-callback cancel-callback + no-merge cancel-token) + "Send BODY as a request to the language server. +Call CALLBACK with the response received from the server +asynchronously. +MODE determines when the callback will be called depending on the +condition of the original buffer. It could be: +- `detached' which means that the callback will be executed no +matter what has happened to the buffer. +- `alive' - the callback will be executed only if the buffer from +which the call was executed is still alive. +- `current' the callback will be executed only if the original buffer +is still selected. +- `tick' - the callback will be executed only if the buffer was not modified. +- `unchanged' - the callback will be executed only if the buffer hasn't +changed and if the buffer is not modified. + +ERROR-CALLBACK will be called in case the request has failed. +CANCEL-CALLBACK will be called in case the request is being canceled. +If NO-MERGE is non-nil, don't merge the results but return alist +workspace->result. +CANCEL-TOKEN is the token that can be used to cancel request." + (when cancel-token + (lsp-cancel-request-by-token cancel-token)) + + (if-let* ((target-workspaces (lsp--find-workspaces-for body))) + (let* ((start-time (current-time)) + (method (plist-get body :method)) + (id (cl-incf lsp-last-id)) + (buf (current-buffer)) + (cancel-callback (when cancel-callback + (pcase mode + ((or 'alive 'tick 'unchanged) + (lambda () + (with-current-buffer buf + (funcall cancel-callback)))) + (_ cancel-callback)))) + ;; calculate what are the (hook . local) pairs which will cancel + ;; the request + (hooks (pcase mode + ('alive '((kill-buffer-hook . t))) + ('tick '((kill-buffer-hook . t) (after-change-functions . t))) + ('unchanged '((after-change-functions . t) (post-command-hook . nil))) + ('current '((post-command-hook . nil))))) + ;; note: lambdas in emacs can be compared but we should make sure + ;; that all of the captured arguments are the same - in our case + ;; `lsp--create-request-cancel' will return the same lambda when + ;; called with the same params. + (cleanup-hooks + (lambda () (mapc + (-lambda ((hook . local)) + (if local + (when (buffer-live-p buf) + (with-current-buffer buf + (remove-hook hook + (lsp--create-request-cancel + id target-workspaces hook buf method cancel-callback) + t))) + (remove-hook hook (lsp--create-request-cancel + id target-workspaces hook buf method cancel-callback)))) + hooks) + (remhash cancel-token lsp--cancelable-requests))) + (callback (pcase mode + ((or 'alive 'tick 'unchanged) (lambda (&rest args) + (with-current-buffer buf + (apply callback args)))) + (_ callback))) + (callback (lsp--create-async-callback callback + method + no-merge + target-workspaces)) + (callback (lambda (result) + (lsp--request-cleanup-hooks id) + (funcall callback result))) + (error-callback (lsp--create-async-callback + (or error-callback + (lsp--create-default-error-handler method)) + method + nil + target-workspaces)) + (error-callback (lambda (error) + (funcall callback :error) + (lsp--request-cleanup-hooks id) + (funcall error-callback error))) + (body (plist-put body :id id))) + + ;; cancel request in any of the hooks + (mapc (-lambda ((hook . local)) + (add-hook hook + (lsp--create-request-cancel + id target-workspaces hook buf method cancel-callback) + nil local)) + hooks) + (puthash id cleanup-hooks lsp--request-cleanup-hooks) + + (setq lsp--last-active-workspaces target-workspaces) + + (when cancel-token + (puthash cancel-token (cons id target-workspaces) lsp--cancelable-requests)) + + (seq-doseq (workspace target-workspaces) + (when (lsp--log-io-p method) + (lsp--log-entry-new (lsp--make-log-entry method id + (plist-get body :params) + 'outgoing-req) + workspace)) + (puthash id + (list callback error-callback method start-time (current-time)) + (-> workspace + (lsp--workspace-client) + (lsp--client-response-handlers))) + (lsp--send-no-wait body (lsp--workspace-proc workspace))) + body) + (error "The connected server(s) does not support method %s. +To find out what capabilities support your server use `M-x lsp-describe-session' +and expand the capabilities section" + (plist-get body :method)))) + +;; deprecated, use lsp-request-async. +(defalias 'lsp-send-request-async 'lsp--send-request-async) +(make-obsolete 'lsp-send-request-async 'lsp-request-async "lsp-mode 7.0.1") + +;; Clean up the entire state of lsp mode when Emacs is killed, to get rid of any +;; pending language servers. +(add-hook 'kill-emacs-hook #'lsp--global-teardown) + +(defun lsp--global-teardown () + "Unload working workspaces." + (lsp-foreach-workspace (lsp--shutdown-workspace))) + +(defun lsp--shutdown-workspace (&optional restart) + "Shut down the language server process for ‘lsp--cur-workspace’." + (with-demoted-errors "LSP error: %S" + (let ((lsp-response-timeout 0.5)) + (condition-case err + (lsp-request "shutdown" nil) + (error (lsp--error "%s" err)))) + (lsp-notify "exit" nil)) + (setf (lsp--workspace-shutdown-action lsp--cur-workspace) (or (and restart 'restart) 'shutdown)) + (lsp--uninitialize-workspace)) + +(defcustom lsp-inlay-hint-enable nil + "If non-nil it will enable inlay hints." + :type 'boolean + :group 'lsp-mode + :package-version '(lsp-mode . "9.0.0")) + +(defun lsp--uninitialize-workspace () + "Cleanup buffer state. +When a workspace is shut down, by request or from just +disappearing, unset all the variables related to it." + (-let [(&lsp-wks 'cmd-proc 'buffers) lsp--cur-workspace] + (lsp-process-kill cmd-proc) + (mapc (lambda (buf) + (when (lsp-buffer-live-p buf) + (lsp-with-current-buffer buf + (lsp-managed-mode -1)))) + buffers) + (lsp-diagnostics--workspace-cleanup lsp--cur-workspace))) + +(defun lsp--client-capabilities (&optional custom-capabilities) + "Return the client capabilities appending CUSTOM-CAPABILITIES." + (append + `((general . ((positionEncodings . ["utf-32", "utf-16"]))) + (workspace . ((workspaceEdit . ((documentChanges . t) + (resourceOperations . ["create" "rename" "delete"]))) + (applyEdit . t) + (symbol . ((symbolKind . ((valueSet . ,(apply 'vector (number-sequence 1 26))))))) + (executeCommand . ((dynamicRegistration . :json-false))) + ,@(when lsp-enable-file-watchers '((didChangeWatchedFiles . ((dynamicRegistration . t))))) + (workspaceFolders . t) + (configuration . t) + ,@(when lsp-semantic-tokens-enable + `((semanticTokens . ((refreshSupport . ,(or (and (boundp 'lsp-semantic-tokens-honor-refresh-requests) + lsp-semantic-tokens-honor-refresh-requests) + :json-false)))))) + ,@(when lsp-lens-enable '((codeLens . ((refreshSupport . t))))) + ,@(when lsp-inlay-hint-enable '((inlayHint . ((refreshSupport . :json-false))))) + (diagnostics . ((refreshSupport . :json-false))) + (fileOperations . ((didCreate . :json-false) + (willCreate . :json-false) + (didRename . t) + (willRename . t) + (didDelete . :json-false) + (willDelete . :json-false))))) + (textDocument . ((declaration . ((dynamicRegistration . t) + (linkSupport . t))) + (definition . ((dynamicRegistration . t) + (linkSupport . t))) + (references . ((dynamicRegistration . t))) + (implementation . ((dynamicRegistration . t) + (linkSupport . t))) + (typeDefinition . ((dynamicRegistration . t) + (linkSupport . t))) + (synchronization . ((willSave . t) (didSave . t) (willSaveWaitUntil . t))) + (documentSymbol . ((symbolKind . ((valueSet . ,(apply 'vector (number-sequence 1 26))))) + (hierarchicalDocumentSymbolSupport . t))) + (formatting . ((dynamicRegistration . t))) + (rangeFormatting . ((dynamicRegistration . t))) + (onTypeFormatting . ((dynamicRegistration . t))) + ,@(when (and lsp-semantic-tokens-enable + (functionp 'lsp--semantic-tokens-capabilities)) + (lsp--semantic-tokens-capabilities)) + (rename . ((dynamicRegistration . t) (prepareSupport . t))) + (codeAction . ((dynamicRegistration . t) + (isPreferredSupport . t) + (codeActionLiteralSupport . ((codeActionKind . ((valueSet . ["" + "quickfix" + "refactor" + "refactor.extract" + "refactor.inline" + "refactor.rewrite" + "source" + "source.organizeImports"]))))) + (resolveSupport . ((properties . ["edit" "command"]))) + (dataSupport . t))) + (completion . ((completionItem . ((snippetSupport . ,(cond + ((and lsp-enable-snippet (not (fboundp 'yas-minor-mode))) + (lsp--warn (concat + "Yasnippet is not installed, but `lsp-enable-snippet' is set to `t'. " + "You must either install yasnippet, or disable snippet support.")) + :json-false) + (lsp-enable-snippet t) + (t :json-false))) + (documentationFormat . ["markdown" "plaintext"]) + ;; Remove this after jdtls support resolveSupport + (resolveAdditionalTextEditsSupport . t) + (insertReplaceSupport . t) + (deprecatedSupport . t) + (resolveSupport + . ((properties . ["documentation" + "detail" + "additionalTextEdits" + "command" + "insertTextFormat" + "insertTextMode"]))) + (insertTextModeSupport . ((valueSet . [1 2]))))) + (contextSupport . t) + (dynamicRegistration . t))) + (signatureHelp . ((signatureInformation . ((parameterInformation . ((labelOffsetSupport . t))))) + (dynamicRegistration . t))) + (documentLink . ((dynamicRegistration . t) + (tooltipSupport . t))) + (hover . ((contentFormat . ["markdown" "plaintext"]) + (dynamicRegistration . t))) + ,@(when lsp-enable-folding + `((foldingRange . ((dynamicRegistration . t) + ,@(when lsp-folding-range-limit + `((rangeLimit . ,lsp-folding-range-limit))) + ,@(when lsp-folding-line-folding-only + `((lineFoldingOnly . t))))))) + (selectionRange . ((dynamicRegistration . t))) + (callHierarchy . ((dynamicRegistration . :json-false))) + (typeHierarchy . ((dynamicRegistration . t))) + (publishDiagnostics . ((relatedInformation . t) + (tagSupport . ((valueSet . [1 2]))) + (versionSupport . t))) + (diagnostic . ((dynamicRegistration . :json-false) + (relatedDocumentSupport . :json-false))) + (linkedEditingRange . ((dynamicRegistration . t))))) + (window . ((workDoneProgress . t) + (showDocument . ((support . t)))))) + custom-capabilities)) + +(defun lsp-find-roots-for-workspace (workspace session) + "Get all roots for the WORKSPACE." + (-filter #'identity (ht-map (lambda (folder workspaces) + (when (-contains? workspaces workspace) + folder)) + (lsp-session-folder->servers session)))) + +(defun lsp-session-watches (&optional session) + "Get watches created for SESSION." + (or (gethash "__watches" (lsp-session-metadata (or session (lsp-session)))) + (-let [res (make-hash-table :test 'equal)] + (puthash "__watches" res (lsp-session-metadata (or session (lsp-session)))) + res))) + +(defun lsp--file-process-event (session root-folder event) + "Process file event." + (let* ((changed-file (cl-third event)) + (rel-changed-file (f-relative changed-file root-folder)) + (event-numeric-kind (alist-get (cl-second event) lsp--file-change-type)) + (bit-position (1- event-numeric-kind)) + (watch-bit (ash 1 bit-position))) + (->> + session + lsp-session-folder->servers + (gethash root-folder) + (seq-do (lambda (workspace) + (when (->> + workspace + lsp--workspace-registered-server-capabilities + (-any? + (lambda (capability) + (and + (equal (lsp--registered-capability-method capability) + "workspace/didChangeWatchedFiles") + (->> + capability + lsp--registered-capability-options + (lsp:did-change-watched-files-registration-options-watchers) + (seq-find + (-lambda ((fs-watcher &as &FileSystemWatcher :glob-pattern :kind? :_cachedRegexp cached-regexp)) + (when (or (null kind?) + (> (logand kind? watch-bit) 0)) + (-let [regexes (or cached-regexp + (let ((regexp (lsp-glob-to-regexps glob-pattern))) + (lsp-put fs-watcher :_cachedRegexp regexp) + regexp))] + (-any? (lambda (re) + (or (string-match re changed-file) + (string-match re rel-changed-file))) + regexes)))))))))) + (with-lsp-workspace workspace + (lsp-notify + "workspace/didChangeWatchedFiles" + `((changes . [((type . ,event-numeric-kind) + (uri . ,(lsp--path-to-uri changed-file)))])))))))))) + +(lsp-defun lsp--server-register-capability ((&Registration :method :id :register-options?)) + "Register capability REG." + (when (and lsp-enable-file-watchers + (equal method "workspace/didChangeWatchedFiles")) + (-let* ((created-watches (lsp-session-watches (lsp-session))) + (root-folders (cl-set-difference + (lsp-find-roots-for-workspace lsp--cur-workspace (lsp-session)) + (ht-keys created-watches)))) + ;; create watch for each root folder without such + (dolist (folder root-folders) + (let* ((watch (make-lsp-watch :root-directory folder)) + (ignored-things (lsp--get-ignored-regexes-for-workspace-root folder)) + (ignored-files-regex-list (car ignored-things)) + (ignored-directories-regex-list (cadr ignored-things))) + (puthash folder watch created-watches) + (lsp-watch-root-folder (file-truename folder) + (-partial #'lsp--file-process-event (lsp-session) folder) + ignored-files-regex-list + ignored-directories-regex-list + watch + t))))) + + (push + (make-lsp--registered-capability :id id :method method :options register-options?) + (lsp--workspace-registered-server-capabilities lsp--cur-workspace))) + +(defmacro lsp--with-workspace-temp-buffer (workspace-root &rest body) + "With a temp-buffer under `WORKSPACE-ROOT' and evaluate `BODY', useful to +access dir-local variables." + (declare (indent 1) (debug t)) + `(with-temp-buffer + ;; Set the buffer's name to something under the root so that we can hack the local variables + ;; This file doesn't need to exist and will not be created due to this. + (setq-local buffer-file-name (expand-file-name "lsp-mode-temp" (expand-file-name ,workspace-root))) + (hack-local-variables) + (prog1 ,@body + (setq-local buffer-file-name nil)))) + +(defun lsp--get-ignored-regexes-for-workspace-root (workspace-root) + "Return a list of the form +(lsp-file-watch-ignored-files lsp-file-watch-ignored-directories) for the given +WORKSPACE-ROOT." + ;; The intent of this function is to provide per-root workspace-level customization of the + ;; lsp-file-watch-ignored-directories and lsp-file-watch-ignored-files variables. + (lsp--with-workspace-temp-buffer workspace-root + (list lsp-file-watch-ignored-files (lsp-file-watch-ignored-directories)))) + + +(defun lsp--cleanup-hanging-watches () + "Cleanup watches in case there are no more workspaces that are interested +in that particular folder." + (let* ((session (lsp-session)) + (watches (lsp-session-watches session))) + (dolist (watched-folder (ht-keys watches)) + (when (-none? (lambda (workspace) + (with-lsp-workspace workspace + (lsp--registered-capability "workspace/didChangeWatchedFiles"))) + (gethash watched-folder (lsp-session-folder->servers (lsp-session)))) + (lsp-log "Cleaning up watches for folder %s. There is no workspace watching this folder..." watched-folder) + (lsp-kill-watch (gethash watched-folder watches)) + (remhash watched-folder watches))))) + +(lsp-defun lsp--server-unregister-capability ((&Unregistration :id :method)) + "Unregister capability UNREG." + (setf (lsp--workspace-registered-server-capabilities lsp--cur-workspace) + (seq-remove (lambda (e) (equal (lsp--registered-capability-id e) id)) + (lsp--workspace-registered-server-capabilities lsp--cur-workspace))) + (when (equal method "workspace/didChangeWatchedFiles") + (lsp--cleanup-hanging-watches))) + +(defun lsp--server-capabilities () + "Return the capabilities of the language server associated with the buffer." + (->> (lsp-workspaces) + (-keep #'lsp--workspace-server-capabilities) + (apply #'lsp-merge))) + +(defun lsp--send-open-close-p () + "Return whether open and close notifications should be sent to the server." + (let ((sync (lsp:server-capabilities-text-document-sync? (lsp--server-capabilities)))) + (or (memq sync '(1 2)) + (lsp:text-document-sync-options-open-close? sync)))) + +(defun lsp--send-will-save-p () + "Return whether willSave notifications should be sent to the server." + (-> (lsp--server-capabilities) + (lsp:server-capabilities-text-document-sync?) + (lsp:text-document-sync-options-will-save?))) + +(defun lsp--send-will-save-wait-until-p () + "Return whether willSaveWaitUntil notifications should be sent to the server." + (-> (lsp--server-capabilities) + (lsp:server-capabilities-text-document-sync?) + (lsp:text-document-sync-options-will-save-wait-until?))) + +(defun lsp--send-did-save-p () + "Return whether didSave notifications should be sent to the server." + (let ((sync (lsp:server-capabilities-text-document-sync? (lsp--server-capabilities)))) + (or (memq sync '(1 2)) + (lsp:text-document-sync-options-save? sync)))) + +(defun lsp--save-include-text-p () + "Return whether save notifications should include the text document's contents." + (->> (lsp--server-capabilities) + (lsp:server-capabilities-text-document-sync?) + (lsp:text-document-sync-options-save?) + (lsp:text-document-save-registration-options-include-text?))) + +(defun lsp--send-will-rename-files-p (path) + "Return whether willRenameFiles request should be sent to the server. +If any filters, checks if it applies for PATH." + (let* ((will-rename (-> (lsp--server-capabilities) + (lsp:server-capabilities-workspace?) + (lsp:workspace-server-capabilities-file-operations?) + (lsp:workspace-file-operations-will-rename?))) + (filters (seq-into (lsp:file-operation-registration-options-filters will-rename) 'list))) + (and will-rename + (or (seq-empty-p filters) + (-any? (-lambda ((&FileOperationFilter :scheme? :pattern (&FileOperationPattern :glob))) + (-let [regexes (lsp-glob-to-regexps glob)] + (and (or (not scheme?) + (string-prefix-p scheme? (lsp--path-to-uri path))) + (-any? (lambda (re) + (string-match re path)) + regexes)))) + filters))))) + +(defun lsp--send-did-rename-files-p () + "Return whether didRenameFiles notification should be sent to the server." + (-> (lsp--server-capabilities) + (lsp:server-capabilities-workspace?) + (lsp:workspace-server-capabilities-file-operations?) + (lsp:workspace-file-operations-did-rename?))) + +(declare-function project-roots "ext:project" (project) t) +(declare-function project-root "ext:project" (project) t) + +(defun lsp--suggest-project-root () + "Get project root." + (or + (when (fboundp 'projectile-project-root) + (condition-case nil + (projectile-project-root) + (error nil))) + (when (fboundp 'project-current) + (when-let* ((project (project-current))) + (if (fboundp 'project-root) + (project-root project) + (car (with-no-warnings + (project-roots project)))))) + default-directory)) + +(defun lsp--read-from-file (file) + "Read FILE content." + (when (file-exists-p file) + (cl-first (read-from-string (f-read-text file 'utf-8))))) + +(defun lsp--persist (file-name to-persist) + "Persist TO-PERSIST in FILE-NAME. + +This function creates the parent directories if they don't exist +yet." + (let ((print-length nil) + (print-level nil)) + ;; Create all parent directories: + (make-directory (f-parent file-name) t) + (f-write-text (prin1-to-string to-persist) 'utf-8 file-name))) + +(defun lsp-workspace-folders-add (project-root) + "Add PROJECT-ROOT to the list of workspace folders." + (interactive + (list (read-directory-name "Select folder to add: " + (or (lsp--suggest-project-root) default-directory) nil t))) + (cl-pushnew (lsp-f-canonical project-root) + (lsp-session-folders (lsp-session)) :test 'equal) + (lsp--persist-session (lsp-session)) + + (run-hook-with-args 'lsp-workspace-folders-changed-functions (list project-root) nil)) + +(defun lsp-workspace-folders-remove (project-root) + "Remove PROJECT-ROOT from the list of workspace folders." + (interactive (list (completing-read "Select folder to remove: " + (lsp-session-folders (lsp-session)) + nil t nil nil + (lsp-find-session-folder (lsp-session) default-directory)))) + + (setq project-root (lsp-f-canonical project-root)) + + ;; send remove folder to each multiroot workspace associated with the folder + (dolist (wks (->> (lsp-session) + (lsp-session-folder->servers) + (gethash project-root) + (--filter (lsp--client-multi-root (lsp--workspace-client it))))) + (with-lsp-workspace wks + (lsp-notify "workspace/didChangeWorkspaceFolders" + (lsp-make-did-change-workspace-folders-params + :event (lsp-make-workspace-folders-change-event + :removed (vector (lsp-make-workspace-folder + :uri (lsp--path-to-uri project-root) + :name (f-filename project-root))) + :added []))))) + + ;; turn off servers in the removed directory + (let* ((session (lsp-session)) + (folder->servers (lsp-session-folder->servers session)) + (server-id->folders (lsp-session-server-id->folders session)) + (workspaces (gethash project-root folder->servers))) + + (remhash project-root folder->servers) + + ;; turn off the servers without root folders + (dolist (workspace workspaces) + (when (--none? (-contains? it workspace) (ht-values folder->servers)) + (lsp--info "Shutdown %s since folder %s is removed..." + (lsp--workspace-print workspace) project-root) + (with-lsp-workspace workspace (lsp--shutdown-workspace)))) + + (setf (lsp-session-folders session) + (-remove-item project-root (lsp-session-folders session))) + + (ht-aeach (puthash key + (-remove-item project-root value) + server-id->folders) + server-id->folders) + (lsp--persist-session (lsp-session))) + + (run-hook-with-args 'lsp-workspace-folders-changed-functions nil (list project-root))) + +(defun lsp-workspace-blocklist-remove (project-root) + "Remove PROJECT-ROOT from the workspace blocklist." + (interactive (list (completing-read "Select folder to remove:" + (lsp-session-folders-blocklist (lsp-session)) + nil t))) + (setf (lsp-session-folders-blocklist (lsp-session)) + (delete project-root + (lsp-session-folders-blocklist (lsp-session)))) + (lsp--persist-session (lsp-session))) + +(define-obsolete-function-alias 'lsp-workspace-folders-switch + 'lsp-workspace-folders-open "lsp-mode 6.1") + +(defun lsp-workspace-folders-open (project-root) + "Open the directory located at PROJECT-ROOT" + (interactive (list (completing-read "Open folder: " + (lsp-session-folders (lsp-session)) + nil t))) + (find-file project-root)) + +(defun lsp--maybe-enable-signature-help (trigger-characters) + (let ((ch last-command-event)) + (when (cl-find ch trigger-characters :key #'string-to-char) + (lsp-signature-activate)))) + +(defun lsp--on-type-formatting-handler-create () + (when-let* ((provider (lsp--capability-for-method "textDocument/onTypeFormatting" ))) + (-let [(&DocumentOnTypeFormattingOptions :more-trigger-character? + :first-trigger-character) provider] + (lambda () + (lsp--on-type-formatting first-trigger-character + more-trigger-character?))))) + +(defun lsp--update-on-type-formatting-hook (&optional cleanup?) + (let ((on-type-formatting-handler (lsp--on-type-formatting-handler-create))) + (cond + ((and lsp-enable-on-type-formatting on-type-formatting-handler (not cleanup?)) + (add-hook 'post-self-insert-hook on-type-formatting-handler nil t)) + ((or cleanup? + (not lsp-enable-on-type-formatting)) + (remove-hook 'post-self-insert-hook on-type-formatting-handler t))))) + +(defun lsp--signature-help-handler-create () + (-when-let ((&SignatureHelpOptions? :trigger-characters?) + (lsp--capability-for-method "textDocument/signatureHelp")) + (lambda () + (lsp--maybe-enable-signature-help trigger-characters?)))) + +(defun lsp--update-signature-help-hook (&optional cleanup?) + (let ((signature-help-handler (lsp--signature-help-handler-create))) + (cond + ((and (or (equal lsp-signature-auto-activate t) + (memq :on-trigger-char lsp-signature-auto-activate)) + signature-help-handler + (not cleanup?)) + (add-hook 'post-self-insert-hook signature-help-handler nil t)) + + ((or cleanup? + (not (or (equal lsp-signature-auto-activate t) + (memq :on-trigger-char lsp-signature-auto-activate)))) + (remove-hook 'post-self-insert-hook signature-help-handler t))))) + +(defun lsp--after-set-visited-file-name () + (lsp-disconnect) + (lsp)) + +;; TODO remove those eldoc workarounds when dropping support for Emacs 27 +;; https://github.com/emacs-lsp/lsp-mode/issues/3295#issuecomment-1308994099 +(defvar eldoc-documentation-default) ; CI +(when (< emacs-major-version 28) + (unless (boundp 'eldoc-documentation-functions) + (load "eldoc" nil 'nomessage)) + (when (memq (default-value 'eldoc-documentation-function) '(nil ignore)) + ;; actually `eldoc-documentation-strategy', but CI was failing + (setq-default eldoc-documentation-function 'eldoc-documentation-default))) + +(define-minor-mode lsp-managed-mode + "Mode for source buffers managed by lsp-mode." + :lighter nil + (cond + (lsp-managed-mode + (when (lsp-feature? "textDocument/hover") + (add-hook 'eldoc-documentation-functions #'lsp-eldoc-function nil t) + (eldoc-mode 1)) + + (add-hook 'after-change-functions #'lsp-on-change nil t) + (add-hook 'after-revert-hook #'lsp-on-revert nil t) + (add-hook 'after-save-hook #'lsp-on-save nil t) + (add-hook 'auto-save-hook #'lsp--on-auto-save nil t) + (add-hook 'before-change-functions #'lsp-before-change nil t) + (add-hook 'before-save-hook #'lsp--before-save nil t) + (add-hook 'kill-buffer-hook #'lsp--text-document-did-close nil t) + (add-hook 'post-command-hook #'lsp--post-command nil t) + + (lsp--update-on-type-formatting-hook) + (lsp--update-signature-help-hook) + + (when lsp-enable-xref + (add-hook 'xref-backend-functions #'lsp--xref-backend nil t)) + + (lsp-configure-buffer) + + ;; make sure we turn off lsp-mode in case major mode changes, because major + ;; mode change will wipe the buffer locals. + (add-hook 'change-major-mode-hook #'lsp-disconnect nil t) + (add-hook 'after-set-visited-file-name-hook #'lsp--after-set-visited-file-name nil t) + + (let ((buffer (lsp-current-buffer))) + (run-with-idle-timer + 0.0 nil + (lambda () + (when (lsp-buffer-live-p buffer) + (lsp-with-current-buffer buffer + (lsp--on-change-debounce buffer) + (lsp--on-idle buffer))))))) + (t + (lsp-unconfig-buffer) + + (remove-hook 'eldoc-documentation-functions #'lsp-eldoc-function t) + (remove-hook 'post-command-hook #'lsp--post-command t) + (remove-hook 'after-change-functions #'lsp-on-change t) + (remove-hook 'after-revert-hook #'lsp-on-revert t) + (remove-hook 'after-save-hook #'lsp-on-save t) + (remove-hook 'auto-save-hook #'lsp--on-auto-save t) + (remove-hook 'before-change-functions #'lsp-before-change t) + (remove-hook 'before-save-hook #'lsp--before-save t) + (remove-hook 'kill-buffer-hook #'lsp--text-document-did-close t) + + (lsp--update-on-type-formatting-hook :cleanup) + (lsp--update-signature-help-hook :cleanup) + + (when lsp--on-idle-timer + (cancel-timer lsp--on-idle-timer) + (setq lsp--on-idle-timer nil)) + + (remove-hook 'lsp-on-idle-hook #'lsp--document-links t) + (remove-hook 'lsp-on-idle-hook #'lsp--document-highlight t) + + (lsp--remove-overlays 'lsp-highlight) + (lsp--remove-overlays 'lsp-links) + + (remove-hook 'xref-backend-functions #'lsp--xref-backend t) + (remove-hook 'change-major-mode-hook #'lsp-disconnect t) + (remove-hook 'after-set-visited-file-name-hook #'lsp--after-set-visited-file-name t) + (setq-local lsp-buffer-uri nil)))) + +(defun lsp-configure-buffer () + "Configure LSP features for current buffer." + ;; make sure the core is running in the context of all available workspaces + ;; to avoid misconfiguration in case we are running in `with-lsp-workspace' context + (let ((lsp--buffer-workspaces (cond + (lsp--buffer-workspaces) + (lsp--cur-workspace (list lsp--cur-workspace)))) + lsp--cur-workspace) + (when lsp-auto-configure + (lsp--auto-configure) + + (when (and lsp-enable-text-document-color + (lsp-feature? "textDocument/documentColor")) + (add-hook 'lsp-on-change-hook #'lsp--document-color nil t)) + + (when (and lsp-enable-imenu + (lsp-feature? "textDocument/documentSymbol")) + (lsp-enable-imenu)) + + (when (and lsp-enable-indentation + (lsp-feature? "textDocument/rangeFormatting")) + (add-function :override (local 'indent-region-function) #'lsp-format-region)) + + (when (and lsp-enable-symbol-highlighting + (lsp-feature? "textDocument/documentHighlight")) + (add-hook 'lsp-on-idle-hook #'lsp--document-highlight nil t)) + + (when (and lsp-enable-links + (lsp-feature? "textDocument/documentLink")) + (add-hook 'lsp-on-idle-hook #'lsp--document-links nil t)) + + (when (and lsp-inlay-hint-enable + (lsp-feature? "textDocument/inlayHint")) + (lsp-inlay-hints-mode)) + + (when (and lsp-enable-dap-auto-configure + (functionp 'dap-mode)) + (dap-auto-configure-mode 1))) + (run-hooks 'lsp-configure-hook))) + +(defun lsp-unconfig-buffer () + "Unconfigure LSP features for buffer." + (lsp--remove-overlays 'lsp-color) + + (when (advice-function-member-p 'lsp--imenu-create-index imenu-create-index-function) + (remove-function (local 'imenu-create-index-function) #'lsp--imenu-create-index) + (setq-local imenu-menubar-modified-tick 0) + (setq-local imenu--index-alist nil) + (imenu--cleanup)) + + (remove-function (local 'indent-region-function) #'lsp-format-region) + + (remove-hook 'lsp-on-change-hook #'lsp--document-color t) + (remove-hook 'lsp-on-idle-hook #'lsp--document-highlight t) + (remove-hook 'lsp-on-idle-hook #'lsp--document-links t) + + (when (and lsp-enable-dap-auto-configure + (functionp 'dap-mode)) + (dap-auto-configure-mode -1)) + + (run-hooks 'lsp-unconfigure-hook)) + +(defun lsp--buffer-content () + (lsp-save-restriction-and-excursion + (or (lsp-virtual-buffer-call :buffer-string) + (buffer-substring-no-properties (point-min) + (point-max))))) + +(defun lsp--text-document-did-open () + "`document/didOpen' event." + (run-hooks 'lsp-before-open-hook) + (when (and lsp-auto-touch-files + (not (f-exists? (lsp--uri-to-path (lsp--buffer-uri))))) + (lsp--info "Saving file '%s' because it is not present on the disk." (lsp--buffer-uri)) + (save-buffer)) + + (setq lsp--cur-version (or lsp--cur-version 0)) + (cl-pushnew (lsp-current-buffer) (lsp--workspace-buffers lsp--cur-workspace)) + (lsp-notify + "textDocument/didOpen" + (list :textDocument + (list :uri (lsp--buffer-uri) + :languageId (lsp-buffer-language) + :version lsp--cur-version + :text (lsp--buffer-content)))) + + (lsp-managed-mode 1) + + (lsp-diagnostics--request-pull-diagnostics lsp--cur-workspace) + + (run-hooks 'lsp-after-open-hook) + (when-let* ((client (-some-> lsp--cur-workspace (lsp--workspace-client)))) + (-some-> (lsp--client-after-open-fn client) + (funcall)) + (-some-> (format "lsp-%s-after-open-hook" (lsp--client-server-id client)) + (intern-soft) + (run-hooks)))) + +(defun lsp--text-document-identifier () + "Make TextDocumentIdentifier." + (list :uri (lsp--buffer-uri))) + +(defun lsp--versioned-text-document-identifier () + "Make VersionedTextDocumentIdentifier." + (plist-put (lsp--text-document-identifier) :version lsp--cur-version)) + +(defun lsp--cur-line (&optional point) + (1- (line-number-at-pos point))) + +(defun lsp--cur-position () + "Make a Position object for the current point." + (or (lsp-virtual-buffer-call :cur-position) + (lsp-save-restriction-and-excursion + (list :line (lsp--cur-line) + :character (- (point) (line-beginning-position)))))) + +(defun lsp--point-to-position (point) + "Convert POINT to Position." + (lsp-save-restriction-and-excursion + (goto-char point) + (lsp--cur-position))) + +(defun lsp--range (start end) + "Make Range body from START and END." + ;; make sure start and end are Position objects + (list :start start :end end)) + +(defun lsp--region-to-range (start end) + "Make Range object for the current region." + (lsp--range (lsp--point-to-position start) + (lsp--point-to-position end))) + +(defun lsp--region-or-line () + "The active region or the current line." + (if (use-region-p) + (lsp--region-to-range (region-beginning) (region-end)) + (lsp--region-to-range (line-beginning-position) (line-end-position)))) + +(defun lsp--check-document-changes-version (document-changes) + "Verify that DOCUMENT-CHANGES have the proper version." + (unless (seq-every-p + (-lambda ((&TextDocumentEdit :text-document)) + (or + (not text-document) + (let* ((filename (-> text-document + lsp:versioned-text-document-identifier-uri + lsp--uri-to-path)) + (version (lsp:versioned-text-document-identifier-version? text-document))) + (with-current-buffer (find-file-noselect filename) + (or (null version) (zerop version) (= -1 version) + (equal version lsp--cur-version)))))) + document-changes) + (error "Document changes cannot be applied due to different document version"))) + +(defun lsp--apply-workspace-edit (workspace-edit &optional operation) + "Apply the WorkspaceEdit object WORKSPACE-EDIT. +OPERATION is symbol representing the source of this text edit." + (-let (((&WorkspaceEdit :document-changes? :changes?) workspace-edit)) + (if-let* ((document-changes (seq-reverse document-changes?))) + (progn + (lsp--check-document-changes-version document-changes) + (->> document-changes + (seq-filter (-lambda ((&CreateFile :kind)) (equal kind "create"))) + (seq-do (lambda (change) (lsp--apply-text-document-edit change operation)))) + (->> document-changes + (seq-filter (-lambda ((&CreateFile :kind)) + (and (or (not kind) (equal kind "edit")) + (not (equal kind "create"))))) + (seq-do (lambda (change) (lsp--apply-text-document-edit change operation)))) + (->> document-changes + (seq-filter (-lambda ((&CreateFile :kind)) + (and (not (or (not kind) (equal kind "edit"))) + (not (equal kind "create"))))) + (seq-do (lambda (change) (lsp--apply-text-document-edit change operation))))) + (lsp-map + (lambda (uri text-edits) + (with-current-buffer (-> uri lsp--uri-to-path find-file-noselect) + (lsp--apply-text-edits text-edits operation))) + changes?)))) + +(defmacro lsp-with-filename (file &rest body) + "Execute BODY with FILE as a context. +Need to handle the case when FILE indicates virtual buffer." + (declare (indent 1) (debug t)) + `(if-let* ((lsp--virtual-buffer (get-text-property 0 'lsp-virtual-buffer ,file))) + (lsp-with-current-buffer lsp--virtual-buffer + ,@body) + ,@body)) + +(defun lsp--apply-text-document-edit (edit &optional operation) + "Apply the TextDocumentEdit object EDIT. +OPERATION is symbol representing the source of this text edit. +If the file is not being visited by any buffer, it is opened with +`find-file-noselect'. +Because lsp-mode does not store previous document versions, the edit is only +applied if the version of the textDocument matches the version of the +corresponding file. + +interface TextDocumentEdit { + textDocument: VersionedTextDocumentIdentifier; + edits: TextEdit[]; +}" + (pcase (lsp:edit-kind edit) + ("create" (-let* (((&CreateFile :uri :options?) edit) + (file-name (lsp--uri-to-path uri))) + (mkdir (f-dirname file-name) t) + (f-touch file-name) + (when (lsp:create-file-options-overwrite? options?) + (f-write-text "" nil file-name)) + (find-file-noselect file-name))) + ("delete" (-let (((&DeleteFile :uri :options? (&DeleteFileOptions? :recursive?)) edit)) + (f-delete (lsp--uri-to-path uri) recursive?))) + ("rename" (-let* (((&RenameFile :old-uri :new-uri :options? (&RenameFileOptions? :overwrite?)) edit) + (old-file-name (lsp--uri-to-path old-uri)) + (new-file-name (lsp--uri-to-path new-uri)) + (buf (find-buffer-visiting old-file-name))) + (when buf + (lsp-with-current-buffer buf + (save-buffer) + (lsp--text-document-did-close))) + (mkdir (f-dirname new-file-name) t) + (rename-file old-file-name new-file-name overwrite?) + (when buf + (lsp-with-current-buffer buf + (set-buffer-modified-p nil) + (setq lsp-buffer-uri nil) + (set-visited-file-name new-file-name) + (lsp))))) + (_ (let ((file-name (->> edit + (lsp:text-document-edit-text-document) + (lsp:versioned-text-document-identifier-uri) + (lsp--uri-to-path)))) + (lsp-with-current-buffer (find-buffer-visiting file-name) + (lsp-with-filename file-name + (lsp--apply-text-edits (lsp:text-document-edit-edits edit) operation))))))) + +(lsp-defun lsp--position-compare ((&Position :line left-line + :character left-character) + (&Position :line right-line + :character right-character)) + "Return t if position LEFT is greater than RIGHT." + (if (= left-line right-line) + (> left-character right-character) + (> left-line right-line))) + +(lsp-defun lsp-point-in-range? (position (&Range :start :end)) + "Returns if POINT is in RANGE." + (not (or (lsp--position-compare start position) + (lsp--position-compare position end)))) + +(lsp-defun lsp--position-equal ((&Position :line left-line + :character left-character) + (&Position :line right-line + :character right-character)) + "Return whether LEFT and RIGHT positions are equal." + (and (= left-line right-line) + (= left-character right-character))) + +(lsp-defun lsp--text-edit-sort-predicate ((&TextEdit :range (&Range :start left-start :end left-end)) + (&TextEdit :range (&Range :start right-start :end right-end))) + (if (lsp--position-equal left-start right-start) + (lsp--position-compare left-end right-end) + (lsp--position-compare left-start right-start))) + +(lsp-defun lsp--apply-text-edit ((edit &as &TextEdit :range (&RangeToPoint :start :end) :new-text)) + "Apply the edits described in the TextEdit object in TEXT-EDIT." + (setq new-text (s-replace "\r" "" (or new-text ""))) + (lsp:set-text-edit-new-text edit new-text) + (goto-char start) + (delete-region start end) + (insert new-text)) + +;; WORKAROUND: typescript-language might send -1 when applying code actions. +;; see https://github.com/emacs-lsp/lsp-mode/issues/1582 +(lsp-defun lsp--fix-point ((point &as &Position :character :line)) + (-doto point + (lsp:set-position-line (max 0 line)) + (lsp:set-position-character (max 0 character)))) + +(lsp-defun lsp--apply-text-edit-replace-buffer-contents ((edit &as + &TextEdit + :range (&Range :start :end) + :new-text)) + "Apply the edits described in the TextEdit object in TEXT-EDIT. +The method uses `replace-buffer-contents'." + (setq new-text (s-replace "\r" "" (or new-text ""))) + (lsp:set-text-edit-new-text edit new-text) + (-let* ((source (current-buffer)) + ((beg . end) (lsp--range-to-region (lsp-make-range :start (lsp--fix-point start) + :end (lsp--fix-point end))))) + (with-temp-buffer + (insert new-text) + (let ((temp (current-buffer))) + (with-current-buffer source + (save-excursion + (save-restriction + (narrow-to-region beg end) + + ;; On emacs versions < 26.2, + ;; `replace-buffer-contents' is buggy - it calls + ;; change functions with invalid arguments - so we + ;; manually call the change functions here. + ;; + ;; See emacs bugs #32237, #32278: + ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32237 + ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32278 + (let ((inhibit-modification-hooks t) + (length (- end beg))) + (run-hook-with-args 'before-change-functions + beg end) + (replace-buffer-contents temp) + (run-hook-with-args 'after-change-functions + beg (+ beg (length new-text)) + length))))))))) + +(defun lsp--to-yasnippet-snippet (snippet) + "Convert LSP SNIPPET to yasnippet snippet." + ;; LSP snippet doesn't escape "{" and "`", but yasnippet requires escaping it. + (replace-regexp-in-string (rx (or bos (not (any "$" "\\"))) (group (or "{" "`"))) + (rx "\\" (backref 1)) + snippet + nil nil 1)) + +(defvar-local lsp-enable-relative-indentation nil + "Enable relative indentation when insert texts, snippets ... +from language server.") + +(defun lsp--expand-snippet (snippet &optional start end expand-env) + "Wrapper of `yas-expand-snippet' with all of it arguments. +The snippet will be convert to LSP style and indent according to +LSP server result." + (require 'yasnippet nil t) + (let* ((inhibit-field-text-motion t) + (yas-wrap-around-region nil) + (yas-indent-line 'none) + (yas-also-auto-indent-first-line nil)) + (yas-expand-snippet + (lsp--to-yasnippet-snippet snippet) + start end expand-env))) + +(defun lsp--indent-lines (start end &optional insert-text-mode?) + "Indent from START to END based on INSERT-TEXT-MODE? value. +- When INSERT-TEXT-MODE? is provided + - if it's `lsp/insert-text-mode-as-it', do no editor indentation. + - if it's `lsp/insert-text-mode-adjust-indentation', adjust leading + whitespaces to match the line where text is inserted. +- When it's not provided, using `indent-line-function' for each line." + (save-excursion + (goto-char end) + (let* ((end-line (line-number-at-pos)) + (offset (save-excursion + (goto-char start) + (current-indentation))) + (indent-line-function + (cond ((equal insert-text-mode? lsp/insert-text-mode-as-it) + #'ignore) + ((or (equal insert-text-mode? lsp/insert-text-mode-adjust-indentation) + lsp-enable-relative-indentation + ;; Indenting snippets is extremely slow in `org-mode' buffers + ;; since it has to calculate indentation based on SRC block + ;; position. Thus we use relative indentation as default. + (derived-mode-p 'org-mode)) + (lambda () (save-excursion + (beginning-of-line) + (indent-to-column offset)))) + (t indent-line-function)))) + (goto-char start) + (forward-line) + (while (and (not (eobp)) + (<= (line-number-at-pos) end-line)) + (funcall indent-line-function) + (forward-line))))) + +(defun lsp--apply-text-edits (edits &optional operation) + "Apply the EDITS described in the TextEdit[] object. +OPERATION is symbol representing the source of this text edit." + (unless (seq-empty-p edits) + (atomic-change-group + (run-hooks 'lsp-before-apply-edits-hook) + (let* ((change-group (prepare-change-group)) + (howmany (length edits)) + (message (format "Applying %s edits to `%s' ..." howmany (current-buffer))) + (_ (lsp--info message)) + (reporter (make-progress-reporter message 0 howmany)) + (done 0) + (apply-edit (if (not lsp--virtual-buffer) + #'lsp--apply-text-edit-replace-buffer-contents + #'lsp--apply-text-edit))) + (unwind-protect + (->> edits + ;; We sort text edits so as to apply edits that modify latter + ;; parts of the document first. Furthermore, because the LSP + ;; spec dictates that: "If multiple inserts have the same + ;; position, the order in the array defines which edit to + ;; apply first." We reverse the initial list and sort stably + ;; to make sure the order among edits with the same position + ;; is preserved. + (nreverse) + (seq-sort #'lsp--text-edit-sort-predicate) + (mapc (lambda (edit) + (progress-reporter-update reporter (cl-incf done)) + (funcall apply-edit edit) + (when (lsp:snippet-text-edit-insert-text-format? edit) + (-when-let ((&SnippetTextEdit :range (&RangeToPoint :start) + :insert-text-format? :new-text) edit) + (when (eq insert-text-format? lsp/insert-text-format-snippet) + ;; No `save-excursion' needed since expand snippet will change point anyway + (goto-char (+ start (length new-text))) + (lsp--indent-lines start (point)) + (lsp--expand-snippet new-text start (point))))) + (run-hook-with-args 'lsp-after-apply-edits-hook operation)))) + (undo-amalgamate-change-group change-group) + (progress-reporter-done reporter)))))) + +(defun lsp--create-apply-text-edits-handlers () + "Create (handler cleanup-fn) for applying text edits in async request. +Only works when mode is `tick or `alive." + (let* (first-edited + (func (lambda (start &rest _) + (setq first-edited (if first-edited + (min start first-edited) + start))))) + (add-hook 'before-change-functions func nil t) + (list + (lambda (edits) + (if (and first-edited + (seq-find (-lambda ((&TextEdit :range (&RangeToPoint :end))) + ;; Text edit region is overlapped + (> end first-edited)) + edits)) + (lsp--warn "TextEdits will not be applied since document has been modified before of them.") + (lsp--apply-text-edits edits 'completion-cleanup))) + (lambda () + (remove-hook 'before-change-functions func t))))) + +(defun lsp--capability (cap &optional capabilities) + "Get the value of capability CAP. If CAPABILITIES is non-nil, use them instead." + (when (stringp cap) + (setq cap (intern (concat ":" cap)))) + + (lsp-get (or capabilities + (lsp--server-capabilities)) + cap)) + +(defun lsp--registered-capability (method) + "Check whether there is workspace providing METHOD." + (->> (lsp-workspaces) + (--keep (seq-find (lambda (reg) + (equal (lsp--registered-capability-method reg) method)) + (lsp--workspace-registered-server-capabilities it))) + cl-first)) + +(defun lsp--capability-for-method (method) + "Get the value of capability for METHOD." + (-let* ((reqs (cdr (assoc method lsp-method-requirements))) + ((&plist :capability) reqs)) + (or (and capability (lsp--capability capability)) + (-some-> (lsp--registered-capability method) + (lsp--registered-capability-options))))) + +(defvar-local lsp--before-change-vals nil + "Store the positions from the `lsp-before-change' function call, for +validation and use in the `lsp-on-change' function.") + +(defun lsp--text-document-content-change-event (start end length) + "Make a TextDocumentContentChangeEvent body for START to END, of length LENGTH." + ;; So (47 54 0) means add 7 chars starting at pos 47 + ;; must become + ;; {"range":{"start":{"line":5,"character":6} + ;; ,"end" :{"line":5,"character":6}} + ;; ,"rangeLength":0 + ;; ,"text":"\nbb = 5"} + ;; + ;; And (47 47 7) means delete 7 chars starting at pos 47 + ;; must become + ;; {"range":{"start":{"line":6,"character":0} + ;; ,"end" :{"line":7,"character":0}} + ;; ,"rangeLength":7 + ;; ,"text":""} + ;; + ;; (208 221 3) means delete 3 chars starting at pos 208, and replace them with + ;; 13 chars. So it must become + ;; {"range":{"start":{"line":5,"character":8} + ;; ,"end" :{"line":5,"character":11}} + ;; ,"rangeLength":3 + ;; ,"text":"new-chars-xxx"} + ;; + + ;; Adding text: + ;; lsp-before-change:(start,end)=(33,33) + ;; lsp-on-change:(start,end,length)=(33,34,0) + ;; + ;; Changing text: + ;; lsp-before-change:(start,end)=(208,211) + ;; lsp-on-change:(start,end,length)=(208,221,3) + ;; + ;; Deleting text: + ;; lsp-before-change:(start,end)=(19,27) + ;; lsp-on-change:(start,end,length)=(19,19,8) + (if (zerop length) + ;; Adding something only, work from start only + `( :range ,(lsp--range + (lsp--point-to-position start) + (lsp--point-to-position start)) + :rangeLength 0 + :text ,(buffer-substring-no-properties start end)) + + (if (eq start end) + ;; Deleting something only + (if (lsp--bracketed-change-p start length) + ;; The before-change value is bracketed, use it + `( :range ,(lsp--range + (lsp--point-to-position start) + (plist-get lsp--before-change-vals :end-pos)) + :rangeLength ,length + :text "") + ;; If the change is not bracketed, send a full change event instead. + (lsp--full-change-event)) + + ;; Deleting some things, adding others + (if (lsp--bracketed-change-p start length) + ;; The before-change value is valid, use it + `( :range ,(lsp--range + (lsp--point-to-position start) + (plist-get lsp--before-change-vals :end-pos)) + :rangeLength ,length + :text ,(buffer-substring-no-properties start end)) + (lsp--full-change-event))))) + +(defun lsp--bracketed-change-p (start length) + "If the before and after positions are the same, and the length +is the size of the start range, we are probably good." + (-let [(&plist :end before-end :start before-start) lsp--before-change-vals] + (and (eq start before-start) + (eq length (- before-end before-start))))) + +(defun lsp--full-change-event () + `(:text ,(lsp--buffer-content))) + +(defun lsp-before-change (start end) + "Executed before a file is changed. +Added to `before-change-functions'." + ;; Note: + ;; + ;; This variable holds a list of functions to call when Emacs is about to + ;; modify a buffer. Each function gets two arguments, the beginning and end of + ;; the region that is about to change, represented as integers. The buffer + ;; that is about to change is always the current buffer when the function is + ;; called. + ;; + ;; WARNING: + ;; + ;; Do not expect the before-change hooks and the after-change hooks be called + ;; in balanced pairs around each buffer change. Also don't expect the + ;; before-change hooks to be called for every chunk of text Emacs is about to + ;; delete. These hooks are provided on the assumption that Lisp programs will + ;; use either before- or the after-change hooks, but not both, and the + ;; boundaries of the region where the changes happen might include more than + ;; just the actual changed text, or even lump together several changes done + ;; piecemeal. + (save-match-data + (lsp-save-restriction-and-excursion + (setq lsp--before-change-vals + (list :start start + :end end + :end-pos (lsp--point-to-position end)))))) + +(defun lsp--flush-delayed-changes () + (let ((inhibit-quit t)) + (when lsp--delay-timer + (cancel-timer lsp--delay-timer)) + (mapc (-lambda ((workspace buffer document change)) + (with-current-buffer buffer + (with-lsp-workspace workspace + (lsp-notify "textDocument/didChange" + (list :textDocument document + :contentChanges (vector change)))))) + (prog1 (nreverse lsp--delayed-requests) + (setq lsp--delayed-requests nil))))) + +(defun lsp--workspace-sync-method (workspace) + (let ((sync (-> workspace + (lsp--workspace-server-capabilities) + (lsp:server-capabilities-text-document-sync?)))) + (if (lsp-text-document-sync-options? sync) + (lsp:text-document-sync-options-change? sync) + sync))) + +(defun lsp-on-change (start end length &optional content-change-event-fn) + "Executed when a file is changed. +Added to `after-change-functions'." + ;; Note: + ;; + ;; Each function receives three arguments: the beginning and end of the region + ;; just changed, and the length of the text that existed before the change. + ;; All three arguments are integers. The buffer that has been changed is + ;; always the current buffer when the function is called. + ;; + ;; The length of the old text is the difference between the buffer positions + ;; before and after that text as it was before the change. As for the + ;; changed text, its length is simply the difference between the first two + ;; arguments. + ;; + ;; So (47 54 0) means add 7 chars starting at pos 47 + ;; So (47 47 7) means delete 7 chars starting at pos 47 + (save-match-data + (let ((inhibit-quit t) + ;; make sure that `lsp-on-change' is called in multi-workspace context + ;; see #2901 + lsp--cur-workspace) + ;; A (revert-buffer) call with the 'preserve-modes parameter (eg, as done + ;; by auto-revert-mode) will cause this handler to get called with a nil + ;; buffer-file-name. We need the buffer-file-name to send notifications; + ;; so we skip handling revert-buffer-caused changes and instead handle + ;; reverts separately in lsp-on-revert + (when (not revert-buffer-in-progress-p) + (cl-incf lsp--cur-version) + (mapc + (lambda (workspace) + (pcase (or lsp-document-sync-method + (lsp--workspace-sync-method workspace)) + (1 + (if lsp-debounce-full-sync-notifications + (setq lsp--delayed-requests + (->> lsp--delayed-requests + (-remove (-lambda ((_ buffer)) + (equal (current-buffer) buffer))) + (cons (list workspace + (current-buffer) + (lsp--versioned-text-document-identifier) + (lsp--full-change-event))))) + (with-lsp-workspace workspace + (lsp-notify "textDocument/didChange" + (list :contentChanges (vector (lsp--full-change-event)) + :textDocument (lsp--versioned-text-document-identifier))) + (lsp-diagnostics--request-pull-diagnostics workspace)))) + (2 + (with-lsp-workspace workspace + (lsp-notify + "textDocument/didChange" + (list :textDocument (lsp--versioned-text-document-identifier) + :contentChanges (vector + (if content-change-event-fn + (funcall content-change-event-fn start end length) + (lsp--text-document-content-change-event + start end length))))) + (lsp-diagnostics--request-pull-diagnostics workspace))))) + (lsp-workspaces)) + (when lsp--delay-timer (cancel-timer lsp--delay-timer)) + (setq lsp--delay-timer (run-with-idle-timer + lsp-debounce-full-sync-notifications-interval + nil + #'lsp--flush-delayed-changes)) + ;; force cleanup overlays after each change + (lsp--remove-overlays 'lsp-highlight) + (lsp--after-change (current-buffer)))))) + + + +;; facilities for on change hooks. We do not want to make lsp calls on each +;; change event so we add debounce to avoid flooding the server with events. +;; Additionally, we want to have a mechanism for stopping the server calls in +;; particular cases like, e. g. when performing completion. + +(defvar lsp-inhibit-lsp-hooks nil + "Flag to control.") + +(defcustom lsp-on-change-hook nil + "Hooks to run when buffer has changed." + :type 'hook + :group 'lsp-mode) + +(defcustom lsp-idle-delay 0.500 + "Debounce interval for `after-change-functions'." + :type 'number + :group 'lsp-mode) + +(defcustom lsp-on-idle-hook nil + "Hooks to run after `lsp-idle-delay'." + :type 'hook + :group 'lsp-mode) + +(defun lsp--idle-reschedule (buffer) + (when lsp--on-idle-timer + (cancel-timer lsp--on-idle-timer)) + + (setq lsp--on-idle-timer (run-with-idle-timer + lsp-idle-delay + nil + #'lsp--on-idle + buffer))) + +(defun lsp--post-command () + (lsp--cleanup-highlights-if-needed) + (lsp--idle-reschedule (current-buffer))) + +(defun lsp--on-idle (buffer) + "Start post command loop." + (when (and (buffer-live-p buffer) + (equal buffer (current-buffer)) + (not lsp-inhibit-lsp-hooks) + lsp-managed-mode) + (run-hooks 'lsp-on-idle-hook))) + +(defun lsp--on-change-debounce (buffer) + (when (and (buffer-live-p buffer) + (equal buffer (current-buffer)) + (not lsp-inhibit-lsp-hooks) + lsp-managed-mode) + (run-hooks 'lsp-on-change-hook))) + +(defun lsp--after-change (buffer) + "Called after most textDocument/didChange events." + (setq lsp--signature-last-index nil + lsp--signature-last nil) + + ;; cleanup diagnostics + (when lsp-diagnostic-clean-after-change + (dolist (workspace (lsp-workspaces)) + (-let [diagnostics (lsp--workspace-diagnostics workspace)] + (remhash (lsp--fix-path-casing (buffer-file-name)) diagnostics)))) + + (when (fboundp 'lsp--semantic-tokens-refresh-if-enabled) + (lsp--semantic-tokens-refresh-if-enabled buffer)) + (when lsp--on-change-timer + (cancel-timer lsp--on-change-timer)) + (setq lsp--on-change-timer (run-with-idle-timer + lsp-idle-delay + nil + #'lsp--on-change-debounce + buffer)) + (lsp--idle-reschedule buffer)) + + +(defcustom lsp-trim-trailing-whitespace t + "Trim trailing whitespace on a line." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-insert-final-newline t + "Insert a newline character at the end of the file if one does not exist." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-trim-final-newlines t + "Trim all newlines after the final newline at the end of the file." + :group 'lsp-mode + :type 'boolean) + + +(defun lsp--on-type-formatting (first-trigger-characters more-trigger-characters) + "Self insert handling. +Applies on type formatting." + (let ((ch last-command-event)) + (when (or (eq (string-to-char first-trigger-characters) ch) + (cl-find ch more-trigger-characters :key #'string-to-char)) + (lsp-request-async "textDocument/onTypeFormatting" + (lsp-make-document-on-type-formatting-params + :text-document (lsp--text-document-identifier) + :options (lsp-make-formatting-options + :tab-size (symbol-value (lsp--get-indent-width major-mode)) + :insert-spaces (lsp-json-bool (not indent-tabs-mode)) + :trim-trailing-whitespace? (lsp-json-bool lsp-trim-trailing-whitespace) + :insert-final-newline? (lsp-json-bool lsp-insert-final-newline) + :trim-final-newlines? (lsp-json-bool lsp-trim-final-newlines)) + :ch (char-to-string ch) + :position (lsp--cur-position)) + (lambda (data) (lsp--apply-text-edits data 'format)) + :mode 'tick)))) + + +;; links +(defun lsp--document-links () + (when (lsp-feature? "textDocument/documentLink") + (lsp-request-async + "textDocument/documentLink" + `(:textDocument ,(lsp--text-document-identifier)) + (lambda (links) + (lsp--remove-overlays 'lsp-link) + (seq-do + (-lambda ((link &as &DocumentLink :range (&Range :start :end))) + (-doto (make-button (lsp--position-to-point start) + (lsp--position-to-point end) + 'action (lsp--document-link-keymap link) + 'keymap (let ((map (make-sparse-keymap))) + (define-key map [M-return] 'push-button) + (define-key map [mouse-2] 'push-button) + map) + 'help-echo "mouse-2, M-RET: Visit this link") + (overlay-put 'lsp-link t))) + links)) + :mode 'unchanged))) + +(defun lsp--document-link-handle-target (url) + (let* ((parsed-url (url-generic-parse-url (url-unhex-string url))) + (type (url-type parsed-url))) + (pcase type + ("file" + (xref-push-marker-stack) + (find-file (lsp--uri-to-path url)) + (-when-let ((_ line column) (s-match (rx "#" (group (1+ num)) (or "," "#") (group (1+ num))) url)) + (goto-char (lsp--position-to-point + (lsp-make-position :character (1- (string-to-number column)) + :line (1- (string-to-number line))))))) + ((or "http" "https") (browse-url url)) + (type (if-let* ((handler (lsp--get-uri-handler type))) + (funcall handler url) + (signal 'lsp-file-scheme-not-supported (list url))))))) + +(lsp-defun lsp--document-link-keymap ((link &as &DocumentLink :target?)) + (if target? + (lambda (_) + (interactive) + (lsp--document-link-handle-target target?)) + (lambda (_) + (interactive) + (when (lsp:document-link-registration-options-resolve-provider? + (lsp--capability-for-method "textDocument/documentLink")) + (lsp-request-async + "documentLink/resolve" + link + (-lambda ((&DocumentLink :target?)) + (lsp--document-link-handle-target target?))))))) + + + +(defcustom lsp-warn-no-matched-clients t + "Whether to show messages when there are no supported clients." + :group 'lsp-mode + :type 'boolean) + +(defun lsp-buffer-language--configured-id () + "Return nil when not registered." + (->> lsp-language-id-configuration + (-first + (-lambda ((mode-or-pattern . language)) + (cond + ((and (stringp mode-or-pattern) + (s-matches? mode-or-pattern (buffer-file-name))) + language) + ((eq mode-or-pattern major-mode) language)))) + cl-rest)) + +(defvar-local lsp--buffer-language nil + "Locally cached returned value of `lsp-buffer-language'.") + +(defun lsp-buffer-language () + "Get language corresponding current buffer." + (or lsp--buffer-language + (let* ((configured-language (lsp-buffer-language--configured-id))) + (setq lsp--buffer-language + (or configured-language + ;; ensure non-nil + (string-remove-suffix "-mode" (symbol-name major-mode)))) + (when (and lsp-warn-no-matched-clients + (null configured-language)) + (lsp-warn "Unable to calculate the languageId for buffer `%s'. \ +Take a look at `lsp-language-id-configuration'. The `major-mode' is %s" + (buffer-name) + major-mode)) + lsp--buffer-language))) + +(defun lsp-activate-on (&rest languages) + "Returns language activation function. +The function will return t when the `lsp-buffer-language' returns +one of the LANGUAGES." + (lambda (_file-name _mode) + (-contains? languages (lsp-buffer-language)))) + +(defun lsp-workspace-root (&optional path) + "Find the workspace root for the current file or PATH." + (-when-let* ((file-name (or path (buffer-file-name))) + (file-name (lsp-f-canonical file-name))) + (->> (lsp-session) + (lsp-session-folders) + (--filter (and (lsp--files-same-host it file-name) + (or (lsp-f-ancestor-of? it file-name) + (equal it file-name)))) + (--max-by (> (length it) (length other)))))) + +(defun lsp-on-revert () + "Executed when a file is reverted. +Added to `after-revert-hook'." + (let ((n (buffer-size)) + (revert-buffer-in-progress-p nil)) + (lsp-on-change 0 n n))) + +(defun lsp--text-document-did-close (&optional keep-workspace-alive) + "Executed when the file is closed, added to `kill-buffer-hook'. + +If KEEP-WORKSPACE-ALIVE is non-nil, do not shutdown the workspace +if it's closing the last buffer in the workspace." + (lsp-foreach-workspace + (cl-callf2 delq (lsp-current-buffer) (lsp--workspace-buffers lsp--cur-workspace)) + (with-demoted-errors "Error sending didClose notification in ‘lsp--text-document-did-close’: %S" + (lsp-notify "textDocument/didClose" + `(:textDocument ,(lsp--text-document-identifier)))) + (when (and (not lsp-keep-workspace-alive) + (not keep-workspace-alive) + (not (lsp--workspace-buffers lsp--cur-workspace))) + (lsp--shutdown-workspace)))) + +(defun lsp--will-save-text-document-params (reason) + (list :textDocument (lsp--text-document-identifier) + :reason reason)) + +(defun lsp--before-save () + "Before save handler." + (with-demoted-errors "Error in ‘lsp--before-save’: %S" + (let ((params (lsp--will-save-text-document-params 1))) + (when (lsp--send-will-save-p) + (lsp-notify "textDocument/willSave" params)) + (when (and (lsp--send-will-save-wait-until-p) lsp-before-save-edits) + (let ((lsp-response-timeout 0.1)) + (condition-case nil + (lsp--apply-text-edits + (lsp-request "textDocument/willSaveWaitUntil" + params) + 'before-save) + (error))))))) + +(defun lsp--on-auto-save () + "Handler for auto-save." + (when (lsp--send-will-save-p) + (with-demoted-errors "Error in ‘lsp--on-auto-save’: %S" + (lsp-notify "textDocument/willSave" (lsp--will-save-text-document-params 2))))) + +(defun lsp--text-document-did-save () + "Executed when the file is closed, added to `after-save-hook''." + (when (lsp--send-did-save-p) + (with-demoted-errors "Error on ‘lsp--text-document-did-save: %S’" + (lsp-notify "textDocument/didSave" + `( :textDocument ,(lsp--versioned-text-document-identifier) + ,@(when (lsp--save-include-text-p) + (list :text (lsp--buffer-content)))))))) + +(defun lsp--text-document-position-params (&optional identifier position) + "Make TextDocumentPositionParams for the current point in the current document. +If IDENTIFIER and POSITION are non-nil, they will be used as the document +identifier and the position respectively." + (list :textDocument (or identifier (lsp--text-document-identifier)) + :position (or position (lsp--cur-position)))) + +(defun lsp--get-buffer-diagnostics () + "Return buffer diagnostics." + (gethash (or + (plist-get lsp--virtual-buffer :buffer-file-name) + (lsp--fix-path-casing (buffer-file-name))) + (lsp-diagnostics t))) + +(defun lsp-cur-line-diagnostics () + "Return any diagnostics that apply to the current line." + (-let [(&plist :start (&plist :line start) :end (&plist :line end)) (lsp--region-or-line)] + (cl-coerce (-filter + (-lambda ((&Diagnostic :range (&Range :start (&Position :line)))) + (and (>= line start) (<= line end))) + (lsp--get-buffer-diagnostics)) + 'vector))) + +(lsp-defun lsp-range-overlapping?((left &as &Range :start left-start :end left-end) + (right &as &Range :start right-start :end right-end)) + (or (lsp-point-in-range? right-start left) + (lsp-point-in-range? right-end left) + (lsp-point-in-range? left-start right) + (lsp-point-in-range? left-end right))) + +(defun lsp-make-position-1 (position) + (lsp-make-position :line (plist-get position :line) + :character (plist-get position :character))) + +(defun lsp-cur-possition-diagnostics () + "Return any diagnostics that apply to the current line." + (-let* ((start (if (use-region-p) (region-beginning) (point))) + (end (if (use-region-p) (region-end) (point))) + (current-range (lsp-make-range :start (lsp-make-position-1 (lsp-point-to-position start)) + :end (lsp-make-position-1 (lsp-point-to-position end))))) + (->> (lsp--get-buffer-diagnostics) + (-filter + (-lambda ((&Diagnostic :range)) + (lsp-range-overlapping? range current-range))) + (apply 'vector)))) + +(defalias 'lsp--cur-line-diagnotics 'lsp-cur-line-diagnostics) + +(defun lsp--extract-line-from-buffer (pos) + "Return the line pointed to by POS (a Position object) in the current buffer." + (let* ((point (lsp--position-to-point pos)) + (inhibit-field-text-motion t)) + (save-excursion + (goto-char point) + (buffer-substring (line-beginning-position) (line-end-position))))) + +(lsp-defun lsp--xref-make-item (filename (&Range :start (start &as &Position :character start-char :line start-line) + :end (end &as &Position :character end-char))) + "Return a xref-item from a RANGE in FILENAME." + (let* ((line (lsp--extract-line-from-buffer start)) + (len (length line))) + (add-face-text-property (max (min start-char len) 0) + (max (min end-char len) 0) + 'xref-match t line) + ;; LINE is nil when FILENAME is not being current visited by any buffer. + (xref-make-match (or line filename) + (xref-make-file-location + filename + (lsp-translate-line (1+ start-line)) + (lsp-translate-column start-char)) + (- end-char start-char)))) + +(defun lsp--location-uri (loc) + (if (lsp-location? loc) + (lsp:location-uri loc) + (lsp:location-link-target-uri loc))) + +(lsp-defun lsp-goto-location ((loc &as &Location :uri :range (&Range :start))) + "Go to location." + (let ((path (lsp--uri-to-path uri))) + (if (f-exists? path) + (with-current-buffer (find-file path) + (goto-char (lsp--position-to-point start))) + (error "There is no file %s" path)))) + +(defun lsp--location-range (loc) + (if (lsp-location? loc) + (lsp:location-range loc) + (lsp:location-link-target-selection-range loc))) + +(defun lsp--locations-to-xref-items (locations) + "Return a list of `xref-item' given LOCATIONS, which can be of +type Location, LocationLink, Location[] or LocationLink[]." + (setq locations + (pcase locations + ((seq (or (lsp-interface Location) + (lsp-interface LocationLink))) + (append locations nil)) + ((or (lsp-interface Location) + (lsp-interface LocationLink)) + (list locations)))) + + (cl-labels ((get-xrefs-in-file + (file-locs) + (-let [(filename . matches) file-locs] + (condition-case err + (let ((visiting (find-buffer-visiting filename)) + (fn (lambda (loc) + (lsp-with-filename filename + (lsp--xref-make-item filename + (lsp--location-range loc)))))) + (if visiting + (with-current-buffer visiting + (seq-map fn matches)) + (when (file-readable-p filename) + (with-temp-buffer + (insert-file-contents-literally filename) + (seq-map fn matches))))) + (error (lsp-warn "Failed to process xref entry for filename '%s': %s" + filename (error-message-string err))) + (file-error (lsp-warn "Failed to process xref entry, file-error, '%s': %s" + filename (error-message-string err))))))) + + (->> locations + (seq-sort #'lsp--location-before-p) + (seq-group-by (-compose #'lsp--uri-to-path #'lsp--location-uri)) + (seq-map #'get-xrefs-in-file) + (apply #'nconc)))) + +(defun lsp--location-before-p (left right) + "Sort first by file, then by line, then by column." + (let ((left-uri (lsp--location-uri left)) + (right-uri (lsp--location-uri right))) + (if (not (string= left-uri right-uri)) + (string< left-uri right-uri) + (-let (((&Range :start left-start) (lsp--location-range left)) + ((&Range :start right-start) (lsp--location-range right))) + (lsp--position-compare right-start left-start))))) + +(defun lsp--make-reference-params (&optional td-position exclude-declaration) + "Make a ReferenceParam object. +If TD-POSITION is non-nil, use it as TextDocumentPositionParams object instead. +If EXCLUDE-DECLARATION is non-nil, request the server to include declarations." + (let ((json-false :json-false)) + (plist-put (or td-position (lsp--text-document-position-params)) + :context `(:includeDeclaration ,(lsp-json-bool (not exclude-declaration)))))) + +(defun lsp--cancel-request (id) + "Cancel request with ID in all workspaces." + (lsp-foreach-workspace + (->> lsp--cur-workspace lsp--workspace-client lsp--client-response-handlers (remhash id)) + (lsp-notify "$/cancelRequest" `(:id ,id)))) + +(defvar-local lsp--hover-saved-bounds nil) + +(defun lsp-eldoc-function (cb &rest _ignored) + "`lsp-mode' eldoc function to display hover info (based on `textDocument/hover')." + (if (and lsp--hover-saved-bounds + (lsp--point-in-bounds-p lsp--hover-saved-bounds)) + lsp--eldoc-saved-message + (setq lsp--hover-saved-bounds nil + lsp--eldoc-saved-message nil) + (if (looking-at-p "[[:space:]\n]") + (setq lsp--eldoc-saved-message nil) ; And returns nil. + (when (and lsp-eldoc-enable-hover (lsp-feature? "textDocument/hover")) + (lsp-request-async + "textDocument/hover" + (lsp--text-document-position-params) + (-lambda ((hover &as &Hover? :range? :contents)) + (setq lsp--hover-saved-bounds (when range? + (lsp--range-to-region range?))) + (funcall cb (setq lsp--eldoc-saved-message + (when contents + (lsp--render-on-hover-content + contents + lsp-eldoc-render-all))))) + :error-handler #'ignore + :mode 'tick + :cancel-token :eldoc-hover))))) + +(defun lsp--point-on-highlight? () + (-some? (lambda (overlay) + (overlay-get overlay 'lsp-highlight)) + (overlays-at (point)))) + +(defun lsp--cleanup-highlights-if-needed () + (when (and lsp-enable-symbol-highlighting + lsp--have-document-highlights + (not (lsp--point-on-highlight?))) + (lsp--remove-overlays 'lsp-highlight) + (setq lsp--have-document-highlights nil) + (lsp-cancel-request-by-token :highlights))) + +(defvar-local lsp--symbol-bounds-of-last-highlight-invocation nil + "The bounds of the symbol from which `lsp--document-highlight' + most recently requested highlights.") + +(defun lsp--document-highlight () + (when (lsp-feature? "textDocument/documentHighlight") + (let ((curr-sym-bounds (bounds-of-thing-at-point 'symbol))) + (unless (or (looking-at-p "[[:space:]\n]") + (not lsp-enable-symbol-highlighting) + (and lsp--have-document-highlights + curr-sym-bounds + (equal curr-sym-bounds + lsp--symbol-bounds-of-last-highlight-invocation))) + (setq lsp--symbol-bounds-of-last-highlight-invocation + curr-sym-bounds) + (lsp-request-async "textDocument/documentHighlight" + (lsp--text-document-position-params) + #'lsp--document-highlight-callback + :mode 'tick + :cancel-token :highlights))))) + +(defun lsp--help-open-link (&rest _) + "Open markdown link at point via mouse or keyboard." + (interactive "P") + (let ((buffer-list-update-hook nil)) + (-let [(buffer point) (if-let* ((valid (and (listp last-input-event) + (eq (car last-input-event) 'mouse-2))) + (event (cadr last-input-event)) + (win (posn-window event)) + (buffer (window-buffer win))) + `(,buffer ,(posn-point event)) + `(,(current-buffer) ,(point)))] + (with-current-buffer buffer + (when-let* ((face (get-text-property point 'face)) + (url (or (and (eq face 'markdown-link-face) + (get-text-property point 'help-echo)) + (and (memq face '(markdown-url-face markdown-plain-url-face)) + (nth 3 (markdown-link-at-pos point)))))) + (lsp--document-link-handle-target url)))))) + +(defvar lsp-help-mode-map + (-doto (make-sparse-keymap) + (define-key [remap markdown-follow-link-at-point] #'lsp--help-open-link)) + "Keymap for `lsp-help-mode'.") + +(define-derived-mode lsp-help-mode help-mode "LspHelp" + "Major mode for displaying lsp help.") + +(defun lsp-describe-thing-at-point () + "Display the type signature and documentation of the thing at point." + (interactive) + (let ((contents (-some->> (lsp--text-document-position-params) + (lsp--make-request "textDocument/hover") + (lsp--send-request) + (lsp:hover-contents)))) + (if (and contents (not (equal contents ""))) + (let ((lsp-help-buf-name "*lsp-help*")) + (with-current-buffer (get-buffer-create lsp-help-buf-name) + (delay-mode-hooks + (lsp-help-mode) + (with-help-window lsp-help-buf-name + (insert + (mapconcat 'string-trim-right + (split-string (lsp--render-on-hover-content contents t) "\n") + "\n")))) + (run-mode-hooks))) + (lsp--info "No content at point.")))) + +(defun lsp--point-in-bounds-p (bounds) + "Return whether the current point is within BOUNDS." + (and (<= (car bounds) (point)) (< (point) (cdr bounds)))) + +(defun lsp-get-renderer (language) + "Get renderer for LANGUAGE." + (lambda (str) + (lsp--render-string str language))) + +(defun lsp--setup-markdown (mode) + "Setup the ‘markdown-mode’ in the frame. +MODE is the mode used in the parent frame." + (make-local-variable 'markdown-code-lang-modes) + (dolist (mark (alist-get mode lsp-custom-markup-modes)) + (add-to-list 'markdown-code-lang-modes (cons mark mode))) + (setq-local markdown-fontify-code-blocks-natively t) + (setq-local markdown-fontify-code-block-default-mode mode) + (setq-local markdown-hide-markup t) + + ;; Render some common HTML entities. + ;; This should really happen in markdown-mode instead, + ;; but it doesn't, so we do it here for now. + (setq prettify-symbols-alist + (cl-loop for i from 0 to 255 + collect (cons (format "&#x%02X;" i) i))) + (push '("<" . ?<) prettify-symbols-alist) + (push '(">" . ?>) prettify-symbols-alist) + (push '("&" . ?&) prettify-symbols-alist) + (push '(" " . ? ) prettify-symbols-alist) + (setq prettify-symbols-compose-predicate + (lambda (_start _end _match) t)) + (prettify-symbols-mode 1)) + +(defvar lsp-help-link-keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] #'lsp--help-open-link) + (define-key map "\r" #'lsp--help-open-link) + map) + "Keymap active on links in *lsp-help* mode.") + +(defun lsp--fix-markdown-links () + (let ((inhibit-read-only t) + (inhibit-modification-hooks t) + (prop)) + (save-restriction + (goto-char (point-min)) + (while (setq prop (markdown-find-next-prop 'face)) + (let ((end (or (next-single-property-change (car prop) 'face) + (point-max)))) + (when (memq (get-text-property (car prop) 'face) + '(markdown-link-face + markdown-url-face + markdown-plain-url-face)) + (add-text-properties (car prop) end + (list 'button t + 'category 'lsp-help-link + 'follow-link t + 'keymap lsp-help-link-keymap))) + (goto-char end)))))) + +(defun lsp--buffer-string-visible () + "Return visible buffer string. +Stolen from `org-copy-visible'." + (let ((temp (generate-new-buffer " *temp*")) + (beg (point-min)) + (end (point-max))) + (while (/= beg end) + (when (get-char-property beg 'invisible) + (setq beg (next-single-char-property-change beg 'invisible nil end))) + (let* ((next (next-single-char-property-change beg 'invisible nil end)) + (substring (buffer-substring beg next))) + (with-current-buffer temp (insert substring)) + ;; (setq result (concat result substring)) + (setq beg next))) + (setq deactivate-mark t) + (prog1 (with-current-buffer temp + (s-chop-suffix "\n" (buffer-string))) + (kill-buffer temp)))) + +(defvar lsp-buffer-major-mode nil + "Holds the major mode when fontification function is running. +See #2588") + +(defvar view-inhibit-help-message) + +(defun lsp--render-markdown () + "Render markdown." + + (let ((markdown-enable-math nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx (and "\\" (group (or "\\" "`" "*" "_" ":" "/" + "{" "}" "[" "]" "(" ")" + "#" "+" "-" "." "!" "|")))) + nil t) + (replace-match (rx (backref 1)))) + + ;; markdown-mode v2.3 does not yet provide gfm-view-mode + (if (fboundp 'gfm-view-mode) + (let ((view-inhibit-help-message t)) + (gfm-view-mode)) + (gfm-mode)) + + (lsp--setup-markdown lsp-buffer-major-mode))) + +(defvar lsp--display-inline-image-alist + '((lsp--render-markdown + (:regexp + "!\\[.*?\\](data:image/[a-zA-Z]+;base64,\\([A-Za-z0-9+/\n]+?=*?\\)\\(|[^)]+\\)?)" + :sexp + (create-image + (base64-decode-string + (buffer-substring-no-properties (match-beginning 1) (match-end 1))) + nil t)))) + "Replaced string regexp and function returning image. +Each element should have the form (MODE . (PROPERTY-LIST...)). +MODE (car) is function which is defined in `lsp-language-id-configuration'. +Cdr should be list of PROPERTY-LIST. + +Each PROPERTY-LIST should have properties: +:regexp Regexp which determines what string is relpaced to image. + You should also get information of image, by parenthesis constructs. + By default, all matched string is replaced to image, but you can + change index of replaced string by keyword :replaced-index. + +:sexp Return image when evaluated. You can use information of regexp + by using (match-beggining N), (match-end N) or (match-substring N). + +In addition, each can have property: +:replaced-index Determine index which is used to replace regexp to image. + The value means first argument of `match-beginning' and + `match-end'. If omitted, interpreted as index 0.") + +(defcustom lsp-display-inline-image t + "Showing inline image or not." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-enable-suggest-server-download t + "When non-nil enable server downloading suggestions." + :group 'lsp-mode + :type 'boolean + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-auto-register-remote-clients t + "When non-nil register remote when registering the local one." + :group 'lsp-mode + :type 'boolean + :package-version '(lsp-mode . "9.0.0")) + +(defun lsp--display-inline-image (mode) + "Add image property if available." + (let ((plist-list (cdr (assq mode lsp--display-inline-image-alist)))) + (when (and (display-images-p) lsp-display-inline-image) + (cl-loop + for plist in plist-list + with regexp with replaced-index + do + (setq regexp (plist-get plist :regexp)) + (setq replaced-index (or (plist-get plist :replaced-index) 0)) + + (font-lock-remove-keywords nil (list regexp replaced-index)) + (let ((inhibit-read-only t)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (set-text-properties + (match-beginning replaced-index) (match-end replaced-index) + nil) + (add-text-properties + (match-beginning replaced-index) (match-end replaced-index) + `(display ,(eval (plist-get plist :sexp))))))))))) + +(defun lsp--fontlock-with-mode (str mode) + "Fontlock STR with MODE." + (let ((lsp-buffer-major-mode major-mode)) + (with-temp-buffer + (with-demoted-errors "Error during doc rendering: %s" + (insert str) + (delay-mode-hooks (funcall mode)) + (cl-flet ((window-body-width () lsp-window-body-width)) + ;; This can go wrong in some cases, and the fontification would + ;; not work as expected. + ;; + ;; See #2984 + (ignore-errors (font-lock-ensure)) + (lsp--display-inline-image mode) + (when (eq mode 'lsp--render-markdown) + (lsp--fix-markdown-links)))) + (lsp--buffer-string-visible)))) + +(defun lsp--render-string (str language) + "Render STR using `major-mode' corresponding to LANGUAGE. +When language is nil render as markup if `markdown-mode' is loaded." + (setq str (s-replace "\r" "" (or str ""))) + (if-let* ((modes (-keep (-lambda ((mode . lang)) + (when (and (equal lang language) (functionp mode)) + mode)) + lsp-language-id-configuration)) + (mode (car (or (member major-mode modes) modes)))) + (lsp--fontlock-with-mode str mode) + str)) + +(defun lsp--render-element (content) + "Render CONTENT element." + (let ((inhibit-message t)) + (or + (pcase content + ((lsp-interface MarkedString :value :language) + (lsp--render-string value language)) + ((lsp-interface MarkupContent :value :kind) + (lsp--render-string value kind)) + ;; plain string + ((pred stringp) (lsp--render-string content "markdown")) + ((pred null) "") + (_ (error "Failed to handle %s" content))) + ""))) + +(defun lsp--create-unique-string-fn () + (let (elements) + (lambda (element) + (let ((count (cl-count element elements :test #'string=))) + (prog1 (if (zerop count) + element + (format "%s (%s)" element count)) + (push element elements)))))) + +(defun lsp--select-action (actions) + "Select an action to execute from ACTIONS." + (cond + ((seq-empty-p actions) (signal 'lsp-no-code-actions nil)) + ((and (eq (seq-length actions) 1) lsp-auto-execute-action) + (lsp-seq-first actions)) + (t (let ((completion-ignore-case t)) + (lsp--completing-read "Select code action: " + (seq-into actions 'list) + (-compose (lsp--create-unique-string-fn) + #'lsp:code-action-title) + nil t))))) + +(defun lsp--workspace-server-id (workspace) + "Return the server ID of WORKSPACE." + (-> workspace lsp--workspace-client lsp--client-server-id)) + +(defun lsp--handle-rendered-for-echo-area (contents) + "Return a single line from RENDERED, appropriate for display in the echo area." + (pcase (lsp-workspaces) + (`(,workspace) + (lsp-clients-extract-signature-on-hover contents (lsp--workspace-server-id workspace))) + ;; For projects with multiple active workspaces we also default to + ;; render the first line. + (_ (lsp-clients-extract-signature-on-hover contents nil)))) + +(cl-defmethod lsp-clients-extract-signature-on-hover (contents _server-id) + "Extract a representative line from CONTENTS, to show in the echo area." + (car (s-lines (s-trim (lsp--render-element contents))))) + +(defun lsp--render-on-hover-content (contents render-all) + "Render the content received from `document/onHover' request. +CONTENTS - MarkedString | MarkedString[] | MarkupContent +RENDER-ALL - nil if only the signature should be rendered." + (cond + ((lsp-markup-content? contents) + ;; MarkupContent. + ;; It tends to be long and is not suitable to display fully in the echo area. + ;; Just display the first line which is typically the signature. + (if render-all + (lsp--render-element contents) + (lsp--handle-rendered-for-echo-area contents))) + ((and (stringp contents) (not (string-match-p "\n" contents))) + ;; If the contents is a single string containing a single line, + ;; render it always. + (lsp--render-element contents)) + (t + ;; MarkedString -> MarkedString[] + (when (or (lsp-marked-string? contents) (stringp contents)) + (setq contents (list contents))) + ;; Consider the signature consisting of the elements who have a renderable + ;; "language" property. When render-all is nil, ignore other elements. + (string-join + (seq-map + #'lsp--render-element + (if render-all + contents + ;; Only render contents that have an available renderer. + (seq-take + (seq-filter + (-andfn #'lsp-marked-string? + (-compose #'lsp-get-renderer #'lsp:marked-string-language)) + contents) + 1))) + (if (bound-and-true-p page-break-lines-mode) + "\n\n" + "\n"))))) + + + +(defvar lsp-signature-mode-map + (-doto (make-sparse-keymap) + (define-key (kbd "M-n") #'lsp-signature-next) + (define-key (kbd "M-p") #'lsp-signature-previous) + (define-key (kbd "M-a") #'lsp-signature-toggle-full-docs) + (define-key (kbd "C-c C-k") #'lsp-signature-stop) + (define-key (kbd "C-g") #'lsp-signature-stop)) + "Keymap for `lsp-signature-mode'.") + +(define-minor-mode lsp-signature-mode + "Mode used to show signature popup." + :keymap lsp-signature-mode-map + :lighter "" + :group 'lsp-mode) + +(defun lsp-signature-stop () + "Stop showing current signature help." + (interactive) + (lsp-cancel-request-by-token :signature) + (remove-hook 'post-command-hook #'lsp-signature) + (funcall lsp-signature-function nil) + (lsp-signature-mode -1)) + +(declare-function page-break-lines--update-display-tables "ext:page-break-lines") + +(defun lsp--setup-page-break-mode-if-present () + "Enable `page-break-lines-mode' in current buffer." + (when (fboundp 'page-break-lines-mode) + (page-break-lines-mode) + ;; force page-break-lines-mode to update the display tables. + (page-break-lines--update-display-tables))) + +(defun lsp-lv-message (message) + (add-hook 'lv-window-hook #'lsp--setup-page-break-mode-if-present) + (if message + (progn + (setq lsp--signature-last-buffer (current-buffer)) + (let ((lv-force-update t)) + (lv-message "%s" message))) + (lv-delete-window) + (remove-hook 'lv-window-hook #'lsp--setup-page-break-mode-if-present))) + +(declare-function posframe-show "ext:posframe") +(declare-function posframe-hide "ext:posframe") +(declare-function posframe-poshandler-point-bottom-left-corner-upward "ext:posframe") + +(defface lsp-signature-posframe + '((t :inherit tooltip)) + "Background and foreground for `lsp-signature-posframe'." + :group 'lsp-mode) + +(defvar lsp-signature-posframe-params + (list :poshandler #'posframe-poshandler-point-bottom-left-corner-upward + :height 10 + :width 60 + :border-width 1 + :min-width 60) + "Params for signature and `posframe-show'.") + +(defun lsp-signature-posframe (str) + "Use posframe to show the STR signatureHelp string." + (if str + (apply #'posframe-show + (with-current-buffer (get-buffer-create " *lsp-signature*") + (erase-buffer) + (insert str) + (visual-line-mode 1) + (lsp--setup-page-break-mode-if-present) + (current-buffer)) + (append + lsp-signature-posframe-params + (list :position (point) + :background-color (face-attribute 'lsp-signature-posframe :background nil t) + :foreground-color (face-attribute 'lsp-signature-posframe :foreground nil t) + :border-color (face-attribute (if (facep 'child-frame-border) + 'child-frame-border + 'internal-border) + :background nil t)))) + (posframe-hide " *lsp-signature*"))) + +(defun lsp--handle-signature-update (signature) + (let ((message + (if (lsp-signature-help? signature) + (lsp--signature->message signature) + (mapconcat #'lsp--signature->message signature "\n")))) + (if (s-present? message) + (funcall lsp-signature-function message) + (lsp-signature-stop)))) + +(defun lsp-signature-activate () + "Activate signature help. +It will show up only if current point has signature help." + (interactive) + (setq lsp--signature-last nil + lsp--signature-last-index nil + lsp--signature-last-buffer (current-buffer)) + (add-hook 'post-command-hook #'lsp-signature) + (lsp-signature-mode t)) + +(defcustom lsp-signature-cycle t + "Whether `lsp-signature-next' and prev should cycle." + :type 'boolean + :group 'lsp-mode) + +(defun lsp-signature-next () + "Show next signature." + (interactive) + (let ((nsigs (length (lsp:signature-help-signatures lsp--signature-last)))) + (when (and lsp--signature-last-index + lsp--signature-last + (or lsp-signature-cycle (< (1+ lsp--signature-last-index) nsigs))) + (setq lsp--signature-last-index (% (1+ lsp--signature-last-index) nsigs)) + (funcall lsp-signature-function (lsp--signature->message lsp--signature-last))))) + +(defun lsp-signature-previous () + "Next signature." + (interactive) + (when (and lsp--signature-last-index + lsp--signature-last + (or lsp-signature-cycle (not (zerop lsp--signature-last-index)))) + (setq lsp--signature-last-index (1- (if (zerop lsp--signature-last-index) + (length (lsp:signature-help-signatures lsp--signature-last)) + lsp--signature-last-index))) + (funcall lsp-signature-function (lsp--signature->message lsp--signature-last)))) + +(defun lsp-signature-toggle-full-docs () + "Toggle full/partial signature documentation." + (interactive) + (let ((all? (not (numberp lsp-signature-doc-lines)))) + (setq lsp-signature-doc-lines (if all? + (or (car-safe lsp-signature-doc-lines) + 20) + (list lsp-signature-doc-lines)))) + (lsp-signature-activate)) + +(defface lsp-signature-highlight-function-argument + '((t :inherit eldoc-highlight-function-argument)) + "The face to use to highlight function arguments in signatures." + :group 'lsp-mode) + +(defun lsp--signature->message (signature-help) + "Generate eldoc message from SIGNATURE-HELP response." + (setq lsp--signature-last signature-help) + + (when (and signature-help (not (seq-empty-p (lsp:signature-help-signatures signature-help)))) + (-let* (((&SignatureHelp :active-signature? + :active-parameter? + :signatures) signature-help) + (active-signature? (or lsp--signature-last-index active-signature? 0)) + (_ (setq lsp--signature-last-index active-signature?)) + ((signature &as &SignatureInformation? :label :parameters?) (seq-elt signatures active-signature?)) + (prefix (if (= (length signatures) 1) + "" + (concat (propertize (format " %s/%s" + (1+ active-signature?) + (length signatures)) + 'face 'success) + " "))) + (method-docs (when + (and lsp-signature-render-documentation + (or (not (numberp lsp-signature-doc-lines)) (< 0 lsp-signature-doc-lines))) + (let ((docs (lsp--render-element + (lsp:parameter-information-documentation? signature)))) + (when (s-present? docs) + (concat + "\n" + (if (fboundp 'page-break-lines-mode) + "\n" + "") + (if (and (numberp lsp-signature-doc-lines) + (> (length (s-lines docs)) lsp-signature-doc-lines)) + (concat (s-join "\n" (-take lsp-signature-doc-lines (s-lines docs))) + (propertize "\nTruncated..." 'face 'highlight)) + docs))))))) + (when (and active-parameter? (not (seq-empty-p parameters?))) + (-when-let* ((param (when (and (< -1 active-parameter? (length parameters?))) + (seq-elt parameters? active-parameter?))) + (selected-param-label (let ((label (lsp:parameter-information-label param))) + (if (stringp label) label (append label nil)))) + (start (if (stringp selected-param-label) + (s-index-of selected-param-label label) + (cl-first selected-param-label))) + (end (if (stringp selected-param-label) + (+ start (length selected-param-label)) + (cl-second selected-param-label)))) + (add-face-text-property start end 'lsp-signature-highlight-function-argument nil label))) + (concat prefix label method-docs)))) + +(defun lsp-signature () + "Display signature info (based on `textDocument/signatureHelp')" + (if (and lsp--signature-last-buffer + (not (equal (current-buffer) lsp--signature-last-buffer))) + (lsp-signature-stop) + (lsp-request-async "textDocument/signatureHelp" + (lsp--text-document-position-params) + #'lsp--handle-signature-update + :cancel-token :signature))) + + +(defcustom lsp-overlay-document-color-char "■" + "Display the char represent the document color in overlay" + :type 'string + :group 'lsp-mode) + +;; color presentation +(defun lsp--color-create-interactive-command (color range) + (lambda () + (interactive) + (-let [(&ColorPresentation? :text-edit? + :additional-text-edits?) + (lsp--completing-read + "Select color presentation: " + (lsp-request + "textDocument/colorPresentation" + `( :textDocument ,(lsp--text-document-identifier) + :color ,color + :range ,range)) + #'lsp:color-presentation-label + nil + t)] + (when text-edit? + (lsp--apply-text-edit text-edit?)) + (when additional-text-edits? + (lsp--apply-text-edits additional-text-edits? 'color-presentation))))) + +(defun lsp--number->color (number) + (let ((result (format "%x" + (round (* (or number 0) 255.0))))) + (if (= 1 (length result)) + (concat "0" result) + result))) + +(defun lsp--document-color () + "Document color handler." + (when (lsp-feature? "textDocument/documentColor") + (lsp-request-async + "textDocument/documentColor" + `(:textDocument ,(lsp--text-document-identifier)) + (lambda (result) + (lsp--remove-overlays 'lsp-color) + (seq-do + (-lambda ((&ColorInformation :color (color &as &Color :red :green :blue) + :range)) + (-let* (((beg . end) (lsp--range-to-region range)) + (overlay (make-overlay beg end)) + (command (lsp--color-create-interactive-command color range))) + (overlay-put overlay 'lsp-color t) + (overlay-put overlay 'evaporate t) + (overlay-put overlay + 'before-string + (propertize + lsp-overlay-document-color-char + 'face `((:foreground ,(format + "#%s%s%s" + (lsp--number->color red) + (lsp--number->color green) + (lsp--number->color blue)))) + 'action command + 'mouse-face 'lsp-lens-mouse-face + 'local-map (-doto (make-sparse-keymap) + (define-key [mouse-1] command)))))) + result)) + :mode 'unchanged + :cancel-token :document-color-token))) + + + +(defun lsp--action-trigger-parameter-hints (_command) + "Handler for editor.action.triggerParameterHints." + (when (member :on-server-request lsp-signature-auto-activate) + (lsp-signature-activate))) + +(defun lsp--action-trigger-suggest (_command) + "Handler for editor.action.triggerSuggest." + (cond + ((and (bound-and-true-p company-mode) + (fboundp 'company-auto-begin) + (fboundp 'company-post-command)) + (run-at-time 0 nil + (lambda () + (let ((this-command 'company-idle-begin) + (company-minimum-prefix-length 0)) + (company-auto-begin) + (company-post-command))))) + (t + (completion-at-point)))) + +(defconst lsp--default-action-handlers + (ht ("editor.action.triggerParameterHints" #'lsp--action-trigger-parameter-hints) + ("editor.action.triggerSuggest" #'lsp--action-trigger-suggest)) + "Default action handlers.") + +(defun lsp--find-action-handler (command) + "Find action handler for particular COMMAND." + (or + (--some (-some->> it + (lsp--workspace-client) + (lsp--client-action-handlers) + (gethash command)) + (lsp-workspaces)) + (gethash command lsp--default-action-handlers))) + +(defun lsp--text-document-code-action-params (&optional kind) + "Code action params." + (list :textDocument (lsp--text-document-identifier) + :range (if (use-region-p) + (lsp--region-to-range (region-beginning) (region-end)) + (lsp--region-to-range (point) (point))) + :context `( :diagnostics ,(lsp-cur-possition-diagnostics) + ,@(when kind (list :only (vector kind)))))) + +(defun lsp-code-actions-at-point (&optional kind) + "Retrieve the code actions for the active region or the current line. +It will filter by KIND if non nil." + (lsp-request "textDocument/codeAction" (lsp--text-document-code-action-params kind))) + +(defun lsp-execute-code-action-by-kind (command-kind) + "Execute code action by COMMAND-KIND." + (if-let* ((action (->> (lsp-get-or-calculate-code-actions command-kind) + (-filter (-lambda ((&CodeAction :kind?)) + (and kind? (s-prefix? command-kind kind?)))) + lsp--select-action))) + (lsp-execute-code-action action) + (signal 'lsp-no-code-actions '(command-kind)))) + +(defalias 'lsp-get-or-calculate-code-actions 'lsp-code-actions-at-point) + +(lsp-defun lsp--execute-command ((action &as &Command :command :arguments?)) + "Parse and execute a code ACTION represented as a Command LSP type." + (let ((server-id (->> (lsp-workspaces) + (cl-first) + (or lsp--cur-workspace) + (lsp--workspace-client) + (lsp--client-server-id)))) + (condition-case nil + (with-no-warnings + (lsp-execute-command server-id (intern command) arguments?)) + (cl-no-applicable-method + (if-let* ((action-handler (lsp--find-action-handler command))) + (funcall action-handler action) + (lsp-send-execute-command command arguments?)))))) + +(lsp-defun lsp-execute-code-action ((action &as &CodeAction :command? :edit?)) + "Execute code action ACTION. For example, when text under the +caret has a suggestion to apply a fix from an lsp-server, calling +this function will do so. +If ACTION is not set it will be selected from `lsp-code-actions-at-point'. +Request codeAction/resolve for more info if server supports." + (interactive (list (lsp--select-action (lsp-code-actions-at-point)))) + (if (and (lsp-feature? "codeAction/resolve") + (not command?) + (not edit?)) + (lsp--execute-code-action (lsp-request "codeAction/resolve" action)) + (lsp--execute-code-action action))) + +(lsp-defun lsp--execute-code-action ((action &as &CodeAction :command? :edit?)) + "Execute code action ACTION." + (when edit? + (lsp--apply-workspace-edit edit? 'code-action)) + + (cond + ((stringp command?) (lsp--execute-command action)) + ((lsp-command? command?) (progn + (when-let* ((action-filter (->> (lsp-workspaces) + (cl-first) + (or lsp--cur-workspace) + (lsp--workspace-client) + (lsp--client-action-filter)))) + (funcall action-filter command?)) + (lsp--execute-command command?))))) + +(lsp-defun lsp-fix-code-action-booleans ((&Command :arguments?) boolean-action-arguments) + "Patch incorrect boolean argument values in the provided `CodeAction' command +in place, based on the BOOLEAN-ACTION-ARGUMENTS list. The values +in this list can be either symbols or lists of symbols that +represent paths to boolean arguments in code actions: + +> (lsp-fix-code-action-booleans command `(:foo :bar (:some :nested :boolean))) + +When there are available code actions, the server sends +`lsp-mode' a list of possible command names and arguments as +JSON. `lsp-mode' parses all boolean false values as `nil'. As a +result code action arguments containing falsy values don't +roundtrip correctly because `lsp-mode' will end up sending null +values back to the client. This list makes it possible to +selectively transform `nil' values back into `:json-false'." + (seq-doseq (path boolean-action-arguments) + (seq-doseq (args arguments?) + (lsp--fix-nested-boolean args (if (listp path) path (list path)))))) + +(defun lsp--fix-nested-boolean (structure path) + "Traverse STRUCTURE using the paths from the PATH list, changing the value to +`:json-false' if it was `nil'. PATH should be a list containing +one or more symbols, and STRUCTURE should be compatible with +`lsp-member?', `lsp-get', and `lsp-put'." + (let ((key (car path)) + (rest (cdr path))) + (if (null rest) + ;; `lsp-put' returns `nil' both when the key doesn't exist and when the + ;; value is `nil', so we need to explicitly check its presence here + (when (and (lsp-member? structure key) (not (lsp-get structure key))) + (lsp-put structure key :json-false)) + ;; If `key' does not exist, then we'll silently ignore it + (when-let* ((child (lsp-get structure key))) + (lsp--fix-nested-boolean child rest))))) + +(defvar lsp--formatting-indent-alist + ;; Taken from `dtrt-indent-mode' + '( + (ada-mode . ada-indent) ; Ada + (ada-ts-mode . ada-ts-mode-indent-offset) + (c++-mode . c-basic-offset) ; C++ + (c++-ts-mode . c-ts-mode-indent-offset) + (c-mode . c-basic-offset) ; C + (c-ts-mode . c-ts-mode-indent-offset) + (cperl-mode . cperl-indent-level) ; Perl + (crystal-mode . crystal-indent-level) ; Crystal (Ruby) + (csharp-mode . c-basic-offset) ; C# + (csharp-tree-sitter-mode . csharp-tree-sitter-indent-offset) ; C# + (csharp-ts-mode . csharp-ts-mode-indent-offset) ; C# (tree-sitter, Emacs29) + (css-mode . css-indent-offset) ; CSS + (d-mode . c-basic-offset) ; D + (enh-ruby-mode . enh-ruby-indent-level) ; Ruby + (erlang-mode . erlang-indent-level) ; Erlang + (ess-mode . ess-indent-offset) ; ESS (R) + (go-ts-mode . go-ts-mode-indent-offset) + (gpr-mode . gpr-indent-offset) ; GNAT Project + (gpr-ts-mode . gpr-ts-mode-indent-offset) + (hack-mode . hack-indent-offset) ; Hack + (java-mode . c-basic-offset) ; Java + (java-ts-mode . java-ts-mode-indent-offset) + (jde-mode . c-basic-offset) ; Java (JDE) + (js-mode . js-indent-level) ; JavaScript + (js-ts-mode . js-indent-level) + (js2-mode . js2-basic-offset) ; JavaScript-IDE + (js3-mode . js3-indent-level) ; JavaScript-IDE + (json-mode . js-indent-level) ; JSON + (json-ts-mode . json-ts-mode-indent-offset) + (lua-mode . lua-indent-level) ; Lua + (lua-ts-mode . lua-ts-indent-offset) + (nxml-mode . nxml-child-indent) ; XML + (objc-mode . c-basic-offset) ; Objective C + (pascal-mode . pascal-indent-level) ; Pascal + (perl-mode . perl-indent-level) ; Perl + (php-mode . c-basic-offset) ; PHP + (php-ts-mode . php-ts-mode-indent-offset) ; PHP + (powershell-mode . powershell-indent) ; PowerShell + (powershell-ts-mode . powershell-ts-mode-indent-offset) ; PowerShell + (raku-mode . raku-indent-offset) ; Perl6/Raku + (ruby-mode . ruby-indent-level) ; Ruby + (rust-mode . rust-indent-offset) ; Rust + (rust-ts-mode . rust-ts-mode-indent-offset) + (rustic-mode . rustic-indent-offset) ; Rust + (scala-mode . scala-indent:step) ; Scala + (sgml-mode . sgml-basic-offset) ; SGML + (sh-mode . sh-basic-offset) ; Shell Script + (toml-ts-mode . toml-ts-mode-indent-offset) + (typescript-mode . typescript-indent-level) ; Typescript + (typescript-ts-mode . typescript-ts-mode-indent-offset) ; Typescript (tree-sitter, Emacs29) + (yaml-mode . yaml-indent-offset) ; YAML + (yang-mode . c-basic-offset) ; YANG (yang-mode) + + (default . standard-indent)) ; default fallback + "A mapping from `major-mode' to its indent variable.") + +(defun lsp--get-indent-width (mode) + "Get indentation offset for MODE." + (or (alist-get mode lsp--formatting-indent-alist) + (lsp--get-indent-width (or (get mode 'derived-mode-parent) 'default)))) + +(defun lsp--make-document-formatting-params () + "Create document formatting params." + (lsp-make-document-formatting-params + :text-document (lsp--text-document-identifier) + :options (lsp-make-formatting-options + :tab-size (symbol-value (lsp--get-indent-width major-mode)) + :insert-spaces (lsp-json-bool (not indent-tabs-mode)) + :trim-trailing-whitespace? (lsp-json-bool lsp-trim-trailing-whitespace) + :insert-final-newline? (lsp-json-bool lsp-insert-final-newline) + :trim-final-newlines? (lsp-json-bool lsp-trim-final-newlines)))) + +(defun lsp-format-buffer () + "Ask the server to format this document." + (interactive "*") + (cond ((lsp-feature? "textDocument/formatting") + (let ((edits (lsp-request "textDocument/formatting" + (lsp--make-document-formatting-params)))) + (if (seq-empty-p edits) + (lsp--info "No formatting changes provided") + (lsp--apply-text-edits edits 'format)))) + ((lsp-feature? "textDocument/rangeFormatting") + (save-restriction + (widen) + (lsp-format-region (point-min) (point-max)))) + (t (signal 'lsp-capability-not-supported (list "documentFormattingProvider"))))) + +(defun lsp-format-region (s e) + "Ask the server to format the region, or if none is selected, the current line." + (interactive "r") + (let ((edits (lsp-request + "textDocument/rangeFormatting" + (lsp--make-document-range-formatting-params s e)))) + (if (seq-empty-p edits) + (lsp--info "No formatting changes provided") + (lsp--apply-text-edits edits 'format)))) + +(defmacro lsp-make-interactive-code-action (func-name code-action-kind) + "Define an interactive function FUNC-NAME that attempts to +execute a CODE-ACTION-KIND action." + `(defun ,(intern (concat "lsp-" (symbol-name func-name))) () + ,(format "Perform the %s code action, if available." code-action-kind) + (interactive) + ;; Even when `lsp-auto-execute-action' is nil, it still makes sense to + ;; auto-execute here: the user has specified exactly what they want. + (let ((lsp-auto-execute-action t)) + (condition-case nil + (lsp-execute-code-action-by-kind ,code-action-kind) + (lsp-no-code-actions + (when (called-interactively-p 'any) + (lsp--info ,(format "%s action not available" code-action-kind)))))))) + +(lsp-make-interactive-code-action organize-imports "source.organizeImports") + +(defun lsp--make-document-range-formatting-params (start end) + "Make DocumentRangeFormattingParams for selected region." + (lsp:set-document-range-formatting-params-range (lsp--make-document-formatting-params) + (lsp--region-to-range start end))) + +(defconst lsp--highlight-kind-face + '((1 . lsp-face-highlight-textual) + (2 . lsp-face-highlight-read) + (3 . lsp-face-highlight-write))) + +(defun lsp--remove-overlays (name) + (save-restriction + (widen) + (remove-overlays (point-min) (point-max) name t))) + +(defun lsp-document-highlight () + "Highlight all relevant references to the symbol under point." + (interactive) + (lsp--remove-overlays 'lsp-highlight) ;; clear any previous highlights + (setq lsp--have-document-highlights nil + lsp--symbol-bounds-of-last-highlight-invocation nil) + (let ((lsp-enable-symbol-highlighting t)) + (lsp--document-highlight))) + +(defun lsp--document-highlight-callback (highlights) + "Create a callback to process the reply of a +`textDocument/documentHighlight' message for the buffer BUF. +A reference is highlighted only if it is visible in a window." + (lsp--remove-overlays 'lsp-highlight) + + (let* ((wins-visible-pos (-map (lambda (win) + (cons (1- (line-number-at-pos (window-start win) t)) + (1+ (line-number-at-pos (window-end win) t)))) + (get-buffer-window-list nil nil 'visible)))) + (setq lsp--have-document-highlights t) + (-map + (-lambda ((&DocumentHighlight :range (&Range :start (start &as &Position :line start-line) + :end (end &as &Position :line end-line)) + :kind?)) + (-map + (-lambda ((start-window . end-window)) + ;; Make the overlay only if the reference is visible + (when (and (> (1+ start-line) start-window) + (< (1+ end-line) end-window)) + (let ((start-point (lsp--position-to-point start)) + (end-point (lsp--position-to-point end))) + (when (not (and lsp-symbol-highlighting-skip-current + (<= start-point (point) end-point))) + (-doto (make-overlay start-point end-point) + (overlay-put 'face (cdr (assq (or kind? 1) lsp--highlight-kind-face))) + (overlay-put 'lsp-highlight t)))))) + wins-visible-pos)) + highlights))) + +(defcustom lsp-symbol-kinds + '((1 . "File") + (2 . "Module") + (3 . "Namespace") + (4 . "Package") + (5 . "Class") + (6 . "Method") + (7 . "Property") + (8 . "Field") + (9 . "Constructor") + (10 . "Enum") + (11 . "Interface") + (12 . "Function") + (13 . "Variable") + (14 . "Constant") + (15 . "String") + (16 . "Number") + (17 . "Boolean") + (18 . "Array") + (19 . "Object") + (20 . "Key") + (21 . "Null") + (22 . "Enum Member") + (23 . "Struct") + (24 . "Event") + (25 . "Operator") + (26 . "Type Parameter")) + "Alist mapping SymbolKinds to human-readable strings. +Various Symbol objects in the LSP protocol have an integral type, +specifying what they are. This alist maps such type integrals to +readable representations of them. See +`https://microsoft.github.io/language-server-protocol/specifications/specification-current/', +namespace SymbolKind." + :group 'lsp-mode + :type '(alist :key-type integer :value-type string)) +(defalias 'lsp--symbol-kind 'lsp-symbol-kinds) + +(lsp-defun lsp--symbol-information-to-xref + ((&SymbolInformation :kind :name + :location (&Location :uri :range (&Range :start + (&Position :line :character))))) + "Return a `xref-item' from SYMBOL information." + (xref-make (format "[%s] %s" (alist-get kind lsp-symbol-kinds) name) + (xref-make-file-location (lsp--uri-to-path uri) + line + character))) + +(defun lsp--get-document-symbols () + "Get document symbols. + +If the buffer has not been modified since symbols were last +retrieved, simply return the latest result. + +Else, if the request was initiated by Imenu updating its menu-bar +entry, perform it asynchronously; i.e., give Imenu the latest +result and then force a refresh when a new one is available. + +Else (e.g., due to interactive use of `imenu' or `xref'), +perform the request synchronously." + (if (= (buffer-chars-modified-tick) lsp--document-symbols-tick) + lsp--document-symbols + (let ((method "textDocument/documentSymbol") + (params `(:textDocument ,(lsp--text-document-identifier))) + (tick (buffer-chars-modified-tick))) + (if (not lsp--document-symbols-request-async) + (prog1 + (setq lsp--document-symbols (lsp-request method params)) + (setq lsp--document-symbols-tick tick)) + (lsp-request-async method params + (lambda (document-symbols) + (setq lsp--document-symbols document-symbols + lsp--document-symbols-tick tick) + (lsp--imenu-refresh)) + :mode 'alive + :cancel-token :document-symbols) + lsp--document-symbols)))) + +(advice-add 'imenu-update-menubar :around + (lambda (oldfun &rest r) + (let ((lsp--document-symbols-request-async t)) + (apply oldfun r)))) + +(defun lsp--document-symbols->document-symbols-hierarchy (document-symbols current-position) + "Convert DOCUMENT-SYMBOLS to symbols hierarchy on CURRENT-POSITION." + (-let (((symbol &as &DocumentSymbol? :children?) + (seq-find (-lambda ((&DocumentSymbol :range)) + (lsp-point-in-range? current-position range)) + document-symbols))) + (if children? + (cons symbol (lsp--document-symbols->document-symbols-hierarchy children? current-position)) + (when symbol + (list symbol))))) + +(lsp-defun lsp--symbol-information->document-symbol ((&SymbolInformation :name :kind :location :container-name? :deprecated?)) + "Convert a SymbolInformation to a DocumentInformation" + (lsp-make-document-symbol :name name + :kind kind + :range (lsp:location-range location) + :children? nil + :deprecated? deprecated? + :selection-range (lsp:location-range location) + :detail? container-name?)) + +(defun lsp--symbols-informations->document-symbols-hierarchy (symbols-informations current-position) + "Convert SYMBOLS-INFORMATIONS to symbols hierarchy on CURRENT-POSITION." + (--> symbols-informations + (-keep (-lambda ((symbol &as &SymbolInformation :location (&Location :range))) + (when (lsp-point-in-range? current-position range) + (lsp--symbol-information->document-symbol symbol))) + it) + (sort it (-lambda ((&DocumentSymbol :range (&Range :start a-start-position :end a-end-position)) + (&DocumentSymbol :range (&Range :start b-start-position :end b-end-position))) + (and (lsp--position-compare b-start-position a-start-position) + (lsp--position-compare a-end-position b-end-position)))))) + +(defun lsp--symbols->document-symbols-hierarchy (symbols) + "Convert SYMBOLS to symbols-hierarchy." + (when-let* ((first-symbol (lsp-seq-first symbols))) + (let ((cur-position (lsp-make-position :line (plist-get (lsp--cur-position) :line) + :character (plist-get (lsp--cur-position) :character)))) + (if (lsp-symbol-information? first-symbol) + (lsp--symbols-informations->document-symbols-hierarchy symbols cur-position) + (lsp--document-symbols->document-symbols-hierarchy symbols cur-position))))) + +(defun lsp--xref-backend () 'xref-lsp) + +(cl-defmethod xref-backend-identifier-at-point ((_backend (eql xref-lsp))) + (propertize (or (thing-at-point 'symbol) "") + 'identifier-at-point t)) + +(defun lsp--xref-elements-index (symbols path) + (-mapcat + (-lambda (sym) + (pcase-exhaustive sym + ((lsp-interface DocumentSymbol :name :children? :selection-range (lsp-interface Range :start)) + (cons (cons (concat path name) + (lsp--position-to-point start)) + (lsp--xref-elements-index children? (concat path name " / ")))) + ((lsp-interface SymbolInformation :name :location (lsp-interface Location :range (lsp-interface Range :start))) + (list (cons (concat path name) + (lsp--position-to-point start)))))) + symbols)) + +(defvar-local lsp--symbols-cache nil) + +(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql xref-lsp))) + (if (lsp--find-workspaces-for "textDocument/documentSymbol") + (progn + (setq lsp--symbols-cache (lsp--xref-elements-index + (lsp--get-document-symbols) nil)) + lsp--symbols-cache) + (list (propertize (or (thing-at-point 'symbol) "") + 'identifier-at-point t)))) + +(cl-defmethod xref-backend-definitions ((_backend (eql xref-lsp)) identifier) + (save-excursion + (unless (get-text-property 0 'identifier-at-point identifier) + (goto-char (cl-rest (or (assoc identifier lsp--symbols-cache) + (user-error "Unable to find symbol %s in current document" identifier))))) + (lsp--locations-to-xref-items (lsp-request "textDocument/definition" + (lsp--text-document-position-params))))) + +(cl-defmethod xref-backend-references ((_backend (eql xref-lsp)) identifier) + (save-excursion + (unless (get-text-property 0 'identifier-at-point identifier) + (goto-char (cl-rest (or (assoc identifier lsp--symbols-cache) + (user-error "Unable to find symbol %s" identifier))))) + (lsp--locations-to-xref-items (lsp-request "textDocument/references" + (lsp--make-reference-params nil lsp-references-exclude-declaration))))) + +(cl-defmethod xref-backend-apropos ((_backend (eql xref-lsp)) pattern) + (seq-map #'lsp--symbol-information-to-xref + (lsp-request "workspace/symbol" `(:query ,pattern)))) + +(defcustom lsp-rename-use-prepare t + "Whether `lsp-rename' should do a prepareRename first. +For some language servers, textDocument/prepareRename might be +too slow, in which case this variable may be set to nil. +`lsp-rename' will then use `thing-at-point' `symbol' to determine +the symbol to rename at point." + :group 'lsp-mode + :type 'boolean) + +(defun lsp--get-symbol-to-rename () + "Get a symbol to rename and placeholder at point. +Returns a cons ((START . END) . PLACEHOLDER?), and nil if +renaming is generally supported but cannot be done at point. +START and END are the bounds of the identifiers being renamed, +while PLACEHOLDER?, is either nil or a string suggested by the +language server as the initial input of a new-name prompt." + (unless (lsp-feature? "textDocument/rename") + (error "The connected server(s) doesn't support renaming")) + (if (and lsp-rename-use-prepare (lsp-feature? "textDocument/prepareRename")) + (when-let* ((response + (lsp-request "textDocument/prepareRename" + (lsp--text-document-position-params)))) + (let* ((bounds (lsp--range-to-region + (if (lsp-range? response) + response + (lsp:prepare-rename-result-range response)))) + (placeholder + (and (not (lsp-range? response)) + (lsp:prepare-rename-result-placeholder response)))) + (cons bounds placeholder))) + (when-let* ((bounds (bounds-of-thing-at-point 'symbol))) + (cons bounds nil)))) + +(defface lsp-face-rename '((t :underline t)) + "Face used to highlight the identifier being renamed. +Renaming can be done using `lsp-rename'." + :group 'lsp-mode) + +(defface lsp-rename-placeholder-face '((t :inherit font-lock-variable-name-face)) + "Face used to display the rename placeholder in. +When calling `lsp-rename' interactively, this will be the face of +the new name." + :group 'lsp-mode) + +(defvar lsp-rename-history '() + "History for `lsp--read-rename'.") + +(defun lsp--read-rename (at-point) + "Read a new name for a `lsp-rename' at `point' from the user. +AT-POINT shall be a structure as returned by +`lsp--get-symbol-to-rename'. + +Returns a string, which should be the new name for the identifier +at point. If renaming cannot be done at point (as determined from +AT-POINT), throw a `user-error'. + +This function is for use in `lsp-rename' only, and shall not be +relied upon." + (unless at-point + (user-error "`lsp-rename' is invalid here")) + (-let* ((((start . end) . placeholder?) at-point) + ;; Do the `buffer-substring' first to not include `lsp-face-rename' + (rename-me (buffer-substring start end)) + (placeholder (or placeholder? rename-me)) + (placeholder (propertize placeholder 'face 'lsp-rename-placeholder-face)) + + overlay) + ;; We need unwind protect, as the user might cancel here, causing the + ;; overlay to linger. + (unwind-protect + (progn + (setq overlay (make-overlay start end)) + (overlay-put overlay 'face 'lsp-face-rename) + + (read-string (format "Rename %s to: " rename-me) placeholder + 'lsp-rename-history)) + (and overlay (delete-overlay overlay))))) + +(defun lsp-rename (newname) + "Rename the symbol (and all references to it) under point to NEWNAME." + (interactive (list (lsp--read-rename (lsp--get-symbol-to-rename)))) + (when-let* ((edits (lsp-request "textDocument/rename" + `( :textDocument ,(lsp--text-document-identifier) + :position ,(lsp--cur-position) + :newName ,newname)))) + (lsp--apply-workspace-edit edits 'rename))) + +(defun lsp--on-rename-file (old-func old-name new-name &optional ok-if-already-exists?) + "Advice around function `rename-file'. +Applies OLD-FUNC with OLD-NAME, NEW-NAME and OK-IF-ALREADY-EXISTS?. + +This advice sends workspace/willRenameFiles before renaming file +to check if server wants to apply any workspaceEdits after renamed." + (if (and lsp-apply-edits-after-file-operations + (lsp--send-will-rename-files-p old-name)) + (let ((params (lsp-make-rename-files-params + :files (vector (lsp-make-file-rename + :oldUri (lsp--path-to-uri old-name) + :newUri (lsp--path-to-uri new-name)))))) + (when-let* ((edits (lsp-request "workspace/willRenameFiles" params))) + (lsp--apply-workspace-edit edits 'rename-file) + (funcall old-func old-name new-name ok-if-already-exists?) + (when (lsp--send-did-rename-files-p) + (lsp-notify "workspace/didRenameFiles" params)))) + (funcall old-func old-name new-name ok-if-already-exists?))) + +(advice-add 'rename-file :around #'lsp--on-rename-file) + +(defcustom lsp-xref-force-references nil + "If non-nil threat everything as references(e. g. jump if only one item.)" + :group 'lsp-mode + :type 'boolean) + +(defun lsp-show-xrefs (xrefs display-action references?) + (unless (region-active-p) (push-mark nil t)) + (if (boundp 'xref-show-definitions-function) + (with-no-warnings + (xref-push-marker-stack) + (funcall (if (and references? (not lsp-xref-force-references)) + xref-show-xrefs-function + xref-show-definitions-function) + (-const xrefs) + `((window . ,(selected-window)) + (display-action . ,display-action) + ,(if (and references? (not lsp-xref-force-references)) + `(auto-jump . ,xref-auto-jump-to-first-xref) + `(auto-jump . ,xref-auto-jump-to-first-definition))))) + (xref--show-xrefs xrefs display-action))) + +(cl-defmethod seq-empty-p ((ht hash-table)) + "Function `seq-empty-p' for hash-table." + (hash-table-empty-p ht)) + +(cl-defun lsp-find-locations (method &optional extra &key display-action references?) + "Send request named METHOD and get cross references of the symbol under point. +EXTRA is a plist of extra parameters. +REFERENCES? t when METHOD returns references." + (let ((loc (lsp-request method + (append (lsp--text-document-position-params) extra)))) + (if (seq-empty-p loc) + (lsp--error "Not found for: %s" (or (thing-at-point 'symbol t) "")) + (lsp-show-xrefs (lsp--locations-to-xref-items loc) display-action references?)))) + +(cl-defun lsp-find-declaration (&key display-action) + "Find declarations of the symbol under point." + (interactive) + (lsp-find-locations "textDocument/declaration" nil :display-action display-action)) + +(cl-defun lsp-find-definition (&key display-action) + "Find definitions of the symbol under point." + (interactive) + (lsp-find-locations "textDocument/definition" nil :display-action display-action)) + +(defun lsp-find-definition-mouse (click) + "Click to start `lsp-find-definition' at clicked point." + (interactive "e") + (let* ((ec (event-start click)) + (p1 (posn-point ec)) + (w1 (posn-window ec))) + (select-window w1) + (goto-char p1) + (lsp-find-definition))) + +(cl-defun lsp-find-implementation (&key display-action) + "Find implementations of the symbol under point." + (interactive) + (lsp-find-locations "textDocument/implementation" + nil + :display-action display-action + :references? t)) + +(cl-defun lsp-find-references (&optional exclude-declaration &key display-action) + "Find references of the symbol under point." + (interactive "P") + (lsp-find-locations "textDocument/references" + (list :context `(:includeDeclaration ,(lsp-json-bool (not (or exclude-declaration lsp-references-exclude-declaration))))) + :display-action display-action + :references? t)) + +(cl-defun lsp-find-type-definition (&key display-action) + "Find type definitions of the symbol under point." + (interactive) + (lsp-find-locations "textDocument/typeDefinition" nil :display-action display-action)) + +(defalias 'lsp-find-custom #'lsp-find-locations) +(defalias 'lsp-goto-implementation #'lsp-find-implementation) +(defalias 'lsp-goto-type-definition #'lsp-find-type-definition) + +(with-eval-after-load 'evil + (evil-set-command-property 'lsp-find-definition :jump t) + (evil-set-command-property 'lsp-find-implementation :jump t) + (evil-set-command-property 'lsp-find-references :jump t) + (evil-set-command-property 'lsp-find-type-definition :jump t)) + +(defun lsp--workspace-method-supported? (check-command method capability workspace) + (with-lsp-workspace workspace + (if check-command + (funcall check-command workspace) + (or + (when capability (lsp--capability capability)) + (lsp--registered-capability method) + (and (not capability) (not check-command)))))) + +(defun lsp-disable-method-for-server (method server-id) + "Disable METHOD for SERVER-ID." + (cl-callf + (lambda (reqs) + (-let (((&plist :check-command :capability) reqs)) + (list :check-command + (lambda (workspace) + (unless (-> workspace + lsp--workspace-client + lsp--client-server-id + (eq server-id)) + (lsp--workspace-method-supported? check-command + method + capability + workspace)))))) + (alist-get method lsp-method-requirements nil nil 'string=))) + +(defun lsp--find-workspaces-for (msg-or-method) + "Find all workspaces in the current project that can handle MSG." + (let ((method (if (stringp msg-or-method) + msg-or-method + (plist-get msg-or-method :method)))) + (-if-let (reqs (cdr (assoc method lsp-method-requirements))) + (-let (((&plist :capability :check-command) reqs)) + (-filter + (-partial #'lsp--workspace-method-supported? + check-command method capability) + (lsp-workspaces))) + (lsp-workspaces)))) + +(defun lsp-can-execute-command? (command-name) + "Returns non-nil if current language server(s) can execute COMMAND-NAME. +The command is executed via `workspace/executeCommand'" + (cl-position + command-name + (lsp:execute-command-options-commands + (lsp:server-capabilities-execute-command-provider? + (lsp--server-capabilities))) + :test #'equal)) + +(defalias 'lsp-feature? 'lsp--find-workspaces-for) + +(cl-defmethod lsp-execute-command (_server _command _arguments) + "Dispatch COMMAND execution." + (signal 'cl-no-applicable-method nil)) + +(defun lsp-workspace-command-execute (command &optional args) + "Execute workspace COMMAND with ARGS." + (condition-case-unless-debug err + (let ((params (if args + (list :command command :arguments args) + (list :command command)))) + (lsp-request "workspace/executeCommand" params)) + (error + (error "`workspace/executeCommand' with `%s' failed.\n\n%S" + command err)))) + +(defun lsp-send-execute-command (command &optional args) + "Create and send a `workspace/executeCommand' message having command COMMAND +and optional ARGS." + (lsp-workspace-command-execute command args)) + +(defalias 'lsp-point-to-position #'lsp--point-to-position) +(defalias 'lsp-text-document-identifier #'lsp--text-document-identifier) +(defalias 'lsp--send-execute-command #'lsp-send-execute-command) +(defalias 'lsp-on-open #'lsp--text-document-did-open) +(defalias 'lsp-on-save #'lsp--text-document-did-save) + +(defun lsp--set-configuration (settings) + "Set the SETTINGS for the lsp server." + (lsp-notify "workspace/didChangeConfiguration" `(:settings ,settings))) + +(defun lsp-current-buffer () + (or lsp--virtual-buffer + (current-buffer))) + +(defun lsp-buffer-live-p (buffer-id) + (if-let* ((buffer-live (plist-get buffer-id :buffer-live?))) + (funcall buffer-live buffer-id) + (buffer-live-p buffer-id))) + +(defun lsp--on-set-visited-file-name (old-func &rest args) + "Advice around function `set-visited-file-name'. + +This advice sends textDocument/didClose for the old file and +textDocument/didOpen for the new file." + (when lsp--cur-workspace + (lsp--text-document-did-close t)) + (prog1 (apply old-func args) + (when lsp--cur-workspace + (lsp--text-document-did-open)))) + +(advice-add 'set-visited-file-name :around #'lsp--on-set-visited-file-name) + +(defcustom lsp-flush-delayed-changes-before-next-message t + "If non-nil send the document changes update before sending other messages. + +If nil, and `lsp-debounce-full-sync-notifications' is non-nil, + change notifications will be throttled by + `lsp-debounce-full-sync-notifications-interval' regardless of + other messages." + :group 'lsp-mode + :type 'boolean) + +(defvar lsp--not-flushing-delayed-changes t) + +(defun lsp--send-no-wait (message proc) + "Send MESSAGE to PROC without waiting for further output." + + (when (and lsp--not-flushing-delayed-changes + lsp-flush-delayed-changes-before-next-message) + (let ((lsp--not-flushing-delayed-changes nil)) + (lsp--flush-delayed-changes))) + (lsp-process-send proc message)) + +(define-error 'lsp-parse-error + "Error parsing message from language server" 'lsp-error) +(define-error 'lsp-unknown-message-type + "Unknown message type" '(lsp-error lsp-parse-error)) +(define-error 'lsp-unknown-json-rpc-version + "Unknown JSON-RPC protocol version" '(lsp-error lsp-parse-error)) +(define-error 'lsp-no-content-length + "Content-Length header missing in message" '(lsp-error lsp-parse-error)) +(define-error 'lsp-invalid-header-name + "Invalid header name" '(lsp-error lsp-parse-error)) + +;; id method +;; x x request +;; x . response +;; . x notification +(defun lsp--get-message-type (json-data) + "Get the message type from JSON-DATA." + (if (lsp:json-message-id? json-data) + (if (lsp:json-message-error? json-data) + 'response-error + (if (lsp:json-message-method? json-data) + 'request + 'response)) + 'notification)) + +(defconst lsp--default-notification-handlers + (ht ("window/showMessage" #'lsp--window-show-message) + ("window/logMessage" #'lsp--window-log-message) + ("window/showInputBox" #'lsp--window-show-input-box) + ("window/showQuickPick" #'lsp--window-show-quick-pick) + ("textDocument/publishDiagnostics" #'lsp--on-diagnostics) + ("textDocument/diagnosticsEnd" #'ignore) + ("textDocument/diagnosticsBegin" #'ignore) + ("telemetry/event" #'ignore) + ("$/progress" (lambda (workspace params) + (funcall lsp-progress-function workspace params))))) + +(lsp-defun lsp--on-notification (workspace (&JSONNotification :params :method)) + "Call the appropriate handler for NOTIFICATION." + (-let ((client (lsp--workspace-client workspace))) + (when (lsp--log-io-p method) + (lsp--log-entry-new (lsp--make-log-entry method nil params 'incoming-notif) + lsp--cur-workspace)) + (if-let* ((handler (or (gethash method (lsp--client-notification-handlers client)) + (gethash method lsp--default-notification-handlers)))) + (funcall handler workspace params) + (when (and method (not (string-prefix-p "$" method))) + (lsp-warn "Unknown notification: %s" method))))) + +(lsp-defun lsp--build-workspace-configuration-response ((&ConfigurationParams :items)) + "Get section configuration. +PARAMS are the `workspace/configuration' request params" + (->> items + (-map (-lambda ((&ConfigurationItem :section?)) + (-let* ((path-parts (split-string section? "\\.")) + (path-without-last (s-join "." (-slice path-parts 0 -1))) + (path-parts-len (length path-parts))) + (cond + ((<= path-parts-len 1) + (ht-get (lsp-configuration-section section?) + (car-safe path-parts) + (ht-create))) + ((> path-parts-len 1) + (when-let* ((section (lsp-configuration-section path-without-last)) + (keys path-parts)) + (while (and keys section) + (setf section (ht-get section (pop keys)))) + section)))))) + (apply #'vector))) + +(defun lsp--ms-since (timestamp) + "Integer number of milliseconds since TIMESTAMP. Fractions discarded." + (floor (* 1000 (float-time (time-since timestamp))))) + +(defun lsp--send-request-response (workspace recv-time request response) + "Send the RESPONSE for REQUEST in WORKSPACE and log if needed." + (-let* (((&JSONResponse :params :method :id) request) + (process (lsp--workspace-proc workspace)) + (response (lsp--make-response id response)) + (req-entry (and lsp-log-io + (lsp--make-log-entry method id params 'incoming-req))) + (resp-entry (and lsp-log-io + (lsp--make-log-entry method id response 'outgoing-resp + (lsp--ms-since recv-time))))) + ;; Send response to the server. + (when (lsp--log-io-p method) + (lsp--log-entry-new req-entry workspace) + (lsp--log-entry-new resp-entry workspace)) + (lsp--send-no-wait response process))) + +(lsp-defun lsp--on-request (workspace (request &as &JSONRequest :params :method)) + "Call the appropriate handler for REQUEST, and send the return value to the +server. WORKSPACE is the active workspace." + (-let* ((recv-time (current-time)) + (client (lsp--workspace-client workspace)) + (buffers (lsp--workspace-buffers workspace)) + handler + (response (cond + ((setq handler (gethash method (lsp--client-request-handlers client) nil)) + (funcall handler workspace params)) + ((setq handler (gethash method (lsp--client-async-request-handlers client) nil)) + (funcall handler workspace params + (-partial #'lsp--send-request-response + workspace recv-time request)) + 'delay-response) + ((equal method "client/registerCapability") + (mapc #'lsp--server-register-capability + (lsp:registration-params-registrations params)) + (mapc (lambda (buf) + (when (lsp-buffer-live-p buf) + (lsp-with-current-buffer buf + (lsp-unconfig-buffer) + (lsp-configure-buffer)))) + buffers) + nil) + ((equal method "window/showMessageRequest") + (let ((choice (lsp--window-log-message-request params))) + `(:title ,choice))) + ((equal method "window/showDocument") + (let ((success? (lsp--window-show-document params))) + (lsp-make-show-document-result :success (or success? + :json-false)))) + ((equal method "client/unregisterCapability") + (mapc #'lsp--server-unregister-capability + (lsp:unregistration-params-unregisterations params)) + (mapc (lambda (buf) + (when (lsp-buffer-live-p buf) + (lsp-with-current-buffer buf + (lsp-unconfig-buffer) + (lsp-configure-buffer)))) + buffers) + nil) + ((equal method "workspace/applyEdit") + (list :applied (condition-case err + (prog1 t + (lsp--apply-workspace-edit (lsp:apply-workspace-edit-params-edit params) 'server-requested)) + (error + (lsp--error "Failed to apply edits with message %s" + (error-message-string err)) + :json-false)))) + ((equal method "workspace/configuration") + (with-lsp-workspace workspace + (if-let* ((buf (car buffers))) + (lsp-with-current-buffer buf + (lsp--build-workspace-configuration-response params)) + (lsp--with-workspace-temp-buffer (lsp--workspace-root workspace) + (lsp--build-workspace-configuration-response params))))) + ((equal method "workspace/workspaceFolders") + (let ((folders (or (-> workspace + (lsp--workspace-client) + (lsp--client-server-id) + (gethash (lsp-session-server-id->folders (lsp-session)))) + (lsp-session-folders (lsp-session))))) + (->> folders + (-distinct) + (-map (lambda (folder) + (list :uri (lsp--path-to-uri folder)))) + (apply #'vector)))) + ((equal method "window/workDoneProgress/create") + nil ;; no specific reply, no processing required + ) + ((equal method "workspace/semanticTokens/refresh") + (when (and lsp-semantic-tokens-enable + (fboundp 'lsp--semantic-tokens-on-refresh)) + (lsp--semantic-tokens-on-refresh workspace)) + nil) + ((equal method "workspace/codeLens/refresh") + (when (and lsp-lens-enable + (fboundp 'lsp--lens-on-refresh)) + (lsp--lens-on-refresh workspace)) + nil) + ((equal method "workspace/diagnostic/refresh") + nil) + (t (lsp-warn "Unknown request method: %s" method) nil)))) + ;; Send response to the server. + (unless (eq response 'delay-response) + (lsp--send-request-response workspace recv-time request response)))) + +(lsp-defun lsp--error-string ((&JSONError :message :code)) + "Format ERR as a user friendly string." + (format "Error from the Language Server: %s (%s)" + message + (or (car (alist-get code lsp--errors)) "Unknown error"))) + +(defun lsp--get-body-length (headers) + (let ((content-length (cdr (assoc "Content-Length" headers)))) + (if content-length + (string-to-number content-length) + + ;; This usually means either the server or our parser is + ;; screwed up with a previous Content-Length + (error "No Content-Length header")))) + +(defun lsp--parse-header (s) + "Parse string S as a LSP (KEY . VAL) header." + (let ((pos (string-match "\:" s)) + key val) + (unless pos + (signal 'lsp-invalid-header-name (list s))) + (setq key (substring s 0 pos) + val (s-trim-left (substring s (+ 1 pos)))) + (when (equal key "Content-Length") + (cl-assert (cl-loop for c across val + when (or (> c ?9) (< c ?0)) return nil + finally return t) + nil (format "Invalid Content-Length value: %s" val))) + (cons key val))) + +(defmacro lsp--read-json (str) + "Read json string STR." + (if (progn + (require 'json) + (fboundp 'json-parse-string)) + `(json-parse-string ,str + :object-type (if lsp-use-plists + 'plist + 'hash-table) + :null-object nil + :false-object nil) + `(let ((json-array-type 'vector) + (json-object-type (if lsp-use-plists + 'plist + 'hash-table)) + (json-false nil)) + (json-read-from-string ,str)))) + +(defmacro lsp-json-read-buffer () + "Read json from the current buffer." + (if (progn + (require 'json) + (fboundp 'json-parse-buffer)) + `(json-parse-buffer :object-type (if lsp-use-plists + 'plist + 'hash-table) + :null-object nil + :false-object nil) + `(let ((json-array-type 'vector) + (json-object-type (if lsp-use-plists + 'plist + 'hash-table)) + (json-false nil)) + (json-read)))) + +(defun lsp--read-json-file (file-path) + "Read json file." + (-> file-path + (f-read-text) + (lsp--read-json))) + +(defun lsp--parser-on-message (json-data workspace) + "Called when the parser P read a complete MSG from the server." + (with-demoted-errors "Error processing message %S." + (with-lsp-workspace workspace + (let* ((client (lsp--workspace-client workspace)) + (id (--when-let (lsp:json-response-id json-data) + (if (stringp it) (string-to-number it) it))) + (data (lsp:json-response-result json-data))) + (pcase (lsp--get-message-type json-data) + ('response + (cl-assert id) + (-let [(callback _ method _ before-send) (gethash id (lsp--client-response-handlers client))] + (when (lsp--log-io-p method) + (lsp--log-entry-new + (lsp--make-log-entry method id data 'incoming-resp + (lsp--ms-since before-send)) + workspace)) + (when callback + (remhash id (lsp--client-response-handlers client)) + (funcall callback (lsp:json-response-result json-data))))) + ('response-error + (cl-assert id) + (-let [(_ callback method _ before-send) (gethash id (lsp--client-response-handlers client))] + (when (lsp--log-io-p method) + (lsp--log-entry-new + (lsp--make-log-entry method id (lsp:json-response-error-error json-data) + 'incoming-resp (lsp--ms-since before-send)) + workspace)) + (when callback + (remhash id (lsp--client-response-handlers client)) + (funcall callback (lsp:json-response-error-error json-data))))) + ('notification + (lsp--on-notification workspace json-data)) + ('request (lsp--on-request workspace json-data))))))) + +(defun lsp--create-filter-function (workspace) + "Make filter for the workspace." + (let ((body-received 0) + leftovers body-length body chunk) + (lambda (_proc input) + (setf chunk (if (s-blank? leftovers) + (encode-coding-string input 'utf-8-unix t) + (concat leftovers (encode-coding-string input 'utf-8-unix t)))) + + (let (messages) + (while (not (s-blank? chunk)) + (if (not body-length) + ;; Read headers + (if-let* ((body-sep-pos (string-match-p "\r\n\r\n" chunk))) + ;; We've got all the headers, handle them all at once: + (setf body-length (lsp--get-body-length + (mapcar #'lsp--parse-header + (split-string + (substring-no-properties chunk + (or (string-match-p "Content-Length" chunk) + (error "Unable to find Content-Length header.")) + body-sep-pos) + "\r\n"))) + body-received 0 + leftovers nil + chunk (substring-no-properties chunk (+ body-sep-pos 4))) + + ;; Haven't found the end of the headers yet. Save everything + ;; for when the next chunk arrives and await further input. + (setf leftovers chunk + chunk nil)) + (let* ((chunk-length (string-bytes chunk)) + (left-to-receive (- body-length body-received)) + (this-body (if (< left-to-receive chunk-length) + (prog1 (substring-no-properties chunk 0 left-to-receive) + (setf chunk (substring-no-properties chunk left-to-receive))) + (prog1 chunk + (setf chunk nil)))) + (body-bytes (string-bytes this-body))) + (push this-body body) + (setf body-received (+ body-received body-bytes)) + (when (>= chunk-length left-to-receive) + (condition-case err + (with-temp-buffer + (apply #'insert + (nreverse + (prog1 body + (setf leftovers nil + body-length nil + body-received nil + body nil)))) + (decode-coding-region (point-min) + (point-max) + 'utf-8) + (goto-char (point-min)) + (push (lsp-json-read-buffer) messages)) + + (error + (lsp-warn "Failed to parse the following chunk:\n'''\n%s\n'''\nwith message %s" + (concat leftovers input) + err))))))) + (mapc (lambda (msg) + (lsp--parser-on-message msg workspace)) + (nreverse messages)))))) + +(defvar-local lsp--line-col-to-point-hash-table nil + "Hash table with keys (line . col) and values that are either point positions +or markers.") + +(defcustom lsp-imenu-detailed-outline t + "Whether `lsp-imenu' should include signatures. +This will be ignored if the server doesn't provide the necessary +information, for example if it doesn't support DocumentSymbols." + :group 'lsp-imenu + :type 'boolean) + +(defcustom lsp-imenu-hide-parent-details t + "Whether `lsp-imenu' should hide signatures of parent nodes." + :group 'lsp-imenu + :type 'boolean) + +(defface lsp-details-face '((t :height 0.8 :inherit shadow)) + "Used to display additional information throughout `lsp'. +Things like line numbers, signatures, ... are considered +additional information. Often, additional faces are defined that +inherit from this face by default, like `lsp-signature-face', and +they may be customized for finer control." + :group 'lsp-mode) + +(defface lsp-signature-face '((t :inherit lsp-details-face)) + "Used to display signatures in `imenu', ...." + :group 'lsp-mode) + +(lsp-defun lsp-render-symbol ((&DocumentSymbol :name :detail? :deprecated?) + show-detail?) + "Render INPUT0, an `&DocumentSymbol', to a string. +If SHOW-DETAIL? is set, make use of its `:detail?' field (often +the signature)." + (let ((detail (and show-detail? (s-present? detail?) + (propertize (concat " " (s-trim-left detail?)) + 'face 'lsp-signature-face))) + (name (if deprecated? + (propertize name 'face 'lsp-face-semhl-deprecated) name))) + (concat name detail))) + +(lsp-defun lsp-render-symbol-information ((&SymbolInformation :name :deprecated? :container-name?) + separator) + "Render a piece of SymbolInformation. +Handle :deprecated?. If SEPARATOR is non-nil, the +symbol's (optional) parent, SEPARATOR and the symbol itself are +concatenated." + (when (and separator container-name? (not (string-empty-p container-name?))) + (setq name (concat name separator container-name?))) + (if deprecated? (propertize name 'face 'lsp-face-semhl-deprecated) name)) + +(defun lsp--symbol-to-imenu-elem (sym) + "Convert SYM to imenu element. + +SYM is a SymbolInformation message. + +Return a cons cell (full-name . start-point)." + (let ((start-point (ht-get lsp--line-col-to-point-hash-table + (lsp--get-line-and-col sym)))) + (cons (lsp-render-symbol-information + sym (and lsp-imenu-show-container-name + lsp-imenu-container-name-separator)) + start-point))) + +(lsp-defun lsp--symbol-to-hierarchical-imenu-elem ((sym &as &DocumentSymbol :children?)) + "Convert SYM to hierarchical imenu elements. + +SYM is a DocumentSymbol message. + +Return cons cell (\"symbol-name (symbol-kind)\" . start-point) if +SYM doesn't have any children. Otherwise return a cons cell with +an alist + + (\"symbol-name\" . ((\"(symbol-kind)\" . start-point) + cons-cells-from-children))" + (let ((filtered-children (lsp--imenu-filter-symbols children?)) + (signature (lsp-render-symbol sym lsp-imenu-detailed-outline))) + (if (seq-empty-p filtered-children) + (cons signature + (ht-get lsp--line-col-to-point-hash-table + (lsp--get-line-and-col sym))) + (cons signature + (lsp--imenu-create-hierarchical-index filtered-children))))) + +(lsp-defun lsp--symbol-ignore ((&SymbolInformation :kind)) + "Determine if SYM is for the current document and is to be shown." + ;; It's a SymbolInformation or DocumentSymbol, which is always in the + ;; current buffer file. + (and lsp-imenu-index-symbol-kinds + (numberp kind) + (let ((clamped-kind (if (< 0 kind (length lsp/symbol-kind-lookup)) + kind + 0))) + (not (memql (aref lsp/symbol-kind-lookup clamped-kind) + lsp-imenu-index-symbol-kinds))))) + +(lsp-defun lsp--get-symbol-type ((&SymbolInformation :kind)) + "The string name of the kind of SYM." + (alist-get kind lsp-symbol-kinds "Other")) + +(defun lsp--get-line-and-col (sym) + "Obtain the line and column corresponding to SYM." + (-let* ((location (lsp:symbol-information-location sym)) + (name-range (or (and location (lsp:location-range location)) + (lsp:document-symbol-selection-range sym))) + ((&Range :start (&Position :line :character)) name-range)) + (cons line character))) + +(defun lsp--collect-lines-and-cols (symbols) + "Return a sorted list ((line . col) ...) of the locations of SYMBOLS." + (let ((stack (mapcar 'identity symbols)) + line-col-list) + (while stack + (let ((sym (pop stack))) + (push (lsp--get-line-and-col sym) line-col-list) + (unless (seq-empty-p (lsp:document-symbol-children? sym)) + (setf stack (nconc (lsp--imenu-filter-symbols (lsp:document-symbol-children? sym)) stack))))) + (-sort #'lsp--line-col-comparator line-col-list))) + +(defun lsp--convert-line-col-to-points-batch (line-col-list) + "Convert a sorted list of positions from line-column +representation to point representation." + (let ((line-col-to-point-map (ht-create)) + (inhibit-field-text-motion t) + (curr-line 0)) + (lsp-save-restriction-and-excursion + (goto-char (point-min)) + (cl-loop for (line . col) in line-col-list do + (forward-line (- line curr-line)) + (setq curr-line line) + (let ((line-end (line-end-position))) + (if (or (not col) (> col (- line-end (point)))) + (goto-char line-end) + (forward-char col))) + (ht-set! line-col-to-point-map (cons line col) (if imenu-use-markers + (point-marker) + (point))))) + line-col-to-point-map)) + +(cl-defun lsp--line-col-comparator ((l1 . c1) (l2 . c2)) + (or (< l1 l2) + (and (= l1 l2) + (cond ((and c1 c2) + (< c1 c2)) + (c1 t))))) + +(defun lsp-imenu-create-uncategorized-index (symbols) + "Create imenu index from document SYMBOLS. +This function, unlike `lsp-imenu-create-categorized-index', does +not categorize by type, but instead returns an `imenu' index +corresponding to the symbol hierarchy returned by the server +directly." + (let* ((lsp--line-col-to-point-hash-table (-> symbols + lsp--collect-lines-and-cols + lsp--convert-line-col-to-points-batch))) + (if (lsp--imenu-hierarchical-p symbols) + (lsp--imenu-create-hierarchical-index symbols) + (lsp--imenu-create-non-hierarchical-index symbols)))) + +(defcustom lsp-imenu-symbol-kinds + '((1 . "Files") + (2 . "Modules") + (3 . "Namespaces") + (4 . "Packages") + (5 . "Classes") + (6 . "Methods") + (7 . "Properties") + (8 . "Fields") + (9 . "Constructors") + (10 . "Enums") + (11 . "Interfaces") + (12 . "Functions") + (13 . "Variables") + (14 . "Constants") + (15 . "Strings") + (16 . "Numbers") + (17 . "Booleans") + (18 . "Arrays") + (19 . "Objects") + (20 . "Keys") + (21 . "Nulls") + (22 . "Enum Members") + (23 . "Structs") + (24 . "Events") + (25 . "Operators") + (26 . "Type Parameters")) + "`lsp-symbol-kinds', but only used by `imenu'. +A new variable is needed, as it is `imenu' convention to use +pluralized categories, which `lsp-symbol-kinds' doesn't. If the +non-pluralized names are preferred, this can be set to +`lsp-symbol-kinds'." + :type '(alist :key-type integer :value-type string)) + +(defun lsp--imenu-kind->name (kind) + (alist-get kind lsp-imenu-symbol-kinds "?")) + +(defun lsp-imenu-create-top-level-categorized-index (symbols) + "Create an `imenu' index categorizing SYMBOLS by type. +Only root symbols are categorized. + +See `lsp-symbol-kinds' to customize the category naming. SYMBOLS +shall be a list of DocumentSymbols or SymbolInformation." + (mapcan + (-lambda ((type . symbols)) + (let ((cat (lsp--imenu-kind->name type)) + (symbols (lsp-imenu-create-uncategorized-index symbols))) + ;; If there is no :kind (this is being defensive), or we couldn't look it + ;; up, just display the symbols inline, without categories. + (if cat (list (cons cat symbols)) symbols))) + (sort (seq-group-by #'lsp:document-symbol-kind symbols) + (-lambda ((kinda) (kindb)) (< kinda kindb))))) + +(lsp-defun lsp--symbol->imenu ((sym &as &DocumentSymbol :selection-range (&RangeToPoint :start))) + "Convert an `&DocumentSymbol' to an `imenu' entry." + (cons (lsp-render-symbol sym lsp-imenu-detailed-outline) start)) + +(defun lsp--imenu-create-categorized-index-1 (symbols) + "Returns an `imenu' index from SYMBOLS categorized by type. +The result looks like this: ((\"Variables\" . (...)))." + (->> + symbols + (mapcan + (-lambda ((sym &as &DocumentSymbol :kind :children?)) + (if (seq-empty-p children?) + (list (list kind (lsp--symbol->imenu sym))) + (let ((parent (lsp-render-symbol sym (and lsp-imenu-detailed-outline + (not lsp-imenu-hide-parent-details))))) + (cons + (list kind (lsp--symbol->imenu sym)) + (mapcar (-lambda ((type . imenu-items)) + (list type (cons parent (mapcan #'cdr imenu-items)))) + (-group-by #'car (lsp--imenu-create-categorized-index-1 children?)))))))) + (-group-by #'car) + (mapcar + (-lambda ((kind . syms)) + (cons kind (mapcan #'cdr syms)))))) + +(defun lsp--imenu-create-categorized-index (symbols) + (let ((syms (lsp--imenu-create-categorized-index-1 symbols))) + (dolist (sym syms) + (setcar sym (lsp--imenu-kind->name (car sym)))) + syms)) + +(lsp-defun lsp--symbol-information->imenu ((sym &as &SymbolInformation :location (&Location :range (&RangeToPoint :start)))) + (cons (lsp-render-symbol-information sym nil) start)) + +(defun lsp--imenu-create-categorized-index-flat (symbols) + "Create a kind-categorized index for SymbolInformation." + (mapcar (-lambda ((kind . syms)) + (cons (lsp--imenu-kind->name kind) + (mapcan (-lambda ((parent . children)) + (let ((children (mapcar #'lsp--symbol-information->imenu children))) + (if parent (list (cons parent children)) children))) + (-group-by #'lsp:symbol-information-container-name? syms)))) + (seq-group-by #'lsp:symbol-information-kind symbols))) + +(defun lsp-imenu-create-categorized-index (symbols) + (if (lsp--imenu-hierarchical-p symbols) + (lsp--imenu-create-categorized-index symbols) + (lsp--imenu-create-categorized-index-flat symbols))) + +(defcustom lsp-imenu-index-function #'lsp-imenu-create-uncategorized-index + "Function that should create an `imenu' index. +It will be called with a list of SymbolInformation or +DocumentSymbols, whose first level is already filtered. It shall +then return an appropriate `imenu' index (see +`imenu-create-index-function'). + +Note that this interface is not stable, and subject to change any +time." + :group 'lsp-imenu + :type '(radio + (const :tag "Categorize by type" + lsp-imenu-create-categorized-index) + (const :tag "Categorize root symbols by type" + lsp-imenu-create-top-level-categorized-index) + (const :tag "Uncategorized, inline entries" + lsp-imenu-create-uncategorized-index) + (function :tag "Custom function"))) + +(defun lsp--imenu-create-index () + "Create an `imenu' index based on the language server. +Respects `lsp-imenu-index-function'." + (let ((symbols (lsp--imenu-filter-symbols (lsp--get-document-symbols)))) + (funcall lsp-imenu-index-function symbols))) + +(defun lsp--imenu-filter-symbols (symbols) + "Filter out unsupported symbols from SYMBOLS." + (seq-remove #'lsp--symbol-ignore symbols)) + +(defun lsp--imenu-hierarchical-p (symbols) + "Determine whether any element in SYMBOLS has children." + (seq-some #'lsp-document-symbol? symbols)) + +(defun lsp--imenu-create-non-hierarchical-index (symbols) + "Create imenu index for non-hierarchical SYMBOLS. + +SYMBOLS are a list of DocumentSymbol messages. + +Return a nested alist keyed by symbol names. e.g. + + ((\"SomeClass\" (\"(Class)\" . 10) + (\"someField (Field)\" . 20) + (\"someFunction (Function)\" . 25) + (\"SomeSubClass\" (\"(Class)\" . 30) + (\"someSubField (Field)\" . 35)) + (\"someFunction (Function)\" . 40))" + (seq-map (lambda (nested-alist) + (cons (car nested-alist) + (seq-map #'lsp--symbol-to-imenu-elem (cdr nested-alist)))) + (seq-group-by #'lsp--get-symbol-type symbols))) + +(defun lsp--imenu-create-hierarchical-index (symbols) + "Create imenu index for hierarchical SYMBOLS. + +SYMBOLS are a list of DocumentSymbol messages. + +Return a nested alist keyed by symbol names. e.g. + + ((\"SomeClass\" (\"(Class)\" . 10) + (\"someField (Field)\" . 20) + (\"someFunction (Function)\" . 25) + (\"SomeSubClass\" (\"(Class)\" . 30) + (\"someSubField (Field)\" . 35)) + (\"someFunction (Function)\" . 40))" + (seq-map #'lsp--symbol-to-hierarchical-imenu-elem + (seq-sort #'lsp--imenu-symbol-lessp symbols))) + +(defun lsp--imenu-symbol-lessp (sym1 sym2) + (let* ((compare-results (mapcar (lambda (method) + (funcall (alist-get method lsp--imenu-compare-function-alist) + sym1 sym2)) + lsp-imenu-sort-methods)) + (result (seq-find (lambda (result) + (not (= result 0))) + compare-results + 0))) + (and (numberp result) (< result 0)))) + +(lsp-defun lsp--imenu-compare-kind ((&SymbolInformation :kind left) + (&SymbolInformation :kind right)) + "Compare SYM1 and SYM2 by kind." + (- left right)) + +(defun lsp--imenu-compare-line-col (sym1 sym2) + (if (lsp--line-col-comparator + (lsp--get-line-and-col sym1) + (lsp--get-line-and-col sym2)) + -1 + 1)) + +(lsp-defun lsp--imenu-compare-name ((&SymbolInformation :name name1) + (&SymbolInformation :name name2)) + "Compare SYM1 and SYM2 by name." + (let ((result (compare-strings name1 0 (length name1) name2 0 (length name2)))) + (if (numberp result) result 0))) + +(defun lsp--imenu-refresh () + "Force Imenu to refresh itself." + (imenu--menubar-select imenu--rescan-item)) + +(defun lsp-enable-imenu () + "Use lsp-imenu for the current buffer." + (imenu--cleanup) + (add-function :override (local 'imenu-create-index-function) #'lsp--imenu-create-index) + (setq-local imenu-menubar-modified-tick -1) + (setq-local imenu--index-alist nil) + (when menu-bar-mode + (lsp--imenu-refresh))) + +(defun lsp-resolve-final-command (command &optional test?) + "Resolve final function COMMAND." + (let* ((command (lsp-resolve-value command)) + (command (cl-etypecase command + (list + (cl-assert (seq-every-p (apply-partially #'stringp) command) nil + "Invalid command list") + command) + (string (list command))))) + (if (and (file-remote-p default-directory) (not test?)) + (list shell-file-name "-c" + (string-join (cons "stty raw > /dev/null;" + (mapcar #'shell-quote-argument command)) + " ")) + command))) + +(defun lsp-server-present? (final-command) + "Check whether FINAL-COMMAND is present." + (let ((binary-found? (executable-find (cl-first final-command) t))) + (if binary-found? + (lsp-log "Command \"%s\" is present on the path." (s-join " " final-command)) + (lsp-log "Command \"%s\" is not present on the path." (s-join " " final-command))) + binary-found?)) + +(defun lsp--value-to-string (value) + "Convert VALUE to a string that can be set as value in an environment +variable." + (cond + ((stringp value) value) + ((booleanp value) (if value + "1" + "0")) + ((and (sequencep value) + (seq-every-p #'stringp value)) (string-join value ":")) + (t (user-error "Only strings, booleans, and sequences of strings are supported as environment variables")))) + +(defun lsp--compute-process-environment (environment-fn) + "Append a list of KEY=VALUE from the alist ENVIRONMENT to `process-environment'. +Ignore non-boolean keys whose value is nil." + (let ((environment (if environment-fn + (funcall environment-fn) + nil))) + (-flatten (cons (cl-loop for (key . value) in environment + if (or (eval value) + (eq (get value 'custom-type) 'boolean)) + collect (concat key "=" (lsp--value-to-string + (eval value)))) + process-environment)))) + +(defun lsp--default-directory-for-connection (&optional path) + "Return path to be used for the working directory of a LSP process. + +If `lsp-use-workspace-root-for-server-default-directory' is +non-nil, uses `lsp-workspace-root' to find the directory +corresponding to PATH, else returns `default-directory'." + (if lsp-use-workspace-root-for-server-default-directory + (lsp-workspace-root path) + default-directory)) + +(defun lsp--fix-remote-cmd (program) + "Helper for `lsp-stdio-connection'. +Originally coppied from eglot." + + (if (file-remote-p default-directory) + (list shell-file-name "-c" + (string-join (cons "stty raw > /dev/null;" + (mapcar #'shell-quote-argument program)) + " ")) + program)) + +(defvar tramp-use-ssh-controlmaster-options) +(defvar tramp-ssh-controlmaster-options) + +(defun lsp-stdio-connection (command &optional test-command) + "Returns a connection property list using COMMAND. +COMMAND can be: A string, denoting the command to launch the +language server. A list of strings, denoting an executable with +its command line arguments. A function, that either returns a +string or a list of strings. In all cases, the launched language +server should send and receive messages on standard I/O. +TEST-COMMAND is a function with no arguments which returns +whether the command is present or not. When not specified +`lsp-mode' will check whether the first element of the list +returned by COMMAND is available via `executable-find'" + (cl-check-type command (or string + function + (and list + (satisfies (lambda (l) + (seq-every-p (lambda (el) + (stringp el)) + l)))))) + (list :connect (lambda (filter sentinel name environment-fn workspace) + (if (and (functionp 'json-rpc-connection) + (not (file-remote-p default-directory))) + (lsp-json-rpc-connection workspace (lsp-resolve-final-command command)) + (let ((final-command (lsp-resolve-final-command command)) + (process-name (generate-new-buffer-name name)) + (process-environment + (lsp--compute-process-environment environment-fn))) + (let* ((stderr-buf (get-buffer-create (format "*%s::stderr*" process-name))) + (default-directory (lsp--default-directory-for-connection)) + (tramp-use-ssh-controlmaster-options 'suppress) + (tramp-ssh-controlmaster-options "-o ControlMaster=no -o ControlPath=none") + (proc (make-process + :name process-name + :connection-type 'pipe + :buffer (format "*%s*" process-name) + :coding 'no-conversion + :command final-command + :filter filter + :sentinel sentinel + :stderr stderr-buf + :noquery t + :file-handler t))) + (set-process-query-on-exit-flag proc nil) + (set-process-query-on-exit-flag (get-buffer-process stderr-buf) nil) + (with-current-buffer (get-buffer stderr-buf) + ;; Make the *NAME::stderr* buffer buffer-read-only, q to bury, etc. + (special-mode)) + (cons proc proc))))) + :test? (or + test-command + (lambda () + (lsp-server-present? (lsp-resolve-final-command command t)))))) + +(defun lsp--open-network-stream (host port name) + "Open network stream to HOST:PORT. + NAME will be passed to `open-network-stream'. + RETRY-COUNT is the number of the retries. + SLEEP-INTERVAL is the sleep interval between each retry." + (let* ((retries 0) + (sleep-interval 0.01) + (number-of-retries (/ lsp-tcp-connection-timeout sleep-interval)) + connection) + (while (and (not connection) (< retries number-of-retries)) + (condition-case err + (setq connection (open-network-stream name nil host port + :type 'plain + :coding 'no-conversion)) + (file-error + (let ((inhibit-message t)) + (lsp--warn "Failed to connect to %s:%s with error message %s" + host + port + (error-message-string err)) + (sleep-for sleep-interval) + (cl-incf retries))))) + (or connection (error "Port %s was never taken. Consider increasing `lsp-tcp-connection-timeout'." port)))) + +(defun lsp--port-available (host port) + "Return non-nil if HOST and PORT are available." + (condition-case _err + (delete-process (open-network-stream "*connection-test*" nil host port :type 'plain)) + (file-error t))) + +(defun lsp--find-available-port (host starting-port) + "Find available port on HOST starting from STARTING-PORT." + (let ((port starting-port)) + (while (not (lsp--port-available host port)) + (cl-incf port)) + port)) + +(defun lsp-tcp-connection (command-fn) + "Returns a connection property list similar to `lsp-stdio-connection'. +COMMAND-FN can only be a function that takes a single argument, a +port number. It should return a command for launches a language server +process listening for TCP connections on the provided port." + (cl-check-type command-fn function) + (list + :connect (lambda (filter sentinel name environment-fn _workspace) + (let* ((host "localhost") + (port (lsp--find-available-port host (cl-incf lsp--tcp-port))) + (command (funcall command-fn port)) + (final-command (if (consp command) command (list command))) + (_ (unless (lsp-server-present? final-command) + (user-error (format "Couldn't find executable %s" (cl-first final-command))))) + (process-environment + (lsp--compute-process-environment environment-fn)) + (proc (make-process :name name :connection-type 'pipe :coding 'no-conversion + :command final-command :sentinel sentinel :stderr (format "*%s::stderr*" name) :noquery t)) + (tcp-proc (lsp--open-network-stream host port (concat name "::tcp")))) + + ;; TODO: Same :noquery issue (see above) + (set-process-query-on-exit-flag proc nil) + (set-process-query-on-exit-flag tcp-proc nil) + (set-process-filter tcp-proc filter) + (cons tcp-proc proc))) + :test? (lambda () (lsp-server-present? (funcall command-fn 0))))) + +(defalias 'lsp-tcp-server 'lsp-tcp-server-command) + +(defun lsp-tcp-server-command (command-fn) + "Create tcp server connection. +In this mode Emacs is TCP server and the language server connects +to it. COMMAND is function with one parameter(the port) and it +should return the command to start the LS server." + (cl-check-type command-fn function) + (list + :connect (lambda (filter sentinel name environment-fn _workspace) + (let* (tcp-client-connection + (tcp-server (make-network-process :name (format "*tcp-server-%s*" name) + :buffer (format "*tcp-server-%s*" name) + :family 'ipv4 + :service lsp--tcp-server-port + :sentinel (lambda (proc _string) + (lsp-log "Language server %s is connected." name) + (setf tcp-client-connection proc)) + :server 't)) + (port (process-contact tcp-server :service)) + (final-command (funcall command-fn port)) + (process-environment + (lsp--compute-process-environment environment-fn)) + (cmd-proc (make-process :name name + :connection-type 'pipe + :coding 'no-conversion + :command final-command + :stderr (format "*tcp-server-%s*::stderr" name) + :noquery t))) + (let ((retries 0)) + ;; wait for the client to connect (we sit-for 500 ms, so have to double lsp--tcp-server-wait-seconds) + (while (and (not tcp-client-connection) (< retries (* 2 lsp--tcp-server-wait-seconds))) + (lsp--info "Waiting for connection for %s, retries: %s" name retries) + (sit-for 0.500) + (cl-incf retries))) + + (unless tcp-client-connection + (condition-case nil (delete-process tcp-server) (error)) + (condition-case nil (delete-process cmd-proc) (error)) + (error "Failed to create connection to %s on port %s" name port)) + (lsp--info "Successfully connected to %s" name) + + (set-process-query-on-exit-flag cmd-proc nil) + (set-process-query-on-exit-flag tcp-client-connection nil) + (set-process-query-on-exit-flag tcp-server nil) + + (set-process-filter tcp-client-connection filter) + (set-process-sentinel tcp-client-connection sentinel) + (cons tcp-client-connection cmd-proc))) + :test? (lambda () (lsp-server-present? (funcall command-fn 0))))) + +(defalias 'lsp-tramp-connection 'lsp-stdio-connection) + +(defun lsp--auto-configure () + "Autoconfigure `company', `flycheck', `lsp-ui', etc if they are installed." + (when (functionp 'lsp-ui-mode) + (lsp-ui-mode)) + + (if lsp-headerline-breadcrumb-enable + (add-hook 'lsp-configure-hook 'lsp-headerline-breadcrumb-mode) + (remove-hook 'lsp-configure-hook 'lsp-headerline-breadcrumb-mode)) + (if lsp-modeline-code-actions-enable + (add-hook 'lsp-configure-hook 'lsp-modeline-code-actions-mode) + (remove-hook 'lsp-configure-hook 'lsp-modeline-code-actions-mode)) + (if lsp-modeline-diagnostics-enable + (add-hook 'lsp-configure-hook 'lsp-modeline-diagnostics-mode) + (remove-hook 'lsp-configure-hook 'lsp-modeline-diagnostics-mode)) + (if lsp-modeline-workspace-status-enable + (add-hook 'lsp-configure-hook 'lsp-modeline-workspace-status-mode) + (remove-hook 'lsp-configure-hook 'lsp-modeline-workspace-status-mode)) + (if lsp-lens-enable + (add-hook 'lsp-configure-hook 'lsp-lens--enable) + (remove-hook 'lsp-configure-hook 'lsp-lens--enable)) + (if lsp-semantic-tokens-enable + (add-hook 'lsp-configure-hook 'lsp-semantic-tokens--enable) + (remove-hook 'lsp-configure-hook 'lsp-semantic-tokens--enable)) + + ;; yas-snippet config + (setq-local yas-inhibit-overlay-modification-protection t)) + +(defun lsp--restart-if-needed (workspace) + "Handler restart for WORKSPACE." + (when (or (eq lsp-restart 'auto-restart) + (eq (lsp--workspace-shutdown-action workspace) 'restart) + (and (eq lsp-restart 'interactive) + (let ((query (format + "Server %s exited (check corresponding stderr buffer for details). Do you want to restart it?" + (lsp--workspace-print workspace)))) + (y-or-n-p query)))) + (--each (lsp--workspace-buffers workspace) + (when (lsp-buffer-live-p it) + (lsp-with-current-buffer it + (if lsp--buffer-deferred + (lsp-deferred) + (lsp--info "Restarting LSP in buffer %s" (buffer-name)) + (lsp))))))) + +(defun lsp--update-key (table key fn) + "Apply FN on value corresponding to KEY in TABLE." + (let ((existing-value (gethash key table))) + (if-let* ((new-value (funcall fn existing-value))) + (puthash key new-value table) + (remhash key table)))) + +(defun lsp--process-sentinel (workspace process exit-str) + "Create the sentinel for WORKSPACE." + (unless (process-live-p process) + (lsp--handle-process-exit workspace exit-str))) + +(defun lsp--handle-process-exit (workspace exit-str) + (let* ((folder->workspaces (lsp-session-folder->servers (lsp-session))) + (proc (lsp--workspace-proc workspace))) + (lsp--warn "%s has exited (%s)" + (lsp-process-name proc) + (string-trim-right (or exit-str ""))) + (with-lsp-workspace workspace + ;; Clean workspace related data in each of the buffers + ;; in the workspace. + (--each (lsp--workspace-buffers workspace) + (when (lsp-buffer-live-p it) + (lsp-with-current-buffer it + (setq lsp--buffer-workspaces (delete workspace lsp--buffer-workspaces)) + (lsp--uninitialize-workspace) + (lsp--spinner-stop) + (lsp--remove-overlays 'lsp-highlight)))) + + ;; Cleanup session from references to the closed workspace. + (--each (hash-table-keys folder->workspaces) + (lsp--update-key folder->workspaces it (apply-partially 'delete workspace))) + + (lsp-process-cleanup proc)) + + (run-hook-with-args 'lsp-after-uninitialized-functions workspace) + + (if (eq (lsp--workspace-shutdown-action workspace) 'shutdown) + (lsp--info "Workspace %s shutdown." (lsp--workspace-print workspace)) + (lsp--restart-if-needed workspace)) + (lsp--cleanup-hanging-watches))) + +(defun lsp-workspace-folders (workspace) + "Return all folders associated with WORKSPACE." + (let (result) + (->> (lsp-session) + (lsp-session-folder->servers) + (maphash (lambda (folder workspaces) + (when (-contains? workspaces workspace) + (push folder result))))) + result)) + +(defun lsp--start-workspace (session client-template root &optional initialization-options) + "Create new workspace for CLIENT-TEMPLATE with project root ROOT. +INITIALIZATION-OPTIONS are passed to initialize function. +SESSION is the active session." + (lsp--spinner-start) + (-let* ((default-directory root) + (client (copy-lsp--client client-template)) + (workspace (make-lsp--workspace + :root root + :client client + :status 'starting + :buffers (list (lsp-current-buffer)) + :host-root (file-remote-p root))) + ((&lsp-cln 'server-id 'environment-fn 'new-connection 'custom-capabilities + 'multi-root 'initialized-fn) client) + ((proc . cmd-proc) (funcall + (or (plist-get new-connection :connect) + (user-error "Client %s is configured incorrectly" client)) + (lsp--create-filter-function workspace) + (apply-partially #'lsp--process-sentinel workspace) + (format "%s" server-id) + environment-fn + workspace)) + (workspace-folders (gethash server-id (lsp-session-server-id->folders session)))) + (setf (lsp--workspace-proc workspace) proc + (lsp--workspace-cmd-proc workspace) cmd-proc) + + ;; update (lsp-session-folder->servers) depending on whether we are starting + ;; multi/single folder workspace + (mapc (lambda (project-root) + (->> session + (lsp-session-folder->servers) + (gethash project-root) + (cl-pushnew workspace))) + (or workspace-folders (list root))) + + (with-lsp-workspace workspace + (run-hooks 'lsp-before-initialize-hook) + (lsp-request-async + "initialize" + (append + (list :processId (unless (file-remote-p (buffer-file-name)) + (emacs-pid)) + :rootPath (lsp-file-local-name (expand-file-name root)) + :clientInfo (list :name "emacs" + :version (emacs-version)) + :rootUri (lsp--path-to-uri root) + :capabilities (lsp--client-capabilities custom-capabilities) + :initializationOptions initialization-options + :workDoneToken "1") + (when lsp-server-trace + (list :trace lsp-server-trace)) + (when multi-root + (->> workspace-folders + (-distinct) + (-map (lambda (folder) + (list :uri (lsp--path-to-uri folder) + :name (f-filename folder)))) + (apply 'vector) + (list :workspaceFolders)))) + (-lambda ((&InitializeResult :capabilities)) + ;; we know that Rust Analyzer will send {} which will be parsed as null + ;; when using plists + (when (equal 'rust-analyzer server-id) + (-> capabilities + (lsp:server-capabilities-text-document-sync?) + (lsp:set-text-document-sync-options-save? t))) + + (setf (lsp--workspace-server-capabilities workspace) capabilities + (lsp--workspace-status workspace) 'initialized) + + (with-lsp-workspace workspace + (lsp-notify "initialized" lsp--empty-ht)) + + (when initialized-fn (funcall initialized-fn workspace)) + + (cl-callf2 -filter #'lsp-buffer-live-p (lsp--workspace-buffers workspace)) + (->> workspace + (lsp--workspace-buffers) + (mapc (lambda (buffer) + (lsp-with-current-buffer buffer + (lsp--open-in-workspace workspace))))) + + (with-lsp-workspace workspace + (run-hooks 'lsp-after-initialize-hook)) + (lsp--info "%s initialized successfully in folders: %s" + (lsp--workspace-print workspace) + (lsp-workspace-folders workspace))) + :mode 'detached)) + workspace)) + +(defun lsp--load-default-session () + "Load default session." + (setq lsp--session (or (condition-case err + (lsp--read-from-file lsp-session-file) + (error (lsp--error "Failed to parse the session %s, starting with clean one." + (error-message-string err)) + nil)) + (make-lsp-session)))) + +(defun lsp-session () + "Get the session associated with the current buffer." + (or lsp--session (setq lsp--session (lsp--load-default-session)))) + +(defun lsp--client-disabled-p (buffer-major-mode client) + (seq-some + (lambda (entry) + (pcase entry + ((pred symbolp) (eq entry client)) + (`(,mode . ,client-or-list) + (and (eq mode buffer-major-mode) + (if (listp client-or-list) + (memq client client-or-list) + (eq client client-or-list)))))) + lsp-disabled-clients)) + + +;; download server + +(defcustom lsp-server-install-dir (expand-file-name + (locate-user-emacs-file (f-join ".cache" "lsp"))) + "Directory in which the servers will be installed." + :risky t + :type 'directory + :package-version '(lsp-mode . "6.3") + :group 'lsp-mode) + +(defcustom lsp-verify-signature t + "Whether to check GPG signatures of downloaded files." + :type 'boolean + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-mode) + +(defvar lsp--dependencies (ht)) + +(defun lsp-dependency (name &rest definitions) + "Used to specify a language server DEPENDENCY, the server +executable or other required file path. Typically, the +DEPENDENCY is found by locating it on the system path using +`executable-find'. + +You can explicitly call lsp-dependency in your environment to +specify the absolute path to the DEPENDENCY. For example, the +typescript-language-server requires both the server and the +typescript compiler. If you have installed them in a team shared +read-only location, you can instruct lsp-mode to use them via + + (eval-after-load `lsp-mode + `(progn + (require lsp-javascript) + (lsp-dependency typescript-language-server (:system ,tls-exe)) + (lsp-dependency typescript (:system ,ts-js)))) + +where tls-exe is the absolute path to the typescript-language-server +executable and ts-js is the absolute path to the typescript compiler +JavaScript file, tsserver.js (the *.js is required for Windows)." + (ht-set lsp--dependencies name definitions)) + +(defun lsp--server-binary-present? (client) + (unless (equal (lsp--client-server-id client) 'lsp-pwsh) + (condition-case () + (-some-> client lsp--client-new-connection (plist-get :test?) funcall) + (error nil) + (args-out-of-range nil)))) + +(define-minor-mode lsp-installation-buffer-mode + "Mode used in *lsp-installation* buffers. +It can be used to set-up keybindings, etc. Disabling this mode +detaches the installation buffer from commands like +`lsp-select-installation-buffer'." + :init-value nil + :lighter nil) + +(defface lsp-installation-finished-buffer-face '((t :foreground "orange")) + "Face used for finished installation buffers. +Used in `lsp-select-installation-buffer'." + :group 'lsp-mode) + +(defface lsp-installation-buffer-face '((t :foreground "green")) + "Face used for installation buffers still in progress. +Used in `lsp-select-installation-buffer'." + :group 'lsp-mode) + +(defun lsp--installation-buffer? (buf) + "Check whether BUF is an `lsp-async-start-process' buffer." + (buffer-local-value 'lsp-installation-buffer-mode buf)) + +(defun lsp-select-installation-buffer (&optional show-finished) + "Interactively choose an installation buffer. +If SHOW-FINISHED is set, leftover (finished) installation buffers +are still shown." + (interactive "P") + (let ((bufs (--filter (and (lsp--installation-buffer? it) + (or show-finished (get-buffer-process it))) + (buffer-list)))) + (pcase bufs + (`nil (user-error "No installation buffers")) + (`(,buf) (pop-to-buffer buf)) + (bufs (pop-to-buffer (completing-read "Select installation buffer: " + (--map (propertize (buffer-name it) 'face + (if (get-buffer-process it) + 'lsp-installation-buffer-face + 'lsp-installation-finished-buffer-face)) + bufs))))))) + +(defun lsp-cleanup-installation-buffers () + "Delete finished *lsp-installation* buffers." + (interactive) + (dolist (buf (buffer-list)) + (when (and (lsp--installation-buffer? buf) (not (get-buffer-process buf))) + (kill-buffer buf)))) + +(defun lsp--download-status () + (-some--> #'lsp--client-download-in-progress? + (lsp--filter-clients it) + (-map (-compose #'symbol-name #'lsp--client-server-id) it) + (format "%s" it) + (propertize it 'face 'success) + (format " Installing following servers: %s" it) + (propertize it + 'local-map (make-mode-line-mouse-map + 'mouse-1 #'lsp-select-installation-buffer) + 'mouse-face 'highlight))) + +(defun lsp--install-server-internal (client &optional update?) + (unless (lsp--client-download-server-fn client) + (user-error "There is no automatic installation for `%s', you have to install it manually following lsp-mode's documentation." + (lsp--client-server-id client))) + + (setf (lsp--client-download-in-progress? client) t) + (add-to-list 'global-mode-string '(t (:eval (lsp--download-status)))) + (cl-flet ((done + (success? &optional error-message) + ;; run with idle timer to make sure the lsp command is executed in + ;; the main thread, see #2739. + (run-with-timer + 0.0 + nil + (lambda () + (-let [(&lsp-cln 'server-id 'buffers) client] + (setf (lsp--client-download-in-progress? client) nil + (lsp--client-buffers client) nil) + (if success? + (lsp--info "Server %s downloaded, auto-starting in %s buffers." server-id + (length buffers)) + (lsp--error "Server %s install process failed with the following error message: %s. +Check `*lsp-install*' and `*lsp-log*' buffer." + server-id + error-message)) + (seq-do + (lambda (buffer) + (when (lsp-buffer-live-p buffer) + (lsp-with-current-buffer buffer + (cl-callf2 -remove-item '(t (:eval (lsp--download-status))) + global-mode-string) + (when success? (lsp))))) + buffers) + (unless (lsp--filter-clients #'lsp--client-download-in-progress?) + (cl-callf2 -remove-item '(t (:eval (lsp--download-status))) + global-mode-string))))))) + (lsp--info "Download %s started." (lsp--client-server-id client)) + (condition-case err + (funcall + (lsp--client-download-server-fn client) + client + (lambda () (done t)) + (lambda (msg) (done nil msg)) + update?) + (error + (done nil (error-message-string err)))))) + +(defun lsp--require-packages () + "Load `lsp-client-packages' if needed." + (when (and lsp-auto-configure (not lsp--client-packages-required)) + (seq-do (lambda (package) + ;; loading client is slow and `lsp' can be called repeatedly + (unless (featurep package) + (require package nil t))) + lsp-client-packages) + (setq lsp--client-packages-required t))) + +;;;###autoload +(defun lsp-install-server (update? &optional server-id) + "Interactively install or re-install server. +When prefix UPDATE? is t force installation even if the server is present." + (interactive "P") + (lsp--require-packages) + (let* ((chosen-client (or (gethash server-id lsp-clients) + (lsp--completing-read + "Select server to install/re-install: " + (or (->> lsp-clients + (ht-values) + (-filter (-andfn + (-not #'lsp--client-download-in-progress?) + #'lsp--client-download-server-fn))) + (user-error "There are no servers with automatic installation")) + (lambda (client) + (let ((server-name (-> client lsp--client-server-id symbol-name))) + (if (lsp--server-binary-present? client) + (concat server-name " (Already installed)") + server-name))) + nil + t))) + (update? (or update? + (and (not (lsp--client-download-in-progress? chosen-client)) + (lsp--server-binary-present? chosen-client))))) + (lsp--install-server-internal chosen-client update?))) + +;;;###autoload +(defun lsp-uninstall-server (dir) + "Delete a LSP server from `lsp-server-install-dir'." + (interactive + (list (read-directory-name "Uninstall LSP server: " (f-slash lsp-server-install-dir)))) + (unless (file-directory-p dir) + (user-error "Couldn't find %s directory" dir)) + (delete-directory dir 'recursive) + (message "Server `%s' uninstalled." (file-name-nondirectory (directory-file-name dir)))) + +;;;###autoload +(defun lsp-uninstall-servers () + "Uninstall all installed servers." + (interactive) + (let* ((dir lsp-server-install-dir) + (servers (ignore-errors + (directory-files dir t + directory-files-no-dot-files-regexp)))) + (if (or (not (file-directory-p dir)) (zerop (length servers))) + (user-error "No servers to uninstall") + (when (yes-or-no-p + (format "Servers to uninstall: %d (%s), proceed? " + (length servers) + (mapconcat (lambda (server) + (file-name-nondirectory (directory-file-name server))) + servers " "))) + (mapc #'lsp-uninstall-server servers) + (message "All servers uninstalled"))))) + +;;;###autoload +(defun lsp-update-server (&optional server-id) + "Interactively update (reinstall) a server." + (interactive) + (lsp--require-packages) + (let ((chosen-client (or (gethash server-id lsp-clients) + (lsp--completing-read + "Select server to update (if not on the list, probably you need to `lsp-install-server`): " + (or (->> lsp-clients + (ht-values) + (-filter (-andfn + (-not #'lsp--client-download-in-progress?) + #'lsp--client-download-server-fn + #'lsp--server-binary-present?))) + (user-error "There are no servers to update")) + (lambda (client) + (-> client lsp--client-server-id symbol-name)) + nil + t)))) + (lsp--install-server-internal chosen-client t))) + +;;;###autoload +(defun lsp-update-servers () + "Update (reinstall) all installed servers." + (interactive) + (lsp--require-packages) + (mapc (lambda (client) (lsp--install-server-internal client t)) + (-filter (-andfn + (-not #'lsp--client-download-in-progress?) + #'lsp--client-download-server-fn + #'lsp--server-binary-present?) (hash-table-values lsp-clients)))) + +;;;###autoload +(defun lsp-ensure-server (server-id) + "Ensure server SERVER-ID" + (lsp--require-packages) + (if-let* ((client (gethash server-id lsp-clients))) + (unless (lsp--server-binary-present? client) + (lsp--info "Server `%s' is not preset, installing..." server-id) + (lsp-install-server nil server-id)) + (warn "Unable to find server registration with id %s" server-id))) + +(defun lsp-async-start-process (callback error-callback &rest command) + "Start async process COMMAND with CALLBACK and ERROR-CALLBACK." + (let ((name (cl-first command))) + (with-current-buffer (compilation-start (mapconcat #'shell-quote-argument (-filter (lambda (cmd) + (not (null cmd))) + command) + " ") t + (lambda (&rest _) + (generate-new-buffer-name (format "*lsp-install: %s*" name)))) + (lsp-installation-buffer-mode +1) + (view-mode +1) + (add-hook + 'compilation-finish-functions + (lambda (_buf status) + (if (string= "finished\n" status) + (condition-case err + (funcall callback) + (error + (funcall error-callback (error-message-string err)))) + (funcall error-callback (s-trim-right status)))) + nil t)))) + +(defun lsp-resolve-value (value) + "Resolve VALUE's value. +If it is function - call it. +If it is a variable - return it's value +Otherwise returns value itself." + (cond + ((functionp value) (funcall value)) + ((and (symbolp value) (boundp value)) (symbol-value value)) + (value))) + +(defvar lsp-deps-providers + (list :npm (list :path #'lsp--npm-dependency-path + :install #'lsp--npm-dependency-install) + :cargo (list :path #'lsp--cargo-dependency-path + :install #'lsp--cargo-dependency-install) + :system (list :path #'lsp--system-path) + :download (list :path #'lsp-download-path + :install #'lsp-download-install))) + +(defun lsp--system-path (path) + "If PATH is absolute and exists return it as is. Otherwise, +return the absolute path to the executable defined by PATH or +nil." + ;; For node.js 'sub-packages' PATH may point to a *.js file. Consider the + ;; typescript-language-server. When lsp invokes the server, lsp needs to + ;; supply the path to the typescript compiler, tsserver.js, as an argument. To + ;; make code platform independent, one must pass the absolute path to the + ;; tsserver.js file (Windows requires a *.js file - see help on the JavaScript + ;; child process spawn command that is invoked by the + ;; typescript-language-server). This is why we check for existence and not + ;; that the path is executable. + (let ((path (lsp-resolve-value path))) + (cond + ((and (f-absolute? path) + (f-exists? path)) + path) + ((executable-find path t) path)))) + +(defun lsp-package-path (dependency) + "Path to the DEPENDENCY each of the registered providers." + (let (path) + (--first (-let [(provider . rest) it] + (setq path (-some-> lsp-deps-providers + (plist-get provider) + (plist-get :path) + (apply rest)))) + (gethash dependency lsp--dependencies)) + path)) + +(defun lsp-package-ensure (dependency callback error-callback) + "Asynchronously ensure a package." + (or (-first (-lambda ((provider . rest)) + (-some-> lsp-deps-providers + (plist-get provider) + (plist-get :install) + (apply (cl-list* callback error-callback rest)))) + (gethash dependency lsp--dependencies)) + (funcall error-callback (format "Unable to find a way to install %s" dependency)))) + + +;; npm handling + +;; https://docs.npmjs.com/files/folders#executables +(cl-defun lsp--npm-dependency-path (&key package path &allow-other-keys) + "Return npm dependency PATH for PACKAGE." + (let ((path (executable-find + (f-join lsp-server-install-dir "npm" package + (cond ((eq system-type 'windows-nt) "") + (t "bin")) + path) + t))) + (unless (and path (f-exists? path)) + (error "The package %s is not installed. Unable to find %s" package path)) + path)) + +(cl-defun lsp--npm-dependency-install (callback error-callback &key package &allow-other-keys) + (if-let* ((npm-binary (executable-find "npm"))) + (progn + ;; Explicitly `make-directory' to work around NPM bug in + ;; versions 7.0.0 through 7.4.1. See + ;; https://github.com/emacs-lsp/lsp-mode/issues/2364 for + ;; discussion. + (make-directory (f-join lsp-server-install-dir "npm" package "lib") 'parents) + (lsp-async-start-process (lambda () + (if (string-empty-p + (string-trim (shell-command-to-string + (mapconcat #'shell-quote-argument `(,npm-binary "view" ,package "peerDependencies") " ")))) + (funcall callback) + (let ((default-directory (f-dirname (car (last (directory-files-recursively (f-join lsp-server-install-dir "npm" package) "package.json"))))) + (process-environment (append '("npm_config_yes=true") process-environment))) ;; Disable prompting for older versions of npx + (when (f-dir-p default-directory) + (lsp-async-start-process callback + error-callback + (executable-find "npx") + "npm-install-peers"))))) + error-callback + npm-binary + "-g" + "--prefix" + (f-join lsp-server-install-dir "npm" package) + "install" + package)) + (lsp-log "Unable to install %s via `npm' because it is not present" package) + nil)) + + +;; Cargo dependency handling +(cl-defun lsp--cargo-dependency-path (&key package path &allow-other-keys) + (let ((path (executable-find + (f-join lsp-server-install-dir + "cargo" + package + "bin" + path) + t))) + (unless (and path (f-exists? path)) + (error "The package %s is not installed. Unable to find %s" package path)) + path)) + +(cl-defun lsp--cargo-dependency-install (callback error-callback &key package git &allow-other-keys) + (if-let* ((cargo-binary (executable-find "cargo"))) + (lsp-async-start-process + callback + error-callback + cargo-binary + "install" + package + (when git + "--git") + git + "--root" + (f-join lsp-server-install-dir "cargo" package)) + (lsp-log "Unable to install %s via `cargo' because it is not present" package) + nil)) + + + +;; Download URL handling +(cl-defun lsp-download-install (callback error-callback &key url asc-url pgp-key store-path decompress &allow-other-keys) + (let* ((url (lsp-resolve-value url)) + (store-path (lsp-resolve-value store-path)) + ;; (decompress (lsp-resolve-value decompress)) + (download-path + (pcase decompress + (:gzip (concat store-path ".gz")) + (:zip (concat store-path ".zip")) + (:targz (concat store-path ".tar.gz")) + (`nil store-path) + (_ (error ":decompress must be `:gzip', `:zip', `:targz' or `nil'"))))) + (make-thread + (lambda () + (condition-case err + (progn + (when (f-exists? download-path) + (f-delete download-path)) + (when (f-exists? store-path) + (f-delete store-path)) + (lsp--info "Starting to download %s to %s..." url download-path) + (mkdir (f-parent download-path) t) + (url-copy-file url download-path) + (lsp--info "Finished downloading %s..." download-path) + (when (and lsp-verify-signature asc-url pgp-key) + (if (executable-find epg-gpg-program) + (let ((asc-download-path (concat download-path ".asc")) + (context (epg-make-context)) + (fingerprint) + (signature)) + (when (f-exists? asc-download-path) + (f-delete asc-download-path)) + (lsp--info "Starting to download %s to %s..." asc-url asc-download-path) + (url-copy-file asc-url asc-download-path) + (lsp--info "Finished downloading %s..." asc-download-path) + (epg-import-keys-from-string context pgp-key) + (setq fingerprint (epg-import-status-fingerprint + (car + (epg-import-result-imports + (epg-context-result-for context 'import))))) + (lsp--info "Verifying signature %s..." asc-download-path) + (epg-verify-file context asc-download-path download-path) + (setq signature (car (epg-context-result-for context 'verify))) + (unless (and + (eq (epg-signature-status signature) 'good) + (equal (epg-signature-fingerprint signature) fingerprint)) + (error "Failed to verify GPG signature: %s" (epg-signature-to-string signature)))) + (lsp--warn "GPG is not installed, skipping the signature check."))) + (when decompress + (lsp--info "Decompressing %s..." download-path) + (pcase decompress + (:gzip + (lsp-gunzip download-path)) + (:zip (lsp-unzip download-path (f-parent store-path))) + (:targz (lsp-tar-gz-decompress download-path (f-parent store-path)))) + (lsp--info "Decompressed %s..." store-path)) + (funcall callback)) + (error (funcall error-callback err))))))) + +(cl-defun lsp-download-path (&key store-path binary-path set-executable? &allow-other-keys) + "Download URL and store it into STORE-PATH. + +SET-EXECUTABLE? when non-nil change the executable flags of +STORE-PATH to make it executable. BINARY-PATH can be specified +when the binary to start does not match the name of the +archive (e.g. when the archive has multiple files)" + (let ((store-path (or (lsp-resolve-value binary-path) + (lsp-resolve-value store-path)))) + (cond + ((executable-find store-path) store-path) + ((and set-executable? (f-exists? store-path)) + (set-file-modes store-path #o0700) + store-path) + ((f-exists? store-path) store-path)))) + +(defun lsp--find-latest-gh-release-url (url regex) + "Fetch the latest version in the releases given by URL by using REGEX." + (let ((url-request-method "GET")) + (with-current-buffer (url-retrieve-synchronously url) + (goto-char (point-min)) + (re-search-forward "\n\n" nil 'noerror) + (delete-region (point-min) (point)) + (let* ((json-result (lsp-json-read-buffer))) + (message "Latest version found: %s" (lsp-get json-result :tag_name)) + (--> json-result + (lsp-get it :assets) + (seq-find (lambda (entry) (string-match-p regex (lsp-get entry :name))) it) + (lsp-get it :browser_download_url)))))) + +;; unzip + +(defconst lsp-ext-pwsh-script "pwsh -noprofile -noninteractive \ +-nologo -ex bypass -c Expand-Archive -Path '%s' -DestinationPath '%s'" + "Pwsh script to unzip file.") + +(defconst lsp-ext-powershell-script "powershell -noprofile -noninteractive \ +-nologo -ex bypass -command Expand-Archive -path '%s' -dest '%s'" + "Powershell script to unzip file.") + +(defconst lsp-ext-unzip-script "bash -c 'mkdir -p %2$s && unzip -qq -o %1$s -d %2$s'" + "Unzip script to unzip file.") + +(defcustom lsp-unzip-script (lambda () + (cond ((and (eq system-type 'windows-nt) + (executable-find "pwsh")) + lsp-ext-pwsh-script) + ((and (eq system-type 'windows-nt) + (executable-find "powershell")) + lsp-ext-powershell-script) + ((executable-find "unzip") lsp-ext-unzip-script) + ((executable-find "pwsh") lsp-ext-pwsh-script) + (t nil))) + "The script to unzip." + :group 'lsp-mode + :type 'string + :package-version '(lsp-mode . "8.0.0")) + +(defun lsp-unzip (zip-file dest) + "Unzip ZIP-FILE to DEST." + (unless lsp-unzip-script + (error "Unable to find `unzip' or `powershell' on the path, please customize `lsp-unzip-script'")) + (shell-command (format (lsp-resolve-value lsp-unzip-script) zip-file dest))) + +;; gunzip + +(defconst lsp-ext-gunzip-script "gzip -d %1$s" + "Script to decompress a gzippped file with gzip.") + +(defcustom lsp-gunzip-script (lambda () + (cond ((executable-find "gzip") lsp-ext-gunzip-script) + (t nil))) + "The script to decompress a gzipped file. +Should be a format string with one argument for the file to be decompressed +in place." + :group 'lsp-mode + :type 'string + :package-version '(lsp-mode . "8.0.0")) + +(defun lsp-gunzip (gz-file) + "Decompress GZ-FILE in place." + (unless lsp-gunzip-script + (error "Unable to find `gzip' on the path, please either customize `lsp-gunzip-script' or manually decompress %s" gz-file)) + (shell-command (format (lsp-resolve-value lsp-gunzip-script) gz-file))) + +;; tar.gz decompression + +(defconst lsp-ext-tar-script "bash -c 'mkdir -p %2$s; tar xf %1$s --directory=%2$s'" + "Script to decompress a .tar.gz file.") + +(defcustom lsp-tar-script (lambda () + (cond ((executable-find "tar") lsp-ext-tar-script) + (t nil))) + "The script to decompress a .tar.gz file. +Should be a format string with one argument for the file to be decompressed +in place." + :group 'lsp-mode + :type 'string) + +(defun lsp-tar-gz-decompress (targz-file dest) + "Decompress TARGZ-FILE in DEST." + (unless lsp-tar-script + (error "Unable to find `tar' on the path, please either customize `lsp-tar-script' or manually decompress %s" targz-file)) + (shell-command (format (lsp-resolve-value lsp-tar-script) targz-file dest))) + + +;; VSCode marketplace + +(defcustom lsp-vscode-ext-url + "https://marketplace.visualstudio.com/_apis/public/gallery/publishers/%s/vsextensions/%s/%s/vspackage%s" + "Vscode extension template url." + :group 'lsp-mode + :type 'string + :package-version '(lsp-mode . "8.0.0")) + +(defun lsp-vscode-extension-url (publisher name version &optional targetPlatform) + "Return the URL to vscode extension. +PUBLISHER is the extension publisher. +NAME is the name of the extension. +VERSION is the version of the extension. +TARGETPLATFORM is the targetPlatform of the extension." + (format lsp-vscode-ext-url publisher name version (or targetPlatform ""))) + + + +;; Queueing prompts + +(defvar lsp--question-queue nil + "List of questions yet to be asked by `lsp-ask-question'.") + +(defun lsp-ask-question (question options callback) + "Prompt the user to answer the QUESTION with one of the OPTIONS from the +minibuffer. Once the user selects an option, the CALLBACK function will be +called, passing the selected option to it. + +If the user is currently being shown a question, the question will be stored in +`lsp--question-queue', and will be asked once the user has answered the current +question." + (add-to-list 'lsp--question-queue `(("question" . ,question) + ("options" . ,options) + ("callback" . ,callback)) t) + (when (eq (length lsp--question-queue) 1) + (lsp--process-question-queue))) + +(defun lsp--process-question-queue () + "Take the first question from `lsp--question-queue', process it, then process +the next question until the queue is empty." + (-let* (((&alist "question" "options" "callback") (car lsp--question-queue)) + (answer (completing-read question options nil t))) + (pop lsp--question-queue) + (funcall callback answer) + (when lsp--question-queue + (lsp--process-question-queue)))) + +(defun lsp--supports-buffer? (client) + (and + ;; both file and client remote or both local + (eq (---truthy? (file-remote-p (buffer-file-name))) + (---truthy? (lsp--client-remote? client))) + + ;; activation function or major-mode match. + (if-let* ((activation-fn (lsp--client-activation-fn client))) + (funcall activation-fn (buffer-file-name) major-mode) + (-contains? (lsp--client-major-modes client) major-mode)) + + ;; check whether it is enabled if `lsp-enabled-clients' is not null + (or (null lsp-enabled-clients) + (or (member (lsp--client-server-id client) lsp-enabled-clients) + (ignore (lsp--info "Client %s is not in lsp-enabled-clients" + (lsp--client-server-id client))))) + + ;; check whether it is not disabled. + (not (lsp--client-disabled-p major-mode (lsp--client-server-id client))))) + +(defun lsp--filter-clients (pred) + (->> lsp-clients hash-table-values (-filter pred))) + +(defun lsp--find-clients () + "Find clients which can handle current buffer." + (-when-let (matching-clients (lsp--filter-clients (-andfn #'lsp--supports-buffer? + #'lsp--server-binary-present?))) + (lsp-log "Found the following clients for %s: %s" + (buffer-file-name) + (s-join ", " + (-map (lambda (client) + (format "(server-id %s, priority %s)" + (lsp--client-server-id client) + (lsp--client-priority client))) + matching-clients))) + (-let* (((add-on-clients main-clients) (-separate #'lsp--client-add-on? matching-clients)) + (selected-clients (if-let* ((main-client (and main-clients + (--max-by (> (lsp--client-priority it) + (lsp--client-priority other)) + main-clients)))) + (cons main-client add-on-clients) + add-on-clients))) + (lsp-log "The following clients were selected based on priority: %s" + (s-join ", " + (-map (lambda (client) + (format "(server-id %s, priority %s)" + (lsp--client-server-id client) + (lsp--client-priority client))) + selected-clients))) + selected-clients))) + +(defun lsp-workspace-remove-all-folders() + "Delete all lsp tracked folders." + (interactive) + (--each (lsp-session-folders (lsp-session)) + (lsp-workspace-folders-remove it))) + +(defun lsp-register-client (client) + "Registers LSP client CLIENT." + (let ((client-id (lsp--client-server-id client))) + (puthash client-id client lsp-clients) + (setplist (intern (format "lsp-%s-after-open-hook" client-id)) + `( standard-value (nil) custom-type hook + custom-package-version (lsp-mode . "7.0.1") + variable-documentation ,(format "Hooks to run after `%s' server is run." client-id) + custom-requests nil))) + (when (and lsp-auto-register-remote-clients + (not (lsp--client-remote? client))) + (let ((remote-client (copy-lsp--client client))) + (setf (lsp--client-remote? remote-client) t + (lsp--client-server-id remote-client) (intern + (format "%s-tramp" + (lsp--client-server-id client))) + ;; disable automatic download + (lsp--client-download-server-fn remote-client) nil) + (lsp-register-client remote-client)))) + +(defun lsp--create-initialization-options (_session client) + "Create initialization-options from SESSION and CLIENT. +Add workspace folders depending on server being multiroot and +session workspace folder configuration for the server." + (let* ((initialization-options-or-fn (lsp--client-initialization-options client))) + (if (functionp initialization-options-or-fn) + (funcall initialization-options-or-fn) + initialization-options-or-fn))) + +(defvar lsp-client-settings (make-hash-table :test 'equal) + "For internal use, any external users please use + `lsp-register-custom-settings' function instead") + +(defun lsp-register-custom-settings (props) + "Register PROPS. +PROPS is list of triple (path value boolean?) where PATH is the path to the +property; VALUE can be a literal value, symbol to be evaluated, or either a +function or lambda function to be called without arguments; BOOLEAN? is an +optional flag that should be non-nil for boolean settings, when it is nil the +property will be ignored if the VALUE is nil. + +Example: `(lsp-register-custom-settings `((\"foo.bar.buzz.enabled\" t t)))' +\(note the double parentheses)" + (mapc + (-lambda ((path . rest)) + (puthash path rest lsp-client-settings)) + props)) + +(defun lsp-region-text (region) + "Get the text for REGION in current buffer." + (-let (((start . end) (lsp--range-to-region region))) + (buffer-substring-no-properties start end))) + +(defun lsp-ht-set (tbl paths value) + "Set nested hash table value. +TBL - a hash table, PATHS is the path to the nested VALUE." + (pcase paths + (`(,path) (ht-set! tbl path value)) + (`(,path . ,rst) (let ((nested-tbl (or (gethash path tbl) + (let ((temp-tbl (ht))) + (ht-set! tbl path temp-tbl) + temp-tbl)))) + (lsp-ht-set nested-tbl rst value))))) + +;; sections + +(defalias 'defcustom-lsp 'lsp-defcustom) + +(defmacro lsp-defcustom (symbol standard doc &rest args) + "Defines `lsp-mode' server property." + (declare (doc-string 3) (debug (name body)) + (indent defun)) + (let ((path (plist-get args :lsp-path)) + (setter (intern (concat (symbol-name symbol) "--set")))) + (cl-remf args :lsp-path) + `(progn + (lsp-register-custom-settings + (quote ((,path ,symbol ,(equal ''boolean (plist-get args :type)))))) + + (defcustom ,symbol ,standard ,doc ,@args) + + ;; Use a variable watcher instead of registering a `defcustom' + ;; setter since `hack-local-variables' is not aware of custom + ;; setters and won't invoke them. + + (defun ,setter (sym val op _where) + (when (eq op 'set) + (lsp--set-custom-property sym val ,path))) + + (add-variable-watcher ',symbol #',setter)))) + +(defun lsp--set-custom-property (sym val path) + (set sym val) + (let ((section (cl-first (s-split "\\." path)))) + (mapc (lambda (workspace) + (when (-contains? (lsp--client-synchronize-sections (lsp--workspace-client workspace)) + section) + (with-lsp-workspace workspace + (lsp--set-configuration (lsp-configuration-section section))))) + (lsp--session-workspaces (lsp-session))))) + +(defun lsp-configuration-section (section) + "Get settings for SECTION." + (let ((ret (ht-create))) + (maphash (-lambda (path (variable boolean?)) + (when (s-matches? (concat (regexp-quote section) "\\..*") path) + (let* ((symbol-value (-> variable + lsp-resolve-value + lsp-resolve-value)) + (value (if (and boolean? (not symbol-value)) + :json-false + symbol-value))) + (when (or boolean? value) + (lsp-ht-set ret (s-split "\\." path) value))))) + lsp-client-settings) + ret)) + + +(defun lsp--start-connection (session client project-root) + "Initiates connection created from CLIENT for PROJECT-ROOT. +SESSION is the active session." + (when (lsp--client-multi-root client) + (cl-pushnew project-root (gethash (lsp--client-server-id client) + (lsp-session-server-id->folders session)))) + (run-hook-with-args 'lsp-workspace-folders-changed-functions (list project-root) nil) + + (unwind-protect + (lsp--start-workspace session client project-root (lsp--create-initialization-options session client)) + (lsp--spinner-stop))) + +;; lsp-log-io-mode + +(defvar lsp-log-io-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "M-n") #'lsp-log-io-next) + (define-key map (kbd "M-p") #'lsp-log-io-prev) + (define-key map (kbd "k") #'lsp--erase-log-buffer) + (define-key map (kbd "K") #'lsp--erase-session-log-buffers) + map) + "Keymap for lsp log buffer mode.") + +(define-derived-mode lsp-log-io-mode special-mode "LspLogIo" + "Special mode for viewing IO logs.") + +(defun lsp-workspace-show-log (workspace) + "Display the log buffer of WORKSPACE." + (interactive + (list (if lsp-log-io + (if (eq (length (lsp-workspaces)) 1) + (cl-first (lsp-workspaces)) + (lsp--completing-read "Workspace: " (lsp-workspaces) + #'lsp--workspace-print nil t)) + (user-error "IO logging is disabled")))) + (pop-to-buffer (lsp--get-log-buffer-create workspace))) + +(defalias 'lsp-switch-to-io-log-buffer 'lsp-workspace-show-log) + +(defun lsp--get-log-buffer-create (workspace) + "Return the lsp log buffer of WORKSPACE, creating a new one if needed." + (let* ((server-id (-> workspace lsp--workspace-client lsp--client-server-id symbol-name)) + (pid (-> workspace lsp--workspace-cmd-proc lsp-process-id))) + (get-buffer-create (format "*lsp-log: %s:%s*" server-id pid)))) + +(defun lsp--erase-log-buffer (&optional all) + "Delete contents of current lsp log buffer. +When ALL is t, erase all log buffers of the running session." + (interactive) + (let* ((workspaces (lsp--session-workspaces (lsp-session))) + (current-log-buffer (current-buffer))) + (dolist (w workspaces) + (let ((b (lsp--get-log-buffer-create w))) + (when (or all (eq b current-log-buffer)) + (with-current-buffer b + (let ((inhibit-read-only t)) + (erase-buffer)))))))) + +(defun lsp--erase-session-log-buffers () + "Erase log buffers of the running session." + (interactive) + (lsp--erase-log-buffer t)) + +(defun lsp-log-io-next (arg) + "Move to next log entry." + (interactive "P") + (ewoc-goto-next lsp--log-io-ewoc (or arg 1))) + +(defun lsp-log-io-prev (arg) + "Move to previous log entry." + (interactive "P") + (ewoc-goto-prev lsp--log-io-ewoc (or arg 1))) + + + +(cl-defmethod lsp-process-id ((process process)) + (process-id process)) + +(cl-defmethod lsp-process-name ((process process)) (process-name process)) + +(cl-defmethod lsp-process-status ((process process)) (process-status process)) + +(cl-defmethod lsp-process-kill ((process process)) + (when (process-live-p process) + (kill-process process))) + +(cl-defmethod lsp-process-send ((process process) message) + (condition-case err + (process-send-string process (lsp--make-message message)) + (error (lsp--error "Sending to process failed with the following error: %s" + (error-message-string err))))) + +(cl-defmethod lsp-process-cleanup (process) + ;; Kill standard error buffer only if the process exited normally. + ;; Leave it intact otherwise for debugging purposes. + (let ((buffer (-> process process-name get-buffer))) + (when (and (eq (process-status process) 'exit) + (zerop (process-exit-status process)) + (buffer-live-p buffer)) + (kill-buffer buffer)))) + + +;; native JSONRPC + +(declare-function json-rpc "ext:json") +(declare-function json-rpc-connection "ext:json") +(declare-function json-rpc-send "ext:json") +(declare-function json-rpc-shutdown "ext:json") +(declare-function json-rpc-stderr "ext:json") +(declare-function json-rpc-pid "ext:json") + +(defvar lsp-json-rpc-thread nil) +(defvar lsp-json-rpc-queue nil) +(defvar lsp-json-rpc-done nil) +(defvar lsp-json-rpc-mutex (make-mutex)) +(defvar lsp-json-rpc-condition (make-condition-variable lsp-json-rpc-mutex)) + +(defun lsp-json-rpc-process-queue () + (while (not lsp-json-rpc-done) + (while lsp-json-rpc-queue + (-let (((proc . message) (pop lsp-json-rpc-queue))) + (json-rpc-send + proc message + :null-object nil + :false-object :json-false))) + (with-mutex lsp-json-rpc-mutex + (condition-wait lsp-json-rpc-condition)))) + +(cl-defmethod lsp-process-id (process) (json-rpc-pid process)) + +(cl-defmethod lsp-process-name (_process) "TBD") + +(cl-defmethod lsp-process-kill (process) (json-rpc-shutdown process)) + +(cl-defmethod lsp-process-send (proc message) + (unless lsp-json-rpc-thread + (with-current-buffer (get-buffer-create " *json-rpc*") + (setq lsp-json-rpc-thread (make-thread #'lsp-json-rpc-process-queue "*json-rpc-queue*")))) + + (with-mutex lsp-json-rpc-mutex + (setq lsp-json-rpc-queue (append lsp-json-rpc-queue + (list (cons proc message)))) + (condition-notify lsp-json-rpc-condition))) + +(cl-defmethod lsp-process-cleanup (_proc)) + +(defun lsp-json-rpc-connection (workspace command) + (let ((con (apply #'json-rpc-connection command)) + (object-type (if lsp-use-plists 'plist 'hash-table))) + (with-current-buffer (get-buffer-create " *json-rpc*") + (make-thread + (lambda () + (json-rpc + con + (lambda (result err done) + (run-with-timer + 0.0 + nil + (lambda () + (cond + (result (lsp--parser-on-message result workspace)) + (err (warn "Json parsing failed with the following error: %s" err)) + (done (lsp--handle-process-exit workspace "")))))) + :object-type object-type + :null-object nil + :false-object nil)) + "*json-rpc-connection*")) + (cons con con))) + +(defun lsp-json-rpc-stderr () + (interactive) + (--when-let (pcase (lsp-workspaces) + (`nil (user-error "There are no active servers in the current buffer")) + (`(,workspace) workspace) + (workspaces (lsp--completing-read "Select server: " + workspaces + 'lsp--workspace-print nil t))) + (let ((content (json-rpc-stderr (lsp--workspace-cmd-proc it))) + (buffer (format "*stderr-%s*" (lsp--workspace-print it)) )) + (with-current-buffer (get-buffer-create buffer) + (with-help-window buffer + (insert content)))))) + + +(defun lsp--workspace-print (workspace) + "Visual representation WORKSPACE." + (let* ((proc (lsp--workspace-cmd-proc workspace)) + (status (lsp--workspace-status workspace)) + (server-id (-> workspace lsp--workspace-client lsp--client-server-id symbol-name)) + (pid (lsp-process-id proc))) + + (if (eq 'initialized status) + (format "%s:%s" server-id pid) + (format "%s:%s/%s" server-id pid status)))) + +(defun lsp--map-tree-widget (m) + "Build `tree-widget' from a hash-table or plist M." + (when (lsp-structure-p m) + (let (nodes) + (lsp-map (lambda (k v) + (push `(tree-widget + :tag ,(if (lsp-structure-p v) + (format "%s:" k) + (format "%s: %s" k + (propertize (format "%s" v) + 'face + 'font-lock-string-face))) + :open t + ,@(lsp--map-tree-widget v)) + nodes)) + m) + nodes))) + +(defun lsp-buffer-name (buffer-id) + (if-let* ((buffer-name (plist-get buffer-id :buffer-name))) + (funcall buffer-name buffer-id) + (buffer-name buffer-id))) + +(defun lsp--render-workspace (workspace) + "Tree node representation of WORKSPACE." + `(tree-widget :tag ,(lsp--workspace-print workspace) + :open t + (tree-widget :tag ,(propertize "Buffers" 'face 'font-lock-function-name-face) + :open t + ,@(->> workspace + (lsp--workspace-buffers) + (--map `(tree-widget + :tag ,(when (lsp-buffer-live-p it) + (let ((buffer-name (lsp-buffer-name it))) + (if (lsp-with-current-buffer it buffer-read-only) + (propertize buffer-name 'face 'font-lock-constant-face) + buffer-name))))))) + (tree-widget :tag ,(propertize "Capabilities" 'face 'font-lock-function-name-face) + ,@(-> workspace lsp--workspace-server-capabilities lsp--map-tree-widget)))) + +(define-derived-mode lsp-browser-mode special-mode "LspBrowser" + "Define mode for displaying lsp sessions." + (setq-local display-buffer-base-action '(nil . ((inhibit-same-window . t))))) + +(defun lsp-describe-session () + "Describes current `lsp-session'." + (interactive) + (let ((session (lsp-session)) + (buf (get-buffer-create "*lsp session*")) + (root (lsp-workspace-root))) + (with-current-buffer buf + (lsp-browser-mode) + (let ((inhibit-read-only t)) + (erase-buffer) + (--each (lsp-session-folders session) + (widget-create + `(tree-widget + :tag ,(propertize it 'face 'font-lock-keyword-face) + :open t + ,@(->> session + (lsp-session-folder->servers) + (gethash it) + (-map 'lsp--render-workspace))))))) + (pop-to-buffer buf) + (goto-char (point-min)) + (cl-loop for tag = (widget-get (widget-get (widget-at) :node) :tag) + until (or (and root (string= tag root)) (eobp)) + do (goto-char (next-overlay-change (point)))))) + +(defun lsp--session-workspaces (session) + "Get all workspaces that are part of the SESSION." + (-> session lsp-session-folder->servers hash-table-values -flatten -uniq)) + +(defun lsp--find-multiroot-workspace (session client project-root) + "Look for a multiroot connection in SESSION created from CLIENT for +PROJECT-ROOT and BUFFER-MAJOR-MODE." + (when (lsp--client-multi-root client) + (-when-let (multi-root-workspace (->> session + (lsp--session-workspaces) + (--first (eq (-> it lsp--workspace-client lsp--client-server-id) + (lsp--client-server-id client))))) + (with-lsp-workspace multi-root-workspace + (lsp-notify "workspace/didChangeWorkspaceFolders" + (lsp-make-did-change-workspace-folders-params + :event (lsp-make-workspace-folders-change-event + :added (vector (lsp-make-workspace-folder + :uri (lsp--path-to-uri project-root) + :name (f-filename project-root))) + :removed [])))) + + (->> session (lsp-session-folder->servers) (gethash project-root) (cl-pushnew multi-root-workspace)) + (->> session (lsp-session-server-id->folders) (gethash (lsp--client-server-id client)) (cl-pushnew project-root)) + + (lsp--persist-session session) + + (lsp--info "Opened folder %s in workspace %s" project-root (lsp--workspace-print multi-root-workspace)) + (lsp--open-in-workspace multi-root-workspace) + + multi-root-workspace))) + +(defun lsp--ensure-lsp-servers (session clients project-root ignore-multi-folder) + "Ensure that SESSION contain server CLIENTS created for PROJECT-ROOT. +IGNORE-MULTI-FOLDER to ignore multi folder server." + (-map (lambda (client) + (or + (lsp--find-workspace session client project-root) + (unless ignore-multi-folder + (lsp--find-multiroot-workspace session client project-root)) + (lsp--start-connection session client project-root))) + clients)) + +(defun lsp--spinner-stop () + "Stop the spinner in case all of the workspaces are started." + (when (--all? (eq (lsp--workspace-status it) 'initialized) + lsp--buffer-workspaces) + (spinner-stop))) + +(defun lsp--open-in-workspace (workspace) + "Open in existing WORKSPACE." + (if (eq 'initialized (lsp--workspace-status workspace)) + ;; when workspace is initialized just call document did open. + (progn + (with-lsp-workspace workspace + (when-let* ((before-document-open-fn (-> workspace + lsp--workspace-client + lsp--client-before-file-open-fn))) + (funcall before-document-open-fn workspace)) + (lsp--text-document-did-open)) + (lsp--spinner-stop)) + ;; when it is not initialized + (lsp--spinner-start) + (cl-pushnew (lsp-current-buffer) (lsp--workspace-buffers workspace)))) + +(defun lsp--find-workspace (session client project-root) + "Find server connection created with CLIENT in SESSION for PROJECT-ROOT." + (when-let* ((workspace (->> session + (lsp-session-folder->servers) + (gethash project-root) + (--first (eql (-> it lsp--workspace-client lsp--client-server-id) + (lsp--client-server-id client)))))) + (lsp--open-in-workspace workspace) + workspace)) + +(defun lsp--read-char (prompt &optional options) + "Wrapper for `read-char-from-minibuffer' if Emacs +27. +Fallback to `read-key' otherwise. +PROMPT is the message and OPTIONS the available options." + (if (fboundp 'read-char-from-minibuffer) + (read-char-from-minibuffer prompt options) + (read-key prompt))) + +(defun lsp--find-root-interactively (session) + "Find project interactively. +Returns nil if the project should not be added to the current SESSION." + (condition-case nil + (let* ((project-root-suggestion (or (lsp--suggest-project-root) default-directory)) + (action (lsp--read-char + (format + "%s is not part of any project. + +%s ==> Import project root %s +%s ==> Import project by selecting root directory interactively +%s ==> Import project at current directory %s +%s ==> Do not ask again for the current project by adding %s to lsp-session-folders-blocklist +%s ==> Do not ask again for the current project by selecting ignore path interactively +%s ==> Do nothing: ask again when opening other files from the current project + +Select action: " + (propertize (buffer-name) 'face 'bold) + (propertize "i" 'face 'success) + (propertize project-root-suggestion 'face 'bold) + (propertize "I" 'face 'success) + (propertize "." 'face 'success) + (propertize default-directory 'face 'bold) + (propertize "d" 'face 'warning) + (propertize project-root-suggestion 'face 'bold) + (propertize "D" 'face 'warning) + (propertize "n" 'face 'warning)) + '(?i ?\r ?I ?. ?d ?D ?n)))) + (cl-case action + (?i project-root-suggestion) + (?\r project-root-suggestion) + (?I (read-directory-name "Select workspace folder to add: " + (or project-root-suggestion default-directory) + nil + t)) + (?. default-directory) + (?d (push project-root-suggestion (lsp-session-folders-blocklist session)) + (lsp--persist-session session) + nil) + (?D (push (read-directory-name "Select folder to blocklist: " + (or project-root-suggestion default-directory) + nil + t) + (lsp-session-folders-blocklist session)) + (lsp--persist-session session) + nil) + (t nil))) + (quit))) + +(declare-function tramp-file-name-host "ext:tramp" (file) t) +(declare-function tramp-dissect-file-name "ext:tramp" (file &optional nodefault)) + +(defun lsp--files-same-host (f1 f2) + "Predicate on whether or not two files are on the same host." + (or (not (or (file-remote-p f1) (file-remote-p f2))) + (and (file-remote-p f1) + (file-remote-p f2) + (progn (require 'tramp) + (equal (tramp-file-name-host (tramp-dissect-file-name f1)) + (tramp-file-name-host (tramp-dissect-file-name f2))))))) + +(defun lsp-find-session-folder (session file-name) + "Look in the current SESSION for folder containing FILE-NAME." + (let ((file-name-canonical (lsp-f-canonical file-name))) + (->> session + (lsp-session-folders) + (--filter (and (lsp--files-same-host it file-name-canonical) + (or (lsp-f-same? it file-name-canonical) + (and (f-dir? it) + (lsp-f-ancestor-of? it file-name-canonical))))) + (--max-by (> (length it) + (length other)))))) + +(defun lsp-find-workspace (server-id &optional file-name) + "Find workspace for SERVER-ID for FILE-NAME." + (-when-let* ((session (lsp-session)) + (folder->servers (lsp-session-folder->servers session)) + (workspaces (if file-name + (gethash (lsp-find-session-folder session file-name) folder->servers) + (lsp--session-workspaces session)))) + + (--first (eq (lsp--client-server-id (lsp--workspace-client it)) server-id) workspaces))) + +(defun lsp--calculate-root (session file-name) + "Calculate project root for FILE-NAME in SESSION." + (and + (->> session + (lsp-session-folders-blocklist) + (--first (and (lsp--files-same-host it file-name) + (lsp-f-ancestor-of? it file-name) + (prog1 t + (lsp--info "File %s is in blocklisted directory %s" file-name it)))) + not) + (or + (when lsp-auto-guess-root + (lsp--suggest-project-root)) + (unless lsp-guess-root-without-session + (lsp-find-session-folder session file-name)) + (unless lsp-auto-guess-root + (when-let* ((root-folder (lsp--find-root-interactively session))) + (if (or (not (f-equal? root-folder (expand-file-name "~/"))) + (yes-or-no-p + (concat + (propertize "[WARNING] " 'face 'warning) + "You are trying to import your home folder as project root. This may cause performance issue because some language servers (python, lua, etc) will try to scan all files under project root. To avoid that you may: + +1. Use `I' option from the interactive project import to select subfolder(e. g. `~/foo/bar' instead of `~/'). +2. If your file is under `~/' then create a subfolder and move that file in this folder. + +Type `No' to go back to project selection. +Type `Yes' to confirm `HOME' as project root. +Type `C-g' to cancel project import process and stop `lsp'"))) + root-folder + (lsp--calculate-root session file-name))))))) + +(defun lsp--try-open-in-library-workspace () + "Try opening current file as library file in any of the active workspace. +The library folders are defined by each client for each of the active workspace." + (when-let* ((workspace (->> (lsp-session) + (lsp--session-workspaces) + ;; Sort the last active workspaces first as they are more likely to be + ;; the correct ones, especially when jumping to a definition. + (-sort (lambda (a _b) + (-contains? lsp--last-active-workspaces a))) + (--first + (and (-> it lsp--workspace-client lsp--supports-buffer?) + (when-let* ((library-folders-fn + (-> it lsp--workspace-client lsp--client-library-folders-fn))) + (-first (lambda (library-folder) + (lsp-f-ancestor-of? library-folder (buffer-file-name))) + (funcall library-folders-fn it)))))))) + (lsp--open-in-workspace workspace) + (view-mode t) + (lsp--info "Opening read-only library file %s." (buffer-file-name)) + (list workspace))) + +(defun lsp--persist-session (session) + "Persist SESSION to `lsp-session-file'." + (lsp--persist lsp-session-file (make-lsp-session + :folders (lsp-session-folders session) + :folders-blocklist (lsp-session-folders-blocklist session) + :server-id->folders (lsp-session-server-id->folders session)))) + +(defun lsp--try-project-root-workspaces (ask-for-client ignore-multi-folder) + "Try create opening file as a project file. +When IGNORE-MULTI-FOLDER is t the lsp mode will start new +language server even if there is language server which can handle +current language. When IGNORE-MULTI-FOLDER is nil current file +will be opened in multi folder language server if there is +such." + (-let ((session (lsp-session))) + (-if-let (clients (if ask-for-client + (list (lsp--completing-read "Select server to start: " + (ht-values lsp-clients) + (-compose 'symbol-name 'lsp--client-server-id) nil t)) + (lsp--find-clients))) + (-if-let (project-root (-some-> session + (lsp--calculate-root (buffer-file-name)) + (lsp-f-canonical))) + (progn + ;; update project roots if needed and persist the lsp session + (unless (-contains? (lsp-session-folders session) project-root) + (cl-pushnew project-root (lsp-session-folders session)) + (lsp--persist-session session)) + (lsp--ensure-lsp-servers session clients project-root ignore-multi-folder)) + (lsp--warn "%s not in project or it is blocklisted." (buffer-name)) + nil) + (lsp--warn "No LSP server for %s(check *lsp-log*)." major-mode) + nil))) + +(defun lsp-shutdown-workspace () + "Shutdown language server." + (interactive) + (--when-let (pcase (lsp-workspaces) + (`nil (user-error "There are no active servers in the current buffer")) + (`(,workspace) (when (y-or-n-p (format "Are you sure you want to stop the server %s?" + (lsp--workspace-print workspace))) + workspace)) + (workspaces (lsp--completing-read "Select server: " + workspaces + 'lsp--workspace-print nil t))) + (lsp-workspace-shutdown it))) + +(make-obsolete 'lsp-shutdown-workspace 'lsp-workspace-shutdown "lsp-mode 6.1") + +(defcustom lsp-auto-select-workspace t + "Shutdown or restart a single workspace. +If set and the current buffer has only a single workspace +associated with it, `lsp-shutdown-workspace' and +`lsp-restart-workspace' will act on it without asking." + :type 'boolean + :group 'lsp-mode) + +(defun lsp--read-workspace () + "Ask the user to select a workspace. +Errors if there are none." + (pcase (lsp-workspaces) + (`nil (error "No workspaces associated with the current buffer")) + ((and `(,workspace) (guard lsp-auto-select-workspace)) workspace) + (workspaces (lsp--completing-read "Select workspace: " workspaces + #'lsp--workspace-print nil t)))) + +(defun lsp-workspace-shutdown (workspace) + "Shut the workspace WORKSPACE and the language server associated with it" + (interactive (list (lsp--read-workspace))) + (lsp--warn "Stopping %s" (lsp--workspace-print workspace)) + (with-lsp-workspace workspace (lsp--shutdown-workspace))) + +(defun lsp-disconnect () + "Disconnect the buffer from the language server." + (interactive) + (lsp--text-document-did-close t) + (lsp-managed-mode -1) + (lsp-mode -1) + (setq lsp--buffer-workspaces nil) + (lsp--info "Disconnected")) + +(defun lsp-restart-workspace () + (interactive) + (--when-let (pcase (lsp-workspaces) + (`nil (user-error "There are no active servers in the current buffer")) + (`(,workspace) workspace) + (workspaces (lsp--completing-read "Select server: " + workspaces + 'lsp--workspace-print nil t))) + (lsp-workspace-restart it))) + +(make-obsolete 'lsp-restart-workspace 'lsp-workspace-restart "lsp-mode 6.1") + +(defun lsp-workspace-restart (workspace) + "Restart the workspace WORKSPACE and the language server associated with it" + (interactive (list (lsp--read-workspace))) + (lsp--warn "Restarting %s" (lsp--workspace-print workspace)) + (with-lsp-workspace workspace (lsp--shutdown-workspace t))) + +;;;###autoload +(defun lsp (&optional arg) + "Entry point for the server startup. +When ARG is t the lsp mode will start new language server even if +there is language server which can handle current language. When +ARG is nil current file will be opened in multi folder language +server if there is such. When `lsp' is called with prefix +argument ask the user to select which language server to start." + (interactive "P") + + (lsp--require-packages) + + (when (buffer-file-name) + (let (clients + (matching-clients (lsp--filter-clients + (-andfn #'lsp--supports-buffer? + #'lsp--server-binary-present?)))) + (cond + (matching-clients + (when (setq lsp--buffer-workspaces + (or (and + ;; Don't open as library file if file is part of a project. + (not (lsp-find-session-folder (lsp-session) (buffer-file-name))) + (lsp--try-open-in-library-workspace)) + (lsp--try-project-root-workspaces (equal arg '(4)) + (and arg (not (equal arg 1)))))) + (lsp-mode 1) + (when lsp-auto-configure (lsp--auto-configure)) + (setq lsp-buffer-uri (lsp--buffer-uri)) + (lsp--info "Connected to %s." + (apply 'concat (--map (format "[%s %s]" + (lsp--workspace-print it) + (lsp--workspace-root it)) + lsp--buffer-workspaces))))) + ;; look for servers which are currently being downloaded. + ((setq clients (lsp--filter-clients (-andfn #'lsp--supports-buffer? + #'lsp--client-download-in-progress?))) + (lsp--info "There are language server(%s) installation in progress. +The server(s) will be started in the buffer when it has finished." + (-map #'lsp--client-server-id clients)) + (seq-do (lambda (client) + (cl-pushnew (current-buffer) (lsp--client-buffers client))) + clients)) + ;; look for servers to install + ((setq clients (lsp--filter-clients + (-andfn #'lsp--supports-buffer? + (-const lsp-enable-suggest-server-download) + #'lsp--client-download-server-fn + (-not #'lsp--client-download-in-progress?)))) + (let ((client (lsp--completing-read + (concat "Unable to find installed server supporting this file. " + "The following servers could be installed automatically: ") + clients + (-compose #'symbol-name #'lsp--client-server-id) + nil + t))) + (cl-pushnew (current-buffer) (lsp--client-buffers client)) + (lsp--install-server-internal client))) + ;; ignore other warnings + ((not lsp-warn-no-matched-clients) + nil) + ;; automatic installation disabled + ((setq clients (unless matching-clients + (lsp--filter-clients (-andfn #'lsp--supports-buffer? + #'lsp--client-download-server-fn + (-not (-const lsp-enable-suggest-server-download)) + (-not #'lsp--server-binary-present?))))) + (lsp--warn "The following servers support current file but automatic download is disabled: %s +\(If you have already installed the server check *lsp-log*)." + (mapconcat (lambda (client) + (symbol-name (lsp--client-server-id client))) + clients + " "))) + ;; no clients present + ((setq clients (unless matching-clients + (lsp--filter-clients (-andfn #'lsp--supports-buffer? + (-not #'lsp--server-binary-present?))))) + (lsp--warn "The following servers support current file but do not have automatic installation: %s +You may find the installation instructions at https://emacs-lsp.github.io/lsp-mode/page/languages. +\(If you have already installed the server check *lsp-log*)." + (mapconcat (lambda (client) + (symbol-name (lsp--client-server-id client))) + clients + " "))) + ;; no matches + ((-> #'lsp--supports-buffer? lsp--filter-clients not) + (lsp--error "There are no language servers supporting current mode `%s' registered with `lsp-mode'. +This issue might be caused by: +1. The language you are trying to use does not have built-in support in `lsp-mode'. You must install the required support manually. Examples of this are `lsp-java' or `lsp-metals'. +2. The language server that you expect to run is not configured to run for major mode `%s'. You may check that by checking the `:major-modes' that are passed to `lsp-register-client'. +3. `lsp-mode' doesn't have any integration for the language behind `%s'. Refer to https://emacs-lsp.github.io/lsp-mode/page/languages and https://langserver.org/ . +4. You are over `tramp'. In this case follow https://emacs-lsp.github.io/lsp-mode/page/remote/. +5. You have disabled the `lsp-mode' clients for that file. (Check `lsp-enabled-clients' and `lsp-disabled-clients'). +You can customize `lsp-warn-no-matched-clients' to disable this message." + major-mode major-mode major-mode)))))) + +(defun lsp--buffer-visible-p () + "Return non nil if current buffer is visible." + (or (buffer-modified-p) (get-buffer-window nil t))) + +(defun lsp--init-if-visible () + "Run `lsp' for the current buffer if the buffer is visible. +Returns non nil if `lsp' was run for the buffer." + (when (lsp--buffer-visible-p) + (remove-hook 'window-configuration-change-hook #'lsp--init-if-visible t) + (lsp) + t)) + +;;;###autoload +(defun lsp-deferred () + "Entry point that defers server startup until buffer is visible. +`lsp-deferred' will wait until the buffer is visible before invoking `lsp'. +This avoids overloading the server with many files when starting Emacs." + ;; Workspace may not be initialized yet. Use a buffer local variable to + ;; remember that we deferred loading of this buffer. + (setq lsp--buffer-deferred t) + (let ((buffer (current-buffer))) + ;; Avoid false positives as desktop-mode restores buffers by deferring + ;; visibility check until the stack clears. + (run-with-idle-timer 0 nil (lambda () + (when (buffer-live-p buffer) + (with-current-buffer buffer + (unless (lsp--init-if-visible) + (add-hook 'window-configuration-change-hook #'lsp--init-if-visible nil t)))))))) + + + +(defvar lsp-file-truename-cache (ht)) + +(defmacro lsp-with-cached-filetrue-name (&rest body) + "Executes BODY caching the `file-truename' calls." + `(let ((old-fn (symbol-function 'file-truename))) + (unwind-protect + (progn + (fset 'file-truename + (lambda (file-name &optional counter prev-dirs) + (or (gethash file-name lsp-file-truename-cache) + (puthash file-name (apply old-fn (list file-name counter prev-dirs)) + lsp-file-truename-cache)))) + ,@body) + (fset 'file-truename old-fn)))) + + +(defun lsp-virtual-buffer-call (key &rest args) + (when lsp--virtual-buffer + (when-let* ((fn (plist-get lsp--virtual-buffer key))) + (apply fn args)))) + +(defun lsp-translate-column (column) + "Translate COLUMN taking into account virtual buffers." + (or (lsp-virtual-buffer-call :real->virtual-char column) + column)) + +(defun lsp-translate-line (line) + "Translate LINE taking into account virtual buffers." + (or (lsp-virtual-buffer-call :real->virtual-line line) + line)) + + +;; lsp internal validation. + +(defmacro lsp--doctor (&rest checks) + `(-let [buf (current-buffer)] + (with-current-buffer (get-buffer-create "*lsp-performance*") + (with-help-window (current-buffer) + ,@(-map (-lambda ((msg form)) + `(insert (format "%s: %s\n" ,msg + (let ((res (with-current-buffer buf + ,form))) + (cond + ((eq res :optional) (propertize "OPTIONAL" 'face 'warning)) + (res (propertize "OK" 'face 'success)) + (t (propertize "ERROR" 'face 'error))))))) + (-partition 2 checks)))))) + +(define-obsolete-function-alias 'lsp-diagnose + 'lsp-doctor "lsp-mode 8.0.0") + +(defun lsp-doctor () + "Validate performance settings." + (interactive) + (lsp--doctor + "Checking for Native JSON support" (functionp 'json-serialize) + "Check emacs supports `read-process-output-max'" (boundp 'read-process-output-max) + "Check `read-process-output-max' default has been changed from 4k" + (and (boundp 'read-process-output-max) + (> read-process-output-max 4096)) + "Byte compiled against Native JSON (recompile lsp-mode if failing when Native JSON available)" + (condition-case _err + (progn (lsp--make-message (list "a" "b")) + nil) + (error t)) + "`gc-cons-threshold' increased?" (> gc-cons-threshold 800000) + "Using `plist' for deserialized objects? (refer to https://emacs-lsp.github.io/lsp-mode/page/performance/#use-plists-for-deserialization)" (or lsp-use-plists :optional) + "Using emacs 28+ with native compilation?" + (or (and (fboundp 'native-comp-available-p) + (native-comp-available-p)) + :optional))) + +(declare-function package-version-join "ext:package") +(declare-function package-desc-version "ext:package") +(declare-function package--alist "ext:package") + +(defun lsp-version () + "Return string describing current version of `lsp-mode'." + (interactive) + (unless (featurep 'package) + (require 'package)) + (let ((ver (format "lsp-mode %s, Emacs %s, %s" + (package-version-join + (package-desc-version + (car (alist-get 'lsp-mode (package--alist))))) + emacs-version + system-type))) + (if (called-interactively-p 'interactive) + (lsp--info "%s" ver) + ver))) + + + +;; org-mode/virtual-buffer + +(declare-function org-babel-get-src-block-info "ext:ob-core") +(declare-function org-do-remove-indentation "ext:org-macs") +(declare-function org-src-get-lang-mode "ext:org-src") +(declare-function org-element-context "ext:org-element") + +(defun lsp--virtual-buffer-update-position () + (-if-let (virtual-buffer (-first (-lambda ((&plist :in-range)) + (funcall in-range)) + lsp--virtual-buffer-connections)) + (unless (equal virtual-buffer lsp--virtual-buffer) + (lsp-org)) + (when lsp-managed-mode + (lsp-managed-mode -1) + (lsp-mode -1) + (setq lsp--buffer-workspaces nil) + (setq lsp--virtual-buffer nil) + (setq lsp-buffer-uri nil) + + ;; force refresh of diagnostics + (run-hooks 'lsp-after-diagnostics-hook)))) + +(defun lsp-virtual-buffer-on-change (start end length) + "Adjust on change event to be executed against the proper language server." + (let ((max-point (max end + (or (plist-get lsp--before-change-vals :end) 0) + (+ start length)))) + (when-let* ((virtual-buffer (-first (lambda (vb) + (let ((lsp--virtual-buffer vb)) + (and (lsp-virtual-buffer-call :in-range start) + (lsp-virtual-buffer-call :in-range max-point)))) + lsp--virtual-buffer-connections))) + (lsp-with-current-buffer virtual-buffer + (lsp-on-change start end length + (lambda (&rest _) + (list :range (lsp--range (list :character 0 :line 0) + lsp--virtual-buffer-point-max) + :text (lsp--buffer-content)))))))) + +(defun lsp-virtual-buffer-before-change (start _end) + (when-let* ((virtual-buffer (-first (lambda (vb) + (lsp-with-current-buffer vb + (lsp-virtual-buffer-call :in-range start))) + lsp--virtual-buffer-connections))) + (lsp-with-current-buffer virtual-buffer + (setq lsp--virtual-buffer-point-max + (lsp--point-to-position (lsp-virtual-buffer-call :last-point)))))) + +(defun lsp-patch-on-change-event () + (remove-hook 'after-change-functions #'lsp-on-change t) + (add-hook 'after-change-functions #'lsp-virtual-buffer-on-change nil t) + (add-hook 'before-change-functions #'lsp-virtual-buffer-before-change nil t)) + +(defun lsp-kill-virtual-buffers () + (mapc #'lsp-virtual-buffer-disconnect lsp--virtual-buffer-connections)) + +(defun lsp--move-point-in-indentation (point indentation) + (save-excursion + (goto-char point) + (if (<= point (+ (line-beginning-position) indentation)) + (line-beginning-position) + point))) + +(declare-function flycheck-checker-supports-major-mode-p "ext:flycheck") +(declare-function flycheck-add-mode "ext:flycheck") +(declare-function lsp-diagnostics-lsp-checker-if-needed "lsp-diagnostics") + +(defalias 'lsp-client-download-server-fn 'lsp--client-download-server-fn) + +(defun lsp-flycheck-add-mode (mode) + "Register flycheck support for MODE." + (lsp-diagnostics-lsp-checker-if-needed) + (unless (flycheck-checker-supports-major-mode-p 'lsp mode) + (flycheck-add-mode 'lsp mode))) + +(defun lsp-progress-spinner-type () + "Retrieve the spinner type value, if value is not a symbol of `spinner-types +defaults to `progress-bar." + (or (car (assoc lsp-progress-spinner-type spinner-types)) 'progress-bar)) + +(defun lsp-org () + (interactive) + (-if-let ((virtual-buffer &as &plist :workspaces) (-first (-lambda ((&plist :in-range)) + (funcall in-range)) + lsp--virtual-buffer-connections)) + (unless (equal lsp--virtual-buffer virtual-buffer) + (setq lsp--buffer-workspaces workspaces) + (setq lsp--virtual-buffer virtual-buffer) + (setq lsp-buffer-uri nil) + (lsp-mode 1) + (lsp-managed-mode 1) + (lsp-patch-on-change-event)) + + (save-excursion + (-let* (virtual-buffer + (wcb (lambda (f) + (with-current-buffer (plist-get virtual-buffer :buffer) + (-let* (((&plist :major-mode :buffer-file-name + :goto-buffer :workspaces) virtual-buffer) + (lsp--virtual-buffer virtual-buffer) + (lsp--buffer-workspaces workspaces)) + (save-excursion + (funcall goto-buffer) + (funcall f)))))) + ((&plist :begin :end :post-blank :language) (cl-second (org-element-context))) + ((&alist :tangle file-name) (cl-third (org-babel-get-src-block-info 'light))) + + (file-name (if file-name + (f-expand file-name) + (user-error "You should specify file name in the src block header."))) + (begin-marker (progn + (goto-char begin) + (forward-line) + (set-marker (make-marker) (point)))) + (end-marker (progn + (goto-char end) + (forward-line (1- (- post-blank))) + (set-marker (make-marker) (1+ (point))))) + (buf (current-buffer)) + (src-block (buffer-substring-no-properties begin-marker + (1- end-marker))) + (indentation (with-temp-buffer + (insert src-block) + + (goto-char (point-min)) + (let ((indentation (current-indentation))) + (plist-put lsp--virtual-buffer :indentation indentation) + (org-do-remove-indentation) + (goto-char (point-min)) + (- indentation (current-indentation)))))) + (add-hook 'post-command-hook #'lsp--virtual-buffer-update-position nil t) + + (when (fboundp 'flycheck-add-mode) + (lsp-flycheck-add-mode 'org-mode)) + + (setq lsp--virtual-buffer + (list + :in-range (lambda (&optional point) + (<= begin-marker (or point (point)) (1- end-marker))) + :goto-buffer (lambda () (goto-char begin-marker)) + :buffer-string + (lambda () + (let ((src-block (buffer-substring-no-properties + begin-marker + (1- end-marker)))) + (with-temp-buffer + (insert src-block) + + (goto-char (point-min)) + (while (not (eobp)) + (delete-region (point) (if (> (+ (point) indentation) (line-end-position)) + (line-end-position) + (+ (point) indentation))) + (forward-line)) + (buffer-substring-no-properties (point-min) + (point-max))))) + :buffer buf + :begin begin-marker + :end end-marker + :indentation indentation + :last-point (lambda () (1- end-marker)) + :cur-position (lambda () + (lsp-save-restriction-and-excursion + (list :line (- (lsp--cur-line) + (lsp--cur-line begin-marker)) + :character (let ((character (- (point) + (line-beginning-position) + indentation))) + (if (< character 0) + 0 + character))))) + :line/character->point (-lambda (line character) + (-let [inhibit-field-text-motion t] + (+ indentation + (lsp-save-restriction-and-excursion + (goto-char begin-marker) + (forward-line line) + (-let [line-end (line-end-position)] + (if (> character (- line-end (point))) + line-end + (forward-char character) + (point))))))) + :major-mode (org-src-get-lang-mode language) + :buffer-file-name file-name + :buffer-uri (lsp--path-to-uri file-name) + :with-current-buffer wcb + :buffer-live? (lambda (_) (buffer-live-p buf)) + :buffer-name (lambda (_) + (propertize (format "%s(%s:%s)%s" + (buffer-name buf) + begin-marker + end-marker + language) + 'face 'italic)) + :real->virtual-line (lambda (line) + (+ line (line-number-at-pos begin-marker) -1)) + :real->virtual-char (lambda (char) (+ char indentation)) + :cleanup (lambda () + (set-marker begin-marker nil) + (set-marker end-marker nil)))) + (setf virtual-buffer lsp--virtual-buffer) + (puthash file-name virtual-buffer lsp--virtual-buffer-mappings) + (push virtual-buffer lsp--virtual-buffer-connections) + + ;; TODO: tangle only connected sections + (add-hook 'after-save-hook 'org-babel-tangle nil t) + (add-hook 'lsp-after-open-hook #'lsp-patch-on-change-event nil t) + (add-hook 'kill-buffer-hook #'lsp-kill-virtual-buffers nil t) + + (setq lsp--buffer-workspaces + (lsp-with-current-buffer virtual-buffer + (lsp) + (plist-put virtual-buffer :workspaces (lsp-workspaces)) + (lsp-workspaces))))))) + +(defun lsp-virtual-buffer-disconnect (virtual-buffer) + (interactive (list (or + lsp--virtual-buffer + (when lsp--virtual-buffer-connections + (lsp--completing-read "Select virtual buffer to disconnect: " + lsp--virtual-buffer-connections + (-lambda ((&plist :buffer-file-name)) + buffer-file-name)))))) + (-if-let ((&plist :buffer-file-name file-name :cleanup) virtual-buffer) + (progn + (lsp-with-current-buffer virtual-buffer + (lsp--text-document-did-close)) + (setq lsp--virtual-buffer-connections (-remove-item virtual-buffer lsp--virtual-buffer-connections)) + (when (eq virtual-buffer lsp--virtual-buffer) + (setf lsp--virtual-buffer nil)) + (when cleanup (funcall cleanup)) + (remhash file-name lsp--virtual-buffer-mappings) + + (lsp--virtual-buffer-update-position) + (lsp--info "Disconnected from buffer %s" file-name)) + (lsp--error "Nothing to disconnect from?"))) + + +;; inlay hints + +(defface lsp-inlay-hint-face + '((t :inherit font-lock-comment-face)) + "The face to use for the JavaScript inlays." + :group 'lsp-mode + :package-version '(lsp-mode . "9.0.0")) + +(defface lsp-inlay-hint-type-face + '((t :inherit lsp-inlay-hint-face)) + "Face for inlay type hints (e.g. inferred variable types)." + :group 'lsp-mode + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-inlay-hint-type-format "%s" + "Format string for variable inlays (part of the inlay face)." + :type '(string :tag "String") + :group 'lsp-mode + :package-version '(lsp-mode . "9.0.0")) + +(defface lsp-inlay-hint-parameter-face + '((t :inherit lsp-inlay-hint-face)) + "Face for inlay parameter hints (e.g. function parameter names at +call-site)." + :group 'lsp-mode + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-inlay-hint-param-format "%s" + "Format string for parameter inlays (part of the inlay face)." + :type '(string :tag "String") + :group 'lsp-mode + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-update-inlay-hints-on-scroll t + "If non-nil update inlay hints immediately when scrolling or +modifying window sizes." + :type 'boolean + :package-version '(lsp-mode . "9.0.0")) + +(defun lsp--format-inlay (text kind) + (cond + ((eql kind lsp/inlay-hint-kind-type-hint) (format lsp-inlay-hint-type-format text)) + ((eql kind lsp/inlay-hint-kind-parameter-hint) (format lsp-inlay-hint-param-format text)) + (t text))) + +(defun lsp--face-for-inlay (kind) + (cond + ((eql kind lsp/inlay-hint-kind-type-hint) 'lsp-inlay-hint-type-face) + ((eql kind lsp/inlay-hint-kind-parameter-hint) 'lsp-inlay-hint-parameter-face) + (t 'lsp-inlay-hint-face))) + +(defun lsp--update-inlay-hints-scroll-function (window start) + (lsp-update-inlay-hints start (window-end window t))) + +(defun lsp--update-inlay-hints () + (lsp-update-inlay-hints (window-start) (window-end nil t))) + +(defun lsp--label-from-inlay-hints-response (label) + "Returns a string label built from an array of +InlayHintLabelParts or the argument itself if it's already a +string." + (cl-typecase label + (string label) + (vector + (string-join (mapcar (lambda (part) + (-let (((&InlayHintLabelPart :value) part)) + value)) + label))))) + +(defun lsp-update-inlay-hints (start end) + (lsp-request-async + "textDocument/inlayHint" + (lsp-make-inlay-hints-params + :text-document (lsp--text-document-identifier) + :range (lsp-make-range :start + (lsp-point-to-position start) + :end + (lsp-point-to-position end))) + (lambda (res) + (lsp--remove-overlays 'lsp-inlay-hint) + (dolist (hint res) + (-let* (((&InlayHint :label :position :kind? :padding-left? :padding-right?) hint) + (kind (or kind? lsp/inlay-hint-kind-type-hint)) + (label (lsp--label-from-inlay-hints-response label)) + (pos (lsp--position-to-point position)) + (overlay (make-overlay pos pos nil 'front-advance 'end-advance))) + (when (stringp label) + (overlay-put overlay 'lsp-inlay-hint t) + (overlay-put overlay 'before-string + (format "%s%s%s" + (if padding-left? " " "") + (propertize (lsp--format-inlay label kind) + 'font-lock-face (lsp--face-for-inlay kind)) + (if padding-right? " " ""))))))) + :mode 'tick)) + +(define-minor-mode lsp-inlay-hints-mode + "Mode for displaying inlay hints." + :lighter nil + (cond + ((and lsp-inlay-hints-mode lsp--buffer-workspaces) + (add-hook 'lsp-on-idle-hook #'lsp--update-inlay-hints nil t) + (when lsp-update-inlay-hints-on-scroll + (add-to-list (make-local-variable 'window-scroll-functions) + #'lsp--update-inlay-hints-scroll-function))) + (t + (lsp--remove-overlays 'lsp-inlay-hint) + (remove-hook 'lsp-on-idle-hook #'lsp--update-inlay-hints t) + (setf window-scroll-functions + (delete #'lsp--update-inlay-hints-scroll-function window-scroll-functions))))) + + + +;;;###autoload +(defun lsp-start-plain () + "Start `lsp-mode' using minimal configuration using the latest `melpa' version +of the packages. + +In case the major-mode that you are using for " + (interactive) + (let ((start-plain (make-temp-file "plain" nil ".el"))) + (url-copy-file "https://raw.githubusercontent.com/emacs-lsp/lsp-mode/master/scripts/lsp-start-plain.el" + start-plain t) + (start-process "lsp-start-plain" + (generate-new-buffer " *lsp-start-plain*") + (expand-file-name invocation-name invocation-directory) + "-q" "-l" start-plain (or (buffer-file-name) "")))) + + + +(provide 'lsp-mode) +;;; lsp-mode.el ends here diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-mode.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-mode.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-modeline.el b/emacs/elpa/lsp-mode-20241119.828/lsp-modeline.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-modeline.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-modeline.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-mojo.el b/emacs/elpa/lsp-mode-20241119.828/lsp-mojo.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-mojo.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-mojo.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-move.el b/emacs/elpa/lsp-mode-20241119.828/lsp-move.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-move.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-move.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-nextflow.el b/emacs/elpa/lsp-mode-20241119.828/lsp-nextflow.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-nextflow.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-nextflow.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-nginx.el b/emacs/elpa/lsp-mode-20241119.828/lsp-nginx.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-nginx.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-nginx.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-nim.el b/emacs/elpa/lsp-mode-20241119.828/lsp-nim.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-nim.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-nim.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-nix.el b/emacs/elpa/lsp-mode-20241119.828/lsp-nix.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-nix.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-nix.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-nushell.el b/emacs/elpa/lsp-mode-20241119.828/lsp-nushell.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-nushell.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-nushell.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-ocaml.el b/emacs/elpa/lsp-mode-20241119.828/lsp-ocaml.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-ocaml.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-ocaml.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-openscad.el b/emacs/elpa/lsp-mode-20241119.828/lsp-openscad.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-openscad.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-openscad.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-perl.el b/emacs/elpa/lsp-mode-20241119.828/lsp-perl.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-perl.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-perl.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-perlnavigator.el b/emacs/elpa/lsp-mode-20241119.828/lsp-perlnavigator.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-perlnavigator.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-perlnavigator.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-php.el b/emacs/elpa/lsp-mode-20241119.828/lsp-php.el diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-php.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-php.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-pls.el b/emacs/elpa/lsp-mode-20241119.828/lsp-pls.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-pls.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-pls.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-prolog.el b/emacs/elpa/lsp-mode-20241119.828/lsp-prolog.el @@ -0,0 +1,55 @@ +;;; lsp-prolog.el --- Prolog Client settings -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 James Cash + +;; Author: James Cash <james.nvc@gmail.com> +;; Keywords: languages,tools + +;; 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: + +;; lsp-prolog client + +;;; Code: + +(require 'lsp-mode) + +(defgroup lsp-prolog nil + "LSP support for Prolog." + :link '(url-link "https://github.com/jamesnvc/lsp_server") + :group 'lsp-mode + :tag "Lsp Prolog") + +(defcustom lsp-prolog-server-command '("swipl" + "-g" "use_module(library(lsp_server))." + "-g" "lsp_server:main" + "-t" "halt" + "--" "stdio") + "The prolog-lsp server command." + :group 'lsp-prolog + :risky t + :type '(list string)) + +(lsp-register-client + (make-lsp-client + :new-connection (lsp-stdio-connection (lambda () lsp-prolog-server-command)) + :major-modes '(prolog-mode) + :multi-root t + :server-id 'prolog-lsp)) + +(lsp-consistency-check lsp-prolog) + +(provide 'lsp-prolog) +;;; lsp-prolog.el ends here diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-prolog.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-prolog.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-protocol.el b/emacs/elpa/lsp-mode-20241119.828/lsp-protocol.el @@ -0,0 +1,831 @@ +;;; lsp-protocol.el --- Language Sever Protocol Bindings -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Ivan Yonchovski + +;; Author: Ivan Yonchovski <yyoncho@gmail.com> +;; Keywords: convenience + +;; 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: + +;; Autogenerated bindings from lsp4j using +;; https://github.com/victools/jsonschema-generator+scripts to generate +;; scripts/generated.protocol.schema.json and then +;; scripts/lsp-generate-bindings.el + +;;; Code: + +(require 'cl-lib) +(require 'dash) +(require 'ht) +(require 's) +(require 'json) + +(eval-and-compile + (defun lsp-keyword->symbol (keyword) + "Convert a KEYWORD to symbol." + (intern (substring (symbol-name keyword) 1))) + + (defun lsp-keyword->string (keyword) + "Convert a KEYWORD to string." + (substring (symbol-name keyword) 1)) + + (defvar lsp-use-plists (getenv "LSP_USE_PLISTS"))) + +(defmacro lsp-interface (&rest interfaces) + "Generate LSP bindings from INTERFACES triplet. + +Example usage with `dash`. + +\(-let [(&ApplyWorkspaceEditResponse + :failure-reason?) (ht (\"failureReason\" \"...\"))] + failure-reason?) + +\(fn (INTERFACE-NAME-1 REQUIRED-FIELDS-1 OPTIONAL-FIELDS-1) (INTERFACE-NAME-2 REQUIRED-FIELDS-2 OPTIONAL-FIELDS-2) ...)" + (with-case-table ascii-case-table + (->> interfaces + (-map (-lambda ((interface required optional)) + (let ((params (nconc + (-map (lambda (param-name) + (cons + (intern (concat ":" (s-dashed-words (symbol-name param-name)) "?")) + param-name)) + optional) + (-map (lambda (param-name) + (cons (intern (concat ":" (s-dashed-words (symbol-name param-name)))) + param-name)) + required)))) + (cl-list* + `(defun ,(intern (format "dash-expand:&%s" interface)) (key source) + (unless (or (member key ',(-map #'cl-first params)) + (s-starts-with? ":_" (symbol-name key))) + (error "Unknown key: %s. Available keys: %s" key ',(-map #'cl-first params))) + ,(if lsp-use-plists + ``(plist-get ,source + ,(if (s-starts-with? ":_" (symbol-name key)) + key + (cl-rest (assoc key ',params)))) + ``(gethash ,(if (s-starts-with? ":_" (symbol-name key)) + (substring (symbol-name key) 1) + (substring (symbol-name + (cl-rest (assoc key ',params))) + 1)) + ,source))) + `(defun ,(intern (format "dash-expand:&%s?" interface)) (key source) + (unless (member key ',(-map #'cl-first params)) + (error "Unknown key: %s. Available keys: %s" key ',(-map #'cl-first params))) + ,(if lsp-use-plists + ``(plist-get ,source + ,(if (s-starts-with? ":_" (symbol-name key)) + key + (cl-rest (assoc key ',params)))) + ``(when (ht? ,source) + (gethash ,(substring (symbol-name + (cl-rest (assoc key ',params))) + 1) + ,source)))) + + `(defun ,(intern (format "lsp-%s?" (s-dashed-words (symbol-name interface)))) (object) + (cond + ((ht? object) + (-all? (let ((keys (ht-keys object))) + (lambda (prop) + (member prop keys))) + ',(-map (lambda (field-name) + (substring (symbol-name field-name) 1)) + required))) + ((listp object) (-all? (lambda (prop) + (plist-member object prop)) + ',required)))) + `(cl-defun ,(intern (format "lsp-make-%s" (s-dashed-words (symbol-name interface)))) + (&rest plist &key ,@(-map (-lambda ((key)) + (let ((key-sym (intern (substring (symbol-name key) 1)))) + (if (special-variable-p key-sym) + `((,key ,(intern (format "%s_" (symbol-name key-sym))))) + key-sym))) + params) + &allow-other-keys) + ,(format "Constructs %s from `plist.' +Allowed params: %s" interface (reverse (-map #'cl-first params))) + (ignore ,@(-map (-lambda ((key)) + (let ((key-sym (intern (substring (symbol-name key) 1)))) + (if (special-variable-p key-sym) + (intern (format "%s_" (symbol-name key-sym))) + key-sym))) + params)) + ,(if lsp-use-plists + `(-mapcat (-lambda ((key value)) + (list (or (cl-rest (assoc key ',params)) key) value)) + (-partition 2 plist)) + `(let (($$result (ht))) + (mapc (-lambda ((key value)) + (puthash (lsp-keyword->string (or (cl-rest (assoc key ',params)) + key)) + value + $$result)) + (-partition 2 plist)) + $$result))) + `(cl-defun ,(intern (format "lsp--pcase-macroexpander-%s" interface)) (&rest property-bindings) + ,(if lsp-use-plists + ``(and + (pred listp) + ;; Check if all the types required by the + ;; interface exist in the expr-val. + ,@(-map + (lambda (key) + `(pred + (lambda (plist) + (plist-member plist ,key)))) + ',required) + ;; Recursively generate the bindings. + ,@(let ((current-list property-bindings) + (output-bindings nil)) + ;; Invariant: while current-list is + ;; non-nil, the car of current-list is + ;; always of the form :key, while the + ;; cadr of current-list is either a) + ;; nil, b) of the form :key-next or c) + ;; a pcase pattern that can + ;; recursively match an expression. + (while current-list + (-let* (((curr-binding-as-keyword next-entry . _) current-list) + (curr-binding-as-camelcased-symbol + (or (alist-get curr-binding-as-keyword ',params) + (error "Unknown key: %s. Available keys: %s" + (symbol-name curr-binding-as-keyword) + ',(-map #'cl-first params)))) + (bound-name (lsp-keyword->symbol curr-binding-as-keyword)) + (next-entry-is-key-or-nil + (and (symbolp next-entry) + (or (null next-entry) + (s-starts-with? ":" (symbol-name next-entry)))))) + (cond + ;; If the next-entry is either a + ;; plist-key or nil, then bind to + ;; bound-name the value corresponding + ;; to the camelcased symbol. Pop + ;; current-list once. + (next-entry-is-key-or-nil + (push `(app (lambda (plist) + (plist-get plist ,curr-binding-as-camelcased-symbol)) + ,bound-name) + output-bindings) + (setf current-list (cdr current-list))) + ;; Otherwise, next-entry is a pcase + ;; pattern we recursively match to the + ;; expression. This can in general + ;; create additional bindings that we + ;; persist in the top level of + ;; bindings. We pop current-list + ;; twice. + (t + (push `(app (lambda (plist) + (plist-get plist ,curr-binding-as-camelcased-symbol)) + ,next-entry) + output-bindings) + (setf current-list (cddr current-list)))))) + output-bindings)) + ``(and + (pred ht?) + ,@(-map + (lambda (key) + `(pred + (lambda (hash-table) + (ht-contains? hash-table ,(lsp-keyword->string key))))) + ',required) + ,@(let ((current-list property-bindings) + (output-bindings nil)) + (while current-list + (-let* (((curr-binding-as-keyword next-entry . _) current-list) + (curr-binding-as-camelcased-string + (lsp-keyword->string (or (alist-get curr-binding-as-keyword ',params) + (error "Unknown key: %s. Available keys: %s" + (symbol-name curr-binding-as-keyword) + ',(-map #'cl-first params))))) + (bound-name (lsp-keyword->symbol curr-binding-as-keyword)) + (next-entry-is-key-or-nil + (and (symbolp next-entry) + (or (null next-entry) + (s-starts-with? ":" (symbol-name next-entry)))))) + (cond + (next-entry-is-key-or-nil + (push `(app (lambda (hash-table) + (ht-get hash-table ,curr-binding-as-camelcased-string)) + ,bound-name) + output-bindings) + (setf current-list (cdr current-list))) + (t + (push `(app (lambda (hash-table) + (ht-get hash-table ,curr-binding-as-camelcased-string)) + ,next-entry) + output-bindings) + (setf current-list (cddr current-list)))))) + output-bindings)))) + (-mapcat (-lambda ((label . name)) + (list + `(defun ,(intern (format "lsp:%s-%s" + (s-dashed-words (symbol-name interface)) + (substring (symbol-name label) 1))) + (object) + ,(if lsp-use-plists + `(plist-get object ,name) + `(when (ht? object) (gethash ,(lsp-keyword->string name) object)))) + `(defun ,(intern (format "lsp:set-%s-%s" + (s-dashed-words (symbol-name interface)) + (substring (symbol-name label) 1))) + (object value) + ,@(if lsp-use-plists + `((plist-put object ,name value)) + `((puthash ,(lsp-keyword->string name) value object) + object))))) + params))))) + (apply #'append) + (cl-list* 'progn)))) + +(pcase-defmacro lsp-interface (interface &rest property-bindings) + "If EXPVAL is an instance of INTERFACE, destructure it by matching its +properties. EXPVAL should be a plist or hash table depending on the variable +`lsp-use-plists'. + +INTERFACE should be an LSP interface defined with `lsp-interface'. This form +will not match if any of INTERFACE's required fields are missing in EXPVAL. + +Each :PROPERTY keyword matches a field in EXPVAL. The keyword may be followed by +an optional PATTERN, which is a `pcase' pattern to apply to the field's value. +Otherwise, PROPERTY is let-bound to the field's value. + +\(fn INTERFACE [:PROPERTY [PATTERN]]...)" + (cl-check-type interface symbol) + (let ((lsp-pcase-macroexpander + (intern (format "lsp--pcase-macroexpander-%s" interface)))) + (cl-assert (fboundp lsp-pcase-macroexpander) "not a known LSP interface: %s" interface) + (apply lsp-pcase-macroexpander property-bindings))) + +(if lsp-use-plists + (progn + (defun lsp-get (from key) + (plist-get from key)) + (defun lsp-put (where key value) + (plist-put where key value)) + (defun lsp-map (fn value) + (-map (-lambda ((k v)) + (funcall fn (lsp-keyword->string k) v)) + (-partition 2 value ))) + (defalias 'lsp-merge 'append) + (defalias 'lsp-empty? 'null) + (defalias 'lsp-copy 'copy-sequence) + (defun lsp-member? (from key) + (when (listp from) + (plist-member from key))) + (defalias 'lsp-structure-p 'json-plist-p) + (defun lsp-delete (from key) + (cl-remf from key) + from)) + (defun lsp-get (from key) + (when from + (gethash (lsp-keyword->string key) from))) + (defun lsp-put (where key value) + (prog1 where + (puthash (lsp-keyword->string key) value where))) + (defun lsp-map (fn value) + (when value + (maphash fn value))) + (defalias 'lsp-merge 'ht-merge) + (defalias 'lsp-empty? 'ht-empty?) + (defalias 'lsp-copy 'ht-copy) + (defun lsp-member? (from key) + (when (hash-table-p from) + (not (eq (gethash (lsp-keyword->string key) from :__lsp_default) + :__lsp_default)))) + (defalias 'lsp-structure-p 'hash-table-p) + (defun lsp-delete (from key) + (ht-remove from (lsp-keyword->string key)) + from)) + +(defmacro lsp-defun (name match-form &rest body) + "Define a function named NAME. +The function destructures its input as MATCH-FORM then executes BODY. + +Note that you have to enclose the MATCH-FORM in a pair of parens, +such that: + + (-defun (x) body) + (-defun (x y ...) body) + +has the usual semantics of `defun'. Furthermore, these get +translated into a normal `defun', so there is no performance +penalty. + +See `-let' for a description of the destructuring mechanism." + (declare (doc-string 3) (indent defun) + (debug (&define name sexp + [&optional stringp] + [&optional ("declare" &rest sexp)] + [&optional ("interactive" interactive)] + def-body))) + (cond + ((nlistp match-form) + (signal 'wrong-type-argument (list #'listp match-form))) + ;; no destructuring, so just return regular defun to make things faster + ((-all? #'symbolp match-form) + `(defun ,name ,match-form ,@body)) + (t + (-let* ((inputs (--map-indexed (list it (make-symbol (format "input%d" it-index))) match-form)) + ((body docs) (cond + ;; only docs + ((and (stringp (car body)) + (not (cdr body))) + (list body (car body))) + ;; docs + body + ((stringp (car body)) + (list (cdr body) (car body))) + ;; no docs + (t (list body)))) + ((body interactive-form) (cond + ;; interactive form + ((and (listp (car body)) + (eq (caar body) 'interactive)) + (list (cdr body) (car body))) + ;; no interactive form + (t (list body))))) + ;; TODO: because inputs to the defun are evaluated only once, + ;; -let* need not to create the extra bindings to ensure that. + ;; We should find a way to optimize that. Not critical however. + `(defun ,name ,(-map #'cadr inputs) + ,@(when docs (list docs)) + ,@(when interactive-form (list interactive-form)) + (-let* ,inputs ,@body)))))) + + + + +;; manually defined interfaces +(defconst lsp/markup-kind-plain-text "plaintext") +(defconst lsp/markup-kind-markdown "markdown") + +(lsp-interface (JSONResponse (:params :id :method :result) nil) + (JSONResponseError (:error) nil) + (JSONMessage nil (:params :id :method :result :error)) + (JSONResult nil (:params :id :method)) + (JSONNotification (:params :method) nil) + (JSONRequest (:params :method) nil) + (JSONError (:message :code) (:data)) + (ProgressParams (:token :value) nil) + (Edit (:kind) nil) + (WorkDoneProgress (:kind) nil) + (WorkDoneProgressBegin (:kind :title) (:cancellable :message :percentage)) + (WorkDoneProgressReport (:kind) (:cancellable :message :percentage)) + (WorkDoneProgressEnd (:kind) (:message)) + (WorkDoneProgressOptions nil (:workDoneProgress)) + (SemanticTokensOptions (:legend) (:rangeProvider :documentProvider)) + (SemanticTokensLegend (:tokenTypes :tokenModifiers)) + (SemanticTokensResult (:resultId) (:data)) + (SemanticTokensPartialResult nil (:data)) + (SemanticTokensEdit (:start :deleteCount) (:data)) + (SemanticTokensDelta (:resultId) (:edits)) + (SemanticTokensDeltaPartialResult nil (:edits))) + +(lsp-interface (v1:ProgressParams (:id :title) (:message :percentage :done))) + +(defun dash-expand:&RangeToPoint (key source) + "Convert the position KEY from SOURCE into a point." + `(lsp--position-to-point + (lsp-get ,source ,key))) + +(lsp-interface (eslint:StatusParams (:state) nil) + (eslint:OpenESLintDocParams (:url) nil) + (eslint:ConfirmExecutionParams (:scope :file :libraryPath) nil)) + +(lsp-interface (haxe:ProcessStartNotification (:title) nil)) + +(lsp-interface (pwsh:ScriptRegion (:StartLineNumber :EndLineNumber :StartColumnNumber :EndColumnNumber :Text) nil)) + +(lsp-interface (omnisharp:ErrorMessage (:Text :FileName :Line :Column)) + (omnisharp:ProjectInformationRequest (:FileName)) + (omnisharp:MsBuildProject (:IsUnitProject :IsExe :Platform :Configuration :IntermediateOutputPath :OutputPath :TargetFrameworks :SourceFiles :TargetFramework :TargetPath :AssemblyName :Path :ProjectGuid)) + (omnisharp:ProjectInformation (:ScriptProject :MsBuildProject)) + (omnisharp:CodeStructureRequest (:FileName)) + (omnisharp:CodeStructureResponse (:Elements)) + (omnisharp:CodeElement (:Kind :Name :DisplayName :Children :Ranges :Properties)) + (omnisharp:CodeElementProperties () (:static :accessibility :testMethodName :testFramework)) + (omnisharp:Range (:Start :End)) + (omnisharp:RangeList () (:attributes :full :name)) + (omnisharp:Point (:Line :Column)) + (omnisharp:RunTestsInClassRequest (:MethodNames :RunSettings :TestFrameworkname :TargetFrameworkVersion :NoBuild :Line :Column :Buffer :FileName)) + (omnisharp:RunTestResponse (:Results :Pass :Failure :ContextHadNoTests)) + (omnisharp:TestMessageEvent (:MessageLevel :Message)) + (omnisharp:DotNetTestResult (:MethodName :Outcome :ErrorMessage :ErrorStackTrace :StandardOutput :StandardError)) + (omnisharp:MetadataRequest (:AssemblyName :TypeName :ProjectName :VersionNumber :Language)) + (omnisharp:MetadataResponse (:SourceName :Source))) + +(lsp-interface (csharp-ls:CSharpMetadata (:textDocument)) + (csharp-ls:CSharpMetadataResponse (:source :projectName :assemblyName :symbolName))) + +(lsp-interface (rls:Cmd (:args :binary :env :cwd) nil)) + +(lsp-interface (rust-analyzer:AnalyzerStatusParams (:textDocument)) + (rust-analyzer:SyntaxTreeParams (:textDocument) (:range)) + (rust-analyzer:ViewHir (:textDocument :position)) + (rust-analyzer:ViewItemTree (:textDocument)) + (rust-analyzer:ExpandMacroParams (:textDocument :position) nil) + (rust-analyzer:ExpandedMacro (:name :expansion) nil) + (rust-analyzer:MatchingBraceParams (:textDocument :positions) nil) + (rust-analyzer:OpenCargoTomlParams (:textDocument) nil) + (rust-analyzer:OpenExternalDocsParams (:textDocument :position) nil) + (rust-analyzer:ResovedCodeActionParams (:id :codeActionParams) nil) + (rust-analyzer:JoinLinesParams (:textDocument :ranges) nil) + (rust-analyzer:MoveItemParams (:textDocument :range :direction) nil) + (rust-analyzer:RunnablesParams (:textDocument) (:position)) + (rust-analyzer:Runnable (:label :kind :args) (:location)) + (rust-analyzer:RunnableArgs (:cargoArgs :executableArgs) (:workspaceRoot :expectTest)) + (rust-analyzer:RelatedTestsParams (:textDocument :position) nil) + (rust-analyzer:RelatedTests (:runnable) nil) + (rust-analyzer:SsrParams (:query :parseOnly) nil) + (rust-analyzer:CommandLink (:title :command) (:arguments :tooltip)) + (rust-analyzer:CommandLinkGroup (:commands) (:title))) + +(lsp-interface (clojure-lsp:TestTreeParams (:uri :tree) nil) + (clojure-lsp:TestTreeNode (:name :range :nameRange :kind) (:children)) + (clojure-lsp:ProjectTreeNode (:name :type) (:nodes :final :id :uri :detail :range))) + +(lsp-interface (terraform-ls:ModuleCalls (:v :module_calls) nil)) +(lsp-interface (terraform-ls:Module (:name :docs_link :version :source_type :dependent_modules) nil)) +(lsp-interface (terraform-ls:Providers (:v :provider_requirements :installed_providers) nil)) +(lsp-interface (terraform-ls:module.terraform (:v :required_version :discovered_version))) + + +;; begin autogenerated code + +(defvar lsp/completion-item-kind-lookup + [nil Text Method Function Constructor Field Variable Class Interface Module Property Unit Value Enum Keyword Snippet Color File Reference Folder EnumMember Constant Struct Event Operator TypeParameter]) +(defconst lsp/completion-item-kind-text 1) +(defconst lsp/completion-item-kind-method 2) +(defconst lsp/completion-item-kind-function 3) +(defconst lsp/completion-item-kind-constructor 4) +(defconst lsp/completion-item-kind-field 5) +(defconst lsp/completion-item-kind-variable 6) +(defconst lsp/completion-item-kind-class 7) +(defconst lsp/completion-item-kind-interface 8) +(defconst lsp/completion-item-kind-module 9) +(defconst lsp/completion-item-kind-property 10) +(defconst lsp/completion-item-kind-unit 11) +(defconst lsp/completion-item-kind-value 12) +(defconst lsp/completion-item-kind-enum 13) +(defconst lsp/completion-item-kind-keyword 14) +(defconst lsp/completion-item-kind-snippet 15) +(defconst lsp/completion-item-kind-color 16) +(defconst lsp/completion-item-kind-file 17) +(defconst lsp/completion-item-kind-reference 18) +(defconst lsp/completion-item-kind-folder 19) +(defconst lsp/completion-item-kind-enum-member 20) +(defconst lsp/completion-item-kind-constant 21) +(defconst lsp/completion-item-kind-struct 22) +(defconst lsp/completion-item-kind-event 23) +(defconst lsp/completion-item-kind-operator 24) +(defconst lsp/completion-item-kind-type-parameter 25) +(defvar lsp/completion-trigger-kind-lookup + [nil Invoked TriggerCharacter TriggerForIncompleteCompletions]) +(defconst lsp/completion-trigger-kind-invoked 1) +(defconst lsp/completion-trigger-kind-trigger-character 2) +(defconst lsp/completion-trigger-kind-trigger-for-incomplete-completions 3) +(defvar lsp/diagnostic-severity-lookup + [nil Error Warning Information Hint Max]) +(defconst lsp/diagnostic-severity-error 1) +(defconst lsp/diagnostic-severity-warning 2) +(defconst lsp/diagnostic-severity-information 3) +(defconst lsp/diagnostic-severity-hint 4) +(defconst lsp/diagnostic-severity-max 5) +(defvar lsp/diagnostic-tag-lookup + [nil Unnecessary Deprecated]) +(defconst lsp/diagnostic-tag-unnecessary 1) +(defconst lsp/diagnostic-tag-deprecated 2) +(defvar lsp/completion-item-tag-lookup + [nil Deprecated]) +(defconst lsp/completion-item-tag-deprecated 1) +(defvar lsp/document-highlight-kind-lookup + [nil Text Read Write]) +(defconst lsp/document-highlight-kind-text 1) +(defconst lsp/document-highlight-kind-read 2) +(defconst lsp/document-highlight-kind-write 3) +(defvar lsp/file-change-type-lookup + [nil Created Changed Deleted]) +(defconst lsp/file-change-type-created 1) +(defconst lsp/file-change-type-changed 2) +(defconst lsp/file-change-type-deleted 3) +(defvar lsp/insert-text-format-lookup + [nil PlainText Snippet]) +(defconst lsp/insert-text-format-plain-text 1) +(defconst lsp/insert-text-format-snippet 2) +(defvar lsp/insert-text-mode-lookup + [nil AsIs AdjustIndentation]) +(defconst lsp/insert-text-mode-as-it 1) +(defconst lsp/insert-text-mode-adjust-indentation 2) +(defvar lsp/message-type-lookup + [nil Error Warning Info Log]) +(defconst lsp/message-type-error 1) +(defconst lsp/message-type-warning 2) +(defconst lsp/message-type-info 3) +(defconst lsp/message-type-log 4) +(defvar lsp/signature-help-trigger-kind-lookup + [nil Invoked TriggerCharacter ContentChange]) +(defconst lsp/signature-help-trigger-kind-invoked 1) +(defconst lsp/signature-help-trigger-kind-trigger-character 2) +(defconst lsp/signature-help-trigger-kind-content-change 3) +(defvar lsp/symbol-kind-lookup + [nil File Module Namespace Package Class Method Property Field Constructor Enum Interface Function Variable Constant String Number Boolean Array Object Key Null EnumMember Struct Event Operator TypeParameter]) +(defconst lsp/symbol-kind-file 1) +(defconst lsp/symbol-kind-module 2) +(defconst lsp/symbol-kind-namespace 3) +(defconst lsp/symbol-kind-package 4) +(defconst lsp/symbol-kind-class 5) +(defconst lsp/symbol-kind-method 6) +(defconst lsp/symbol-kind-property 7) +(defconst lsp/symbol-kind-field 8) +(defconst lsp/symbol-kind-constructor 9) +(defconst lsp/symbol-kind-enum 10) +(defconst lsp/symbol-kind-interface 11) +(defconst lsp/symbol-kind-function 12) +(defconst lsp/symbol-kind-variable 13) +(defconst lsp/symbol-kind-constant 14) +(defconst lsp/symbol-kind-string 15) +(defconst lsp/symbol-kind-number 16) +(defconst lsp/symbol-kind-boolean 17) +(defconst lsp/symbol-kind-array 18) +(defconst lsp/symbol-kind-object 19) +(defconst lsp/symbol-kind-key 20) +(defconst lsp/symbol-kind-null 21) +(defconst lsp/symbol-kind-enum-member 22) +(defconst lsp/symbol-kind-struct 23) +(defconst lsp/symbol-kind-event 24) +(defconst lsp/symbol-kind-operator 25) +(defconst lsp/symbol-kind-type-parameter 26) +(defvar lsp/text-document-save-reason-lookup + [nil Manual AfterDelay FocusOut]) +(defconst lsp/text-document-save-reason-manual 1) +(defconst lsp/text-document-save-reason-after-delay 2) +(defconst lsp/text-document-save-reason-focus-out 3) +(defvar lsp/text-document-sync-kind-lookup + [None Full Incremental]) +(defconst lsp/text-document-sync-kind-none 0) +(defconst lsp/text-document-sync-kind-full 1) +(defconst lsp/text-document-sync-kind-incremental 2) +(defvar lsp/type-hierarchy-direction-lookup + [nil Children Parents Both]) +(defconst lsp/type-hierarchy-direction-children 1) +(defconst lsp/type-hierarchy-direction-parents 2) +(defconst lsp/type-hierarchy-direction-both 3) +(defvar lsp/call-hierarchy-direction-lookup + [nil CallsFrom CallsTo]) +(defconst lsp/call-hierarchy-direction-calls-from 1) +(defconst lsp/call-hierarchy-direction-calls-to 2) +(defvar lsp/response-error-code-lookup + [nil ParseError InvalidRequest MethodNotFound InvalidParams InternalError serverErrorStart serverErrorEnd]) +(defconst lsp/response-error-code-parse-error 1) +(defconst lsp/response-error-code-invalid-request 2) +(defconst lsp/response-error-code-method-not-found 3) +(defconst lsp/response-error-code-invalid-params 4) +(defconst lsp/response-error-code-internal-error 5) +(defconst lsp/response-error-code-server-error-start 6) +(defconst lsp/response-error-code-server-error-end 7) + +(lsp-interface + (CallHierarchyCapabilities nil (:dynamicRegistration)) + (CallHierarchyItem (:kind :name :range :selectionRange :uri) (:detail :tags)) + (ClientCapabilities nil (:experimental :textDocument :workspace)) + (ClientInfo (:name) (:version)) + (CodeActionCapabilities nil (:codeActionLiteralSupport :dynamicRegistration :isPreferredSupport :dataSupport :resolveSupport)) + (CodeActionContext (:diagnostics) (:only)) + (CodeActionKindCapabilities (:valueSet) nil) + (CodeActionLiteralSupportCapabilities nil (:codeActionKind)) + (CodeActionOptions nil (:codeActionKinds :resolveProvider)) + (CodeLensCapabilities nil (:dynamicRegistration)) + (CodeLensOptions (:resolveProvider) nil) + (Color (:red :green :blue :alpha) nil) + (ColorProviderCapabilities nil (:dynamicRegistration)) + (ColorProviderOptions nil (:documentSelector :id)) + (ColoringInformation (:range :styles) nil) + (Command (:title :command) (:arguments)) + (CompletionCapabilities nil (:completionItem :completionItemKind :contextSupport :dynamicRegistration)) + (CompletionContext (:triggerKind) (:triggerCharacter)) + (CompletionItem (:label) (:additionalTextEdits :command :commitCharacters :data :deprecated :detail :documentation :filterText :insertText :insertTextFormat :insertTextMode :kind :preselect :sortText :tags :textEdit :score :labelDetails)) + (CompletionItemCapabilities nil (:commitCharactersSupport :deprecatedSupport :documentationFormat :preselectSupport :snippetSupport :tagSupport :insertReplaceSupport :resolveSupport)) + (CompletionItemKindCapabilities nil (:valueSet)) + (CompletionItemTagSupportCapabilities (:valueSet) nil) + (CompletionOptions nil (:resolveProvider :triggerCharacters :allCommitCharacters)) + (ConfigurationItem nil (:scopeUri :section)) + (CreateFileOptions nil (:ignoreIfExists :overwrite)) + (DeclarationCapabilities nil (:dynamicRegistration :linkSupport)) + (DefinitionCapabilities nil (:dynamicRegistration :linkSupport)) + (DeleteFileOptions nil (:ignoreIfNotExists :recursive)) + (Diagnostic (:range :message) (:code :relatedInformation :severity :source :tags)) + (DiagnosticClientCapabilities nil (:dynamicRegistration :relatedDocumentSupport)) + (DiagnosticOptions (:interFileDependencies :workspaceDiagnostics) (:identifier)) + (DiagnosticRelatedInformation (:location :message) nil) + (DiagnosticServerCancellationData (:retriggerRequest) nil) + (DiagnosticsTagSupport (:valueSet) nil) + (DidChangeConfigurationCapabilities nil (:dynamicRegistration)) + (DidChangeWatchedFilesCapabilities nil (:dynamicRegistration)) + (DocumentDiagnosticParams (:textDocument) (:identifier :previousResultId)) + (DocumentDiagnosticReport (:kind) (:resultId :items :relatedDocuments)) + (DocumentFilter nil (:language :pattern :scheme)) + (DocumentHighlightCapabilities nil (:dynamicRegistration)) + (DocumentLinkCapabilities nil (:dynamicRegistration :tooltipSupport)) + (DocumentLinkOptions nil (:resolveProvider)) + (DocumentOnTypeFormattingOptions (:firstTriggerCharacter) (:moreTriggerCharacter)) + (DocumentSymbol (:kind :name :range :selectionRange) (:children :deprecated :detail)) + (DocumentSymbolCapabilities nil (:dynamicRegistration :hierarchicalDocumentSymbolSupport :symbolKind)) + (ExecuteCommandCapabilities nil (:dynamicRegistration)) + (ExecuteCommandOptions (:commands) nil) + (FileEvent (:type :uri) nil) + (FileSystemWatcher (:globPattern) (:kind)) + (FileOperationFilter (:pattern) (:scheme)) + (FileOperationPattern (:glob) (:matches :options)) + (FileOperationPatternOptions nil (:ignoreCase)) + (FileOperationRegistrationOptions (:filters) nil) + (FoldingRangeCapabilities nil (:dynamicRegistration :lineFoldingOnly :rangeLimit)) + (FoldingRangeProviderOptions nil (:documentSelector :id)) + (FormattingCapabilities nil (:dynamicRegistration)) + (FormattingOptions (:tabSize :insertSpaces) (:trimTrailingWhitespace :insertFinalNewline :trimFinalNewlines)) + (HoverCapabilities nil (:contentFormat :dynamicRegistration)) + (ImplementationCapabilities nil (:dynamicRegistration :linkSupport)) + (LabelDetails (:detail :description) nil) + (LinkedEditingRanges (:ranges) (:wordPattern)) + (Location (:range :uri) nil) + (MarkedString (:language :value) nil) + (MarkupContent (:kind :value) nil) + (MessageActionItem (:title) nil) + (OnTypeFormattingCapabilities nil (:dynamicRegistration)) + (ParameterInformation (:label) (:documentation)) + (ParameterInformationCapabilities nil (:labelOffsetSupport)) + (Position (:character :line) nil) + (PublishDiagnosticsCapabilities nil (:relatedInformation :tagSupport :versionSupport)) + (Range (:start :end) nil) + (RangeFormattingCapabilities nil (:dynamicRegistration)) + (ReferenceContext (:includeDeclaration) nil) + (ReferencesCapabilities nil (:dynamicRegistration)) + (Registration (:method :id) (:registerOptions)) + (RenameCapabilities nil (:dynamicRegistration :prepareSupport)) + (RenameFileOptions nil (:ignoreIfExists :overwrite)) + (RenameOptions nil (:documentSelector :id :prepareProvider)) + (ResourceChange nil (:current :newUri)) + (ResourceOperation (:kind) nil) + (SaveOptions nil (:includeText)) + (SelectionRange (:range) (:parent)) + (SelectionRangeCapabilities nil (:dynamicRegistration)) + (SemanticHighlightingCapabilities nil (:semanticHighlighting)) + (SemanticHighlightingInformation (:line) (:tokens)) + (SemanticHighlightingServerCapabilities nil (:scopes)) + (ServerCapabilities nil (:callHierarchyProvider :codeActionProvider :codeLensProvider :colorProvider :completionProvider :declarationProvider :definitionProvider :documentFormattingProvider :documentHighlightProvider :documentLinkProvider :documentOnTypeFormattingProvider :documentRangeFormattingProvider :documentSymbolProvider :executeCommandProvider :experimental :foldingRangeProvider :hoverProvider :implementationProvider :referencesProvider :renameProvider :selectionRangeProvider :semanticHighlighting :signatureHelpProvider :textDocumentSync :typeDefinitionProvider :typeHierarchyProvider :workspace :workspaceSymbolProvider :semanticTokensProvider)) + (ServerInfo (:name) (:version)) + (SignatureHelp (:signatures) (:activeParameter :activeSignature)) + (SignatureHelpCapabilities nil (:contextSupport :dynamicRegistration :signatureInformation)) + (SignatureHelpContext (:triggerKind :isRetrigger) (:activeSignatureHelp :triggerCharacter)) + (SignatureHelpOptions nil (:retriggerCharacters :triggerCharacters)) + (SignatureInformation (:label) (:documentation :parameters)) + (SignatureInformationCapabilities nil (:documentationFormat :parameterInformation)) + (StaticRegistrationOptions nil (:documentSelector :id)) + (SymbolCapabilities nil (:dynamicRegistration :symbolKind)) + (SymbolKindCapabilities nil (:valueSet)) + (SynchronizationCapabilities nil (:didSave :dynamicRegistration :willSave :willSaveWaitUntil)) + (TextDocumentClientCapabilities nil (:callHierarchy :codeAction :codeLens :colorProvider :completion :declaration :definition :documentHighlight :documentLink :documentSymbol :foldingRange :formatting :hover :implementation :onTypeFormatting :publishDiagnostics :rangeFormatting :references :rename :selectionRange :semanticHighlightingCapabilities :signatureHelp :synchronization :typeDefinition :typeHierarchyCapabilities)) + (TextDocumentContentChangeEvent (:text) (:range :rangeLength)) + (TextDocumentEdit (:textDocument :edits) nil) + (TextDocumentIdentifier (:uri) nil) + (TextDocumentItem (:languageId :text :uri :version) nil) + (TextDocumentSyncOptions nil (:change :openClose :save :willSave :willSaveWaitUntil)) + (TextEdit (:newText :range) nil) + (InsertReplaceEdit (:newText :insert :replace) nil) + (SnippetTextEdit (:newText :range) (:insertTextFormat)) + (TypeDefinitionCapabilities nil (:dynamicRegistration :linkSupport)) + (TypeHierarchyCapabilities nil (:dynamicRegistration)) + (TypeHierarchyItem (:kind :name :range :selectionRange :uri) (:children :data :deprecated :detail :parents)) + (Unregistration (:method :id) nil) + (VersionedTextDocumentIdentifier (:uri) (:version)) + (WorkspaceClientCapabilities nil (:applyEdit :configuration :didChangeConfiguration :didChangeWatchedFiles :executeCommand :symbol :workspaceEdit :workspaceFolders)) + (WorkspaceEdit nil (:changes :documentChanges :resourceChanges)) + (WorkspaceEditCapabilities nil (:documentChanges :failureHandling :resourceChanges :resourceOperations)) + (WorkspaceFolder (:uri :name) nil) + (WorkspaceFoldersChangeEvent (:removed :added) nil) + (WorkspaceFoldersOptions nil (:changeNotifications :supported)) + (WorkspaceServerCapabilities nil (:workspaceFolders :fileOperations)) + (WorkspaceFileOperations nil (:didCreate :willCreate :didRename :willRename :didDelete :willDelete)) + (ApplyWorkspaceEditParams (:edit) (:label)) + (ApplyWorkspaceEditResponse (:applied) nil) + (CallHierarchyIncomingCall (:from :fromRanges) nil) + (CallHierarchyIncomingCallsParams (:item) nil) + (CallHierarchyOutgoingCall (:to :fromRanges) nil) + (CallHierarchyOutgoingCallsParams (:item) nil) + (CallHierarchyPrepareParams (:textDocument :position) (:uri)) + (CodeAction (:title) (:command :diagnostics :edit :isPreferred :kind :data)) + (CodeActionKind nil nil) + (CodeActionParams (:textDocument :context :range) nil) + (CodeLens (:range) (:command :data)) + (CodeLensParams (:textDocument) nil) + (CodeLensRegistrationOptions nil (:documentSelector :resolveProvider)) + (ColorInformation (:color :range) nil) + (ColorPresentation (:label) (:additionalTextEdits :textEdit)) + (ColorPresentationParams (:color :textDocument :range) nil) + (ColoringParams (:uri :infos) nil) + (ColoringStyle nil nil) + (CompletionList (:items :isIncomplete) nil) + (CompletionParams (:textDocument :position) (:context :uri)) + (CompletionRegistrationOptions nil (:documentSelector :resolveProvider :triggerCharacters)) + (ConfigurationParams (:items) nil) + (CreateFile (:kind :uri) (:options)) + (DeclarationParams (:textDocument :position) (:uri)) + (DefinitionParams (:textDocument :position) (:uri)) + (DeleteFile (:kind :uri) (:options)) + (DidChangeConfigurationParams (:settings) nil) + (DidChangeTextDocumentParams (:contentChanges :textDocument) (:uri)) + (DidChangeWatchedFilesParams (:changes) nil) + (DidChangeWatchedFilesRegistrationOptions (:watchers) nil) + (DidChangeWorkspaceFoldersParams (:event) nil) + (DidCloseTextDocumentParams (:textDocument) nil) + (DidOpenTextDocumentParams (:textDocument) (:text)) + (DidSaveTextDocumentParams (:textDocument) (:text)) + (DocumentColorParams (:textDocument) nil) + (DocumentFormattingParams (:textDocument :options) nil) + (DocumentHighlight (:range) (:kind)) + (DocumentHighlightParams (:textDocument :position) (:uri)) + (DocumentLink (:range) (:data :target :tooltip)) + (DocumentLinkParams (:textDocument) nil) + (DocumentLinkRegistrationOptions nil (:documentSelector :resolveProvider)) + (DocumentOnTypeFormattingParams (:ch :textDocument :options :position) nil) + (DocumentOnTypeFormattingRegistrationOptions (:firstTriggerCharacter) (:documentSelector :moreTriggerCharacter)) + (DocumentRangeFormattingParams (:textDocument :options :range) nil) + (DocumentSymbolParams (:textDocument) nil) + (DynamicRegistrationCapabilities nil (:dynamicRegistration)) + (ExecuteCommandParams (:command) (:arguments)) + (ExecuteCommandRegistrationOptions (:commands) nil) + (FailureHandlingKind nil nil) + (FileRename (:oldUri :newUri) nil) + (FoldingRange (:endLine :startLine) (:endCharacter :kind :startCharacter)) + (FoldingRangeKind nil nil) + (FoldingRangeRequestParams (:textDocument) nil) + (Hover (:contents) (:range)) + (HoverParams (:textDocument :position) (:uri)) + (ImplementationParams (:textDocument :position) (:uri)) + (InitializeError (:retry) nil) + (InitializeErrorCode nil nil) + (InitializeParams nil (:capabilities :clientInfo :clientName :initializationOptions :processId :rootPath :rootUri :trace :workspaceFolders)) + (InitializeResult (:capabilities) (:serverInfo)) + (InitializedParams nil nil) + (LocationLink (:targetSelectionRange :targetUri :targetRange) (:originSelectionRange)) + (MarkupKind nil nil) + (MessageParams (:type :message) nil) + (PrepareRenameParams (:textDocument :position) (:uri)) + (PrepareRenameResult (:range :placeholder) nil) + (PublishDiagnosticsParams (:diagnostics :uri) (:version)) + (QuickPickItem (:label :picked :userData) nil) + (ReferenceParams (:textDocument :context :position) (:uri)) + (RegistrationParams (:registrations) nil) + (RenameFile (:kind :newUri :oldUri) (:options)) + (RenameFilesParams (:files) nil) + (RenameParams (:newName :textDocument :position) (:uri)) + (ResolveTypeHierarchyItemParams (:item :resolve :direction) nil) + (ResourceOperationKind nil nil) + (SelectionRangeParams (:textDocument :positions) nil) + (SemanticHighlightingParams (:textDocument :lines) nil) + (ShowDocumentParams (:uri) (:external :takeFocus :selection)) + (ShowDocumentResult (:success) nil) + (ShowInputBoxParams (:prompt) (:value)) + (ShowMessageRequestParams (:type :message) (:actions)) + (ShowQuickPickParams (:placeHolder :canPickMany :items) nil) + (SignatureHelpParams (:textDocument :position) (:context :uri)) + (SignatureHelpRegistrationOptions nil (:documentSelector :triggerCharacters)) + (SymbolInformation (:kind :name :location) (:containerName :deprecated)) + (TextDocumentChangeRegistrationOptions (:syncKind) (:documentSelector)) + (TextDocumentPositionParams (:textDocument :position) (:uri)) + (TextDocumentRegistrationOptions nil (:documentSelector)) + (TextDocumentSaveRegistrationOptions nil (:documentSelector :includeText)) + (TypeDefinitionParams (:textDocument :position) (:uri)) + (TypeHierarchyParams (:resolve :textDocument :position) (:direction :uri)) + (UnregistrationParams (:unregisterations) nil) + (WatchKind nil nil) + (WillSaveTextDocumentParams (:reason :textDocument) nil) + (WorkspaceSymbolParams (:query) nil) + ;; 3.17 + (InlayHint (:label :position) (:kind :paddingLeft :paddingRight)) + (InlayHintLabelPart (:value) (:tooltip :location :command)) + (InlayHintsParams (:textDocument) (:range))) + +;; 3.17 +(defconst lsp/inlay-hint-kind-type-hint 1) +(defconst lsp/inlay-hint-kind-parameter-hint 2) + + +(provide 'lsp-protocol) + +;;; lsp-protocol.el ends here diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-protocol.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-protocol.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-purescript.el b/emacs/elpa/lsp-mode-20241119.828/lsp-purescript.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-purescript.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-purescript.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-pwsh.el b/emacs/elpa/lsp-mode-20241119.828/lsp-pwsh.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-pwsh.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-pwsh.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-pyls.el b/emacs/elpa/lsp-mode-20241119.828/lsp-pyls.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-pyls.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-pyls.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-pylsp.el b/emacs/elpa/lsp-mode-20241119.828/lsp-pylsp.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-pylsp.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-pylsp.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-qml.el b/emacs/elpa/lsp-mode-20241119.828/lsp-qml.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-qml.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-qml.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-r.el b/emacs/elpa/lsp-mode-20241119.828/lsp-r.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-r.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-r.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-racket.el b/emacs/elpa/lsp-mode-20241119.828/lsp-racket.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-racket.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-racket.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-remark.el b/emacs/elpa/lsp-mode-20241119.828/lsp-remark.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-remark.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-remark.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-rf.el b/emacs/elpa/lsp-mode-20241119.828/lsp-rf.el @@ -0,0 +1,147 @@ +;;; lsp-rf.el --- description -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 emacs-lsp maintainers + +;; Author: emacs-lsp maintainers +;; Keywords: lsp, rf, robot + +;; 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: + +;; LSP Clients for the Robot Framework. + +;;; Code: + +(require 'lsp-mode) + +(defgroup lsp-rf nil + "Settings for Robot Framework Language Server." + :group 'lsp-mode + :link '(url-link "https://github.com/tomi/vscode-rf-language-server")) + +(defcustom lsp-rf-language-server-start-command '("~/.nvm/versions/node/v9.11.2/bin/node" "~/.vscode/extensions/tomiturtiainen.rf-intellisense-2.8.0/server/server.js") + "Path to the server.js file of the rf-intellisense server. +Accepts a list of strings (path/to/interpreter path/to/server.js)" + :type '(list string) + :group 'lsp-rf) + +(defcustom lsp-rf-language-server-include-paths [] + "An array of files that should be included by the parser. +Glob patterns as strings are accepted (eg. *.robot between double quotes)" + :type 'lsp-string-vector + :group 'lsp-rf) + +(defcustom lsp-rf-language-server-exclude-paths [] + "An array of files that should be ignored by the parser. +Glob patterns as strings are accepted (eg. *bad.robot between double quotes)" + :type 'lsp-string-vector + :group 'lsp-rf) + +(defcustom lsp-rf-language-server-dir "~/.vscode/extensions/tomiturtiainen.rf-intellisense-2.8.0/server/library-docs/" + "Libraries directory for libraries in `lsp-rf-language-server-libraries'" + :type 'string + :group 'lsp-rf) + +(defcustom lsp-rf-language-server-libraries ["BuiltIn-3.1.1" "Collections-3.0.4"] + "Libraries whose keywords are suggested with `auto-complete'." + :type '(repeat string) + ;; :type 'lsp-string-vector + :group 'lsp-rf) + +(defcustom lsp-rf-language-server-log-level "debug" + "What language server log messages are printed." + :type 'string + ;; :type '(choice (:tag "off" "errors" "info" "debug")) + :group 'lsp-rf) + +(defcustom lsp-rf-language-server-trace-server "verbose" + "Traces the communication between VSCode and the rfLanguageServer service." + :type 'string + ;; :type '(choice (:tag "off" "messages" "verbose")) + :group 'lsp-rf) + +(defun parse-rf-language-server-library-dirs (dirs) + (vconcat (mapcar + (lambda (x) + (concat + (expand-file-name + lsp-rf-language-server-dir) + x + ".json")) + dirs))) + +(defun expand-start-command () + (mapcar 'expand-file-name lsp-rf-language-server-start-command)) + +(defun parse-rf-language-server-globs-to-regex (vector) + "Convert a VECTOR of globs to a regex." + (--> (mapcan #'lsp-glob-to-regexps vector) + (s-join "\\|" it) + (concat "\\(?:" it "\\)"))) + +(defun parse-rf-language-server-include-path-regex (vector) + "Creates regexp to select files from workspace directory." + (let ((globs (if (eq vector []) + ["*.robot" "*.resource"] + vector))) + (parse-rf-language-server-globs-to-regex globs))) + +(defun parse-rf-language-server-exclude-paths (seq) + "Creates regexp to select files from workspace directory." + (if (eq lsp-rf-language-server-exclude-paths []) + seq + (cl-delete-if (lambda (x) (string-match-p + (parse-rf-language-server-globs-to-regex + lsp-rf-language-server-exclude-paths) + x)) + seq))) + +(lsp-register-custom-settings + '( + ("rfLanguageServer.trace.server" lsp-rf-language-server-trace-server) + ("rfLanguageServer.logLevel" lsp-rf-language-server-log-level) + ("rfLanguageServer.libraries" lsp-rf-language-server-libraries) + ("rfLanguageServer.excludePaths" lsp-rf-language-server-exclude-paths) + ("rfLanguageServer.includePaths" lsp-rf-language-server-include-paths))) + +(lsp-register-client + (make-lsp-client :new-connection (lsp-stdio-connection + (expand-start-command)) + :major-modes '(robot-mode) + :server-id 'rf-intellisense + ;; :library-folders-fn (lambda (_workspace) + ;; lsp-rf-language-server-libraries) + :library-folders-fn (lambda (_workspace) + (parse-rf-language-server-library-dirs + lsp-rf-language-server-libraries)) + :initialized-fn (lambda (workspace) + (with-lsp-workspace workspace + (lsp--set-configuration + (lsp-configuration-section "rfLanguageServer")) + (lsp-request "buildFromFiles" + (list :files + (vconcat + (parse-rf-language-server-exclude-paths + (directory-files-recursively + (lsp--workspace-root workspace) + (parse-rf-language-server-include-path-regex + lsp-rf-language-server-include-paths)))))))))) + + + +(lsp-consistency-check lsp-rf) + +(provide 'lsp-rf) +;;; lsp-rf.el ends here diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-rf.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-rf.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-roslyn.el b/emacs/elpa/lsp-mode-20241119.828/lsp-roslyn.el @@ -0,0 +1,351 @@ +;;; lsp-roslyn.el --- description -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Ruin0x11 + +;; Author: Ruin0x11 <ipickering2@gmail.com> +;; Keywords: + +;; 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: + +;; C# client using the Roslyn language server + +;;; Code: + +(require 'lsp-mode) + +(defgroup lsp-roslyn nil + "LSP support for the C# programming language, using the Roslyn language server." + :link '(url-link "https://github.com/dotnet/roslyn/tree/main/src/LanguageServer") + :group 'lsp-mode + :package-version '(lsp-mode . "8.0.0")) + +(defconst lsp-roslyn--stdpipe-path (expand-file-name + "lsp-roslyn-stdpipe.ps1" + (file-name-directory (locate-library "lsp-roslyn"))) + "Path to the `stdpipe' script. +On Windows, this script is used as a proxy for the language server's named pipe. +Unused on other platforms.") + +(defcustom lsp-roslyn-install-path (expand-file-name "roslyn" lsp-server-install-dir) + "The path to install the Roslyn server to." + :type 'string + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-roslyn) + +(defcustom lsp-roslyn-server-dll-override-path nil + "Custom path to Microsoft.CodeAnalysis.LanguageServer.dll." + :type '(choice (const nil) string) + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-roslyn) + +(defcustom lsp-roslyn-server-timeout-seconds 60 + "Amount of time to wait for Roslyn server startup, in seconds." + :type 'integer + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-roslyn) + +(defcustom lsp-roslyn-server-log-level "Information" + "Log level for the Roslyn language server." + :type '(choice (:tag "None" "Trace" "Debug" "Information" "Warning" "Error" "Critical")) + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-roslyn) + +(defcustom lsp-roslyn-server-log-directory (concat (temporary-file-directory) (file-name-as-directory "lsp-roslyn")) + "Log directory for the Roslyn language server." + :type 'string + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-roslyn) + +(defcustom lsp-roslyn-server-extra-args '() + "Extra arguments for the Roslyn language server." + :type '(repeat string) + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-roslyn) + +(defcustom lsp-roslyn-dotnet-executable "dotnet" + "Dotnet executable to use with the Roslyn language server." + :type 'string + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-roslyn) + +(defcustom lsp-roslyn-package-version "4.13.0-2.24564.12" + "Version of the Roslyn package to install. +Gotten from https://dev.azure.com/azure-public/vside/_artifacts/feed/vs-impl/NuGet/Microsoft.CodeAnalysis.LanguageServer.win-x64" + :type 'string + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-roslyn) + +(defvar lsp-roslyn--pipe-name nil) + +(defun lsp-roslyn--parse-pipe-name (pipe) + (if (eq system-type 'windows-nt) + (progn + (string-match "\\([a-z0-9]+\\)$" pipe) + (match-string 1 pipe)) + pipe)) + +(defun lsp-roslyn--parent-process-filter (_process output) + "Parses the named pipe's name that the Roslyn server process prints on stdout." + (let* ((data (json-parse-string output :object-type 'plist)) + (pipe (plist-get data :pipeName))) + (when pipe + (setq lsp-roslyn--pipe-name (lsp-roslyn--parse-pipe-name pipe))))) + +(defun lsp-roslyn--make-named-pipe-process (filter sentinel environment-fn process-name stderr-buf) + "Creates the process that will handle the JSON-RPC communication." + (let* ((process-environment + (lsp--compute-process-environment environment-fn)) + (default-directory (lsp--default-directory-for-connection))) + (cond + ((eq system-type 'windows-nt) + (make-process + :name process-name + :connection-type 'pipe + :buffer (format "*%s*" process-name) + :coding 'no-conversion + :filter filter + :sentinel sentinel + :stderr stderr-buf + :noquery t + :command (lsp-resolve-final-command + `("PowerShell" "-NoProfile" "-ExecutionPolicy" "Bypass" "-Command" + ,lsp-roslyn--stdpipe-path "." + ,lsp-roslyn--pipe-name)))) + (t (make-network-process + :service "roslyn" + :name process-name + :remote lsp-roslyn--pipe-name + :sentinel sentinel + :filter filter + :noquery t))))) + +(defun lsp-roslyn--connect (filter sentinel name environment-fn _workspace) + "Creates a connection to the Roslyn language server's named pipe. + +First creates an instance of the language server process, then +creates another process connecting to the named pipe it specifies." + (setq lsp-roslyn--pipe-name nil) + (let* ((parent-process-name name) + (parent-stderr-buf (format "*%s::stderr*" parent-process-name)) + (command-process (make-process + :name parent-process-name + :buffer (generate-new-buffer-name parent-process-name) + :coding 'no-conversion + :filter 'lsp-roslyn--parent-process-filter + :sentinel sentinel + :stderr parent-stderr-buf + :command `(,lsp-roslyn-dotnet-executable + ,(lsp-roslyn--get-server-dll-path) + ,(format "--logLevel=%s" lsp-roslyn-server-log-level) + ,(format "--extensionLogDirectory=%s" lsp-roslyn-server-log-directory) + ,@lsp-roslyn-server-extra-args) + :noquery t))) + (accept-process-output command-process lsp-roslyn-server-timeout-seconds) ; wait for JSON with pipe name to print on stdout, like {"pipeName":"\\\\.\\pipe\\d1b72351"} + (when (not lsp-roslyn--pipe-name) + (error "Failed to receieve pipe name from Roslyn server process")) + (let* ((process-name (generate-new-buffer-name (format "%s-pipe" name))) + (stderr-buf (format "*%s::stderr*" process-name)) + (communication-process + (lsp-roslyn--make-named-pipe-process filter sentinel environment-fn process-name stderr-buf))) + (with-current-buffer (get-buffer parent-stderr-buf) + (special-mode)) + (when-let* ((stderr-buffer (get-buffer stderr-buf))) + (with-current-buffer stderr-buffer + ;; Make the *NAME::stderr* buffer buffer-read-only, q to bury, etc. + (special-mode)) + (set-process-query-on-exit-flag (get-buffer-process stderr-buffer) nil)) + (set-process-query-on-exit-flag command-process nil) + (set-process-query-on-exit-flag communication-process nil) + (cons communication-process communication-process)))) + +(defun lsp-roslyn--uri-to-path (uri) + "Convert a URI to a file path, without unhexifying." + (let* ((url (url-generic-parse-url uri)) + (type (url-type url)) + (target (url-target url)) + (file + (concat (decode-coding-string (url-filename url) + (or locale-coding-system 'utf-8)) + (when (and target + (not (s-match + (rx "#" (group (1+ num)) (or "," "#") + (group (1+ num)) + string-end) + uri))) + (concat "#" target)))) + (file-name (if (and type (not (string= type "file"))) + (if-let* ((handler (lsp--get-uri-handler type))) + (funcall handler uri) + uri) + ;; `url-generic-parse-url' is buggy on windows: + ;; https://github.com/emacs-lsp/lsp-mode/pull/265 + (or (and (eq system-type 'windows-nt) + (eq (elt file 0) ?\/) + (substring file 1)) + file)))) + (->> file-name + (concat (-some #'lsp--workspace-host-root (lsp-workspaces))) + (lsp-remap-path-if-needed)))) + +(defun lsp-roslyn--path-to-uri (path) + "Convert PATH to a URI, without hexifying." + (url-unhex-string (lsp--path-to-uri-1 path))) + +(lsp-defun lsp-roslyn--on-project-initialization-complete (workspace _params) + (lsp--info "%s: Project initialized successfully." + (lsp--workspace-print workspace))) + +(defun lsp-roslyn--find-files-in-parent-directories (directory regex &optional result) + "Search DIRECTORY for files matching REGEX and return their full paths if found." + (let* ((parent-dir (file-truename (concat (file-name-directory directory) "../"))) + (found (directory-files directory 't regex)) + (result (append (or result '()) found))) + (if (and (not (string= (file-truename directory) parent-dir)) + (< (length parent-dir) (length (file-truename directory)))) + (lsp-roslyn--find-files-in-parent-directories parent-dir regex result) + result))) + +(defun lsp-roslyn--pick-solution-file-interactively (solution-files) + (completing-read "Solution file for this workspace: " solution-files nil t)) + +(defun lsp-roslyn--find-solution-file () + (let ((solutions (lsp-roslyn--find-files-in-parent-directories + (file-name-directory (buffer-file-name)) + (rx (* any) ".sln" eos)))) + (cond + ((not solutions) nil) + ((eq (length solutions) 1) (cl-first solutions)) + (t (lsp-roslyn--pick-solution-file-interactively solutions))))) + +(defun lsp-roslyn-open-solution-file () + "Chooses the solution file to associate with the Roslyn language server." + (interactive) + (let ((solution-file (lsp-roslyn--find-solution-file))) + (if solution-file + (lsp-notify "solution/open" (list :solution (lsp--path-to-uri solution-file))) + (lsp--error "No solution file was found for this workspace.")))) + +(defun lsp-roslyn--on-initialized (_workspace) + "Handler for Roslyn server initialization." + (lsp-roslyn-open-solution-file)) + +(defun lsp-roslyn--get-package-name () + "Gets the package name of the Roslyn language server." + (format "microsoft.codeanalysis.languageserver.%s" (lsp-roslyn--get-rid))) + +(defun lsp-roslyn--get-server-dll-path () + "Gets the path to the language server DLL. +Assumes it was installed with the server install function." + (if lsp-roslyn-server-dll-override-path + lsp-roslyn-server-dll-override-path + (f-join lsp-roslyn-install-path "out" + (lsp-roslyn--get-package-name) + lsp-roslyn-package-version + "content" "LanguageServer" + (lsp-roslyn--get-rid) + "Microsoft.CodeAnalysis.LanguageServer.dll"))) + +(defun lsp-roslyn--get-rid () + "Retrieves the .NET Runtime Identifier (RID) for the current system." + (let* ((is-x64 (string-match-p "x86_64" system-configuration)) + (is-arm64 (string-match-p "aarch64" system-configuration)) + (is-x86 (and (string-match-p "x86" system-configuration) (not is-x64)))) + (if-let* ((platform-name (cond + ((eq system-type 'gnu/linux) "linux") + ((eq system-type 'darwin) "osx") + ((eq system-type 'windows-nt) "win"))) + (arch-name (cond + (is-x64 "x64") + (is-arm64 "arm64") + (is-x86 "x86")))) + (format "%s-%s" platform-name arch-name) + (error "Unsupported platform: %s (%s)" system-type system-configuration)))) + +;; Adapted from roslyn.nvim's version +(defconst lsp-roslyn--temp-project-nuget-config + "<?xml version=\"1.0\" encoding=\"utf-8\"?> +<configuration> + <packageSources> + <add key=\"vs-impl\" value=\"https://pkgs.dev.azure.com/azure-public/vside/_packaging/vs-impl/nuget/v3/index.json\" /> + </packageSources> +</configuration>" + "The nuget.config to use when downloading Roslyn.") + +;; Adapted from roslyn.nvim's version +(defun lsp-roslyn--temp-project-csproj (pkg-name pkg-version) + "Generates a temporary .csproj to use for downloading the language server." + (format + "<Project Sdk=\"Microsoft.Build.NoTargets/1.0.80\"> + <PropertyGroup> + <!-- Changes the global packages folder --> + <RestorePackagesPath>out</RestorePackagesPath> + <!-- This is not super relevant, as long as your SDK version supports it. --> + <TargetFramework>net7.0</TargetFramework> + <!-- If a package is resolved to a fallback folder, it may not be downloaded --> + <DisableImplicitNuGetFallbackFolder>true</DisableImplicitNuGetFallbackFolder> + <!-- We don't want to build this project, so we do not need the reference assemblies for the framework we chose --> + <AutomaticallyUseReferenceAssemblyPackages>false</AutomaticallyUseReferenceAssemblyPackages> + </PropertyGroup> + <ItemGroup> + <PackageDownload Include=\"%s\" version=\"[%s]\" /> + </ItemGroup> +</Project>" + pkg-name pkg-version)) + +(defun lsp-roslyn--download-server (_client callback error-callback update?) + "Downloads the Roslyn language server to `lsp-roslyn-install-path'. +CALLBACK is called when the download finish successfully otherwise +ERROR-CALLBACK is called. +UPDATE is non-nil if it is already downloaded. +FORCED if specified with prefix argument." + + (let ((pkg-name (lsp-roslyn--get-package-name))) + (when update? + (ignore-errors (delete-directory lsp-roslyn-install-path t))) + (unless (f-exists? lsp-roslyn-install-path) + (mkdir lsp-roslyn-install-path 'create-parent)) + (f-write-text lsp-roslyn--temp-project-nuget-config + 'utf-8 (expand-file-name "nuget.config" lsp-roslyn-install-path)) + (f-write-text (lsp-roslyn--temp-project-csproj pkg-name lsp-roslyn-package-version) + 'utf-8 (expand-file-name "DownloadRoslyn.csproj" lsp-roslyn-install-path)) + (lsp-async-start-process + callback + error-callback + lsp-roslyn-dotnet-executable "restore" "--interactive" lsp-roslyn-install-path + (format "/p:PackageName=%s" pkg-name) + (format "/p:PackageVersion=%s" lsp-roslyn-package-version)))) + +(defun lsp-roslyn--make-connection () + (list :connect (lambda (f s n e w) (lsp-roslyn--connect f s n e w)) + :test? (lambda () (f-exists? (lsp-roslyn--get-server-dll-path))))) + +(lsp-register-client + (make-lsp-client :new-connection (lsp-roslyn--make-connection) + :priority 0 + :server-id 'csharp-roslyn + :activation-fn (lsp-activate-on "csharp") + :notification-handlers (ht ("workspace/projectInitializationComplete" 'lsp-roslyn--on-project-initialization-complete)) + + ;; These two functions are the same as lsp-mode's except they do not + ;; (un)hexify URIs. + :path->uri-fn 'lsp-roslyn--path-to-uri + :uri->path-fn 'lsp-roslyn--uri-to-path + + :initialized-fn #'lsp-roslyn--on-initialized + :download-server-fn #'lsp-roslyn--download-server)) + +(provide 'lsp-roslyn) +;;; lsp-roslyn.el ends here diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-roslyn.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-roslyn.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-rpm-spec.el b/emacs/elpa/lsp-mode-20241119.828/lsp-rpm-spec.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-rpm-spec.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-rpm-spec.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-rubocop.el b/emacs/elpa/lsp-mode-20241119.828/lsp-rubocop.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-rubocop.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-rubocop.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-ruby-lsp.el b/emacs/elpa/lsp-mode-20241119.828/lsp-ruby-lsp.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-ruby-lsp.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-ruby-lsp.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-ruby-syntax-tree.el b/emacs/elpa/lsp-mode-20241119.828/lsp-ruby-syntax-tree.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-ruby-syntax-tree.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-ruby-syntax-tree.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-ruff.el b/emacs/elpa/lsp-mode-20241119.828/lsp-ruff.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-ruff.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-ruff.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-rust.el b/emacs/elpa/lsp-mode-20241119.828/lsp-rust.el @@ -0,0 +1,1816 @@ +;;; lsp-rust.el --- Rust Client settings -*- lexical-binding: t; -*- + +;; Copyright (C) 2019 Ivan Yonchovski + +;; Author: Ivan Yonchovski <yyoncho@gmail.com> +;; Keywords: + +;; 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: + +;; lsp-rust client + +;;; Code: + +(require 'lsp-mode) +(require 'ht) +(require 'dash) +(require 'lsp-semantic-tokens) +(require 's) + +(defgroup lsp-rust nil + "LSP support for Rust, using Rust Language Server or rust-analyzer." + :group 'lsp-mode + :link '(url-link "https://github.com/rust-lang/rls") + :package-version '(lsp-mode . "6.1")) + +(defgroup lsp-rust-rls nil + "LSP support for Rust, using Rust Language Server." + :group 'lsp-mode + :link '(url-link "https://github.com/rust-lang/rls") + :package-version '(lsp-mode . "8.0.0")) + +(defgroup lsp-rust-analyzer nil + "LSP support for Rust, using rust-analyzer." + :group 'lsp-mode + :link '(url-link "https://github.com/rust-lang/rust-analyzer") + :package-version '(lsp-mode . "8.0.0")) + +(defgroup lsp-rust-analyzer-semantic-tokens nil + "LSP semantic tokens support for rust-analyzer." + :group 'lsp-rust-analyzer + :link '(url-link "https://github.com/rust-lang/rust-analyzer") + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-server 'rust-analyzer + "Choose LSP server." + :type '(choice (const :tag "rls" rls) + (const :tag "rust-analyzer" rust-analyzer)) + :group 'lsp-rust + :package-version '(lsp-mode . "6.2")) + +;; RLS + +(defcustom lsp-rust-rls-server-command '("rls") + "Command to start RLS." + :type '(repeat string) + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-library-directories + '("~/.cargo/registry/src" "~/.rustup/toolchains") + "List of directories which will be considered to be libraries." + :risky t + :type '(repeat string) + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-sysroot nil + "If non-nil, use the given path as the sysroot for all rustc invocations +instead of trying to detect the sysroot automatically." + :type '(choice + (const :tag "None" nil) + (string :tag "Sysroot")) + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-target nil + "If non-nil, use the given target triple for all rustc invocations." + :type '(choice + (const :tag "None" nil) + (string :tag "Target")) + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-rustflags nil + "Flags added to RUSTFLAGS." + :type '(choice + (const :tag "None" nil) + (string :tag "Flags")) + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-clear-env-rust-log t + "Clear the RUST_LOG environment variable before running rustc or cargo." + :type 'boolean + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-build-lib nil + "If non-nil, checks the project as if you passed the `--lib' argument to +cargo. + +Mutually exclusive with, and preferred over, `lsp-rust-build-bin'. (Unstable)" + :type 'boolean + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-build-bin nil + "If non-nil, checks the project as if you passed `-- bin <build_bin>' +argument to cargo. + +Mutually exclusive with `lsp-rust-build-lib'. (Unstable)" + :type '(choice + (const :tag "None" nil) + (string :tag "Binary")) + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-cfg-test nil + "If non-nil, checks the project as if you were running `cargo test' rather +than cargo build. + +I.e., compiles (but does not run) test code." + :type 'boolean + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-unstable-features nil + "Enable unstable features." + :type 'boolean + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-wait-to-build nil + "Time in milliseconds between receiving a change notification +and starting build. If not specified, automatically inferred by +the latest build duration." + :type '(choice + (const :tag "Auto" nil) + (number :tag "Time")) + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-show-warnings t + "Show warnings." + :type 'boolean + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-crate-blocklist [ + "cocoa" + "gleam" + "glium" + "idna" + "libc" + "openssl" + "rustc_serialize" + "serde" + "serde_json" + "typenum" + "unicode_normalization" + "unicode_segmentation" + "winapi" + ] + "A list of Cargo crates to blocklist." + :type 'lsp-string-vector + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-build-on-save nil + "Only index the project when a file is saved and not on change." + :type 'boolean + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-features [] + "List of features to activate. +Corresponds to the `rust-analyzer` setting `rust-analyzer.cargo.features`. +Set this to `\"all\"` to pass `--all-features` to cargo." + :type 'lsp-string-vector + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-all-features nil + "Enable all Cargo features." + :type 'boolean + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-no-default-features nil + "Do not enable default Cargo features." + :type 'boolean + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-racer-completion t + "Enables code completion using racer." + :type 'boolean + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-clippy-preference "opt-in" + "Controls eagerness of clippy diagnostics when available. +Valid values are (case-insensitive): + - \"off\": Disable clippy lints. + - \"opt-in\": Clippy lints are shown when crates specify `#![warn(clippy)]'. + - \"on\": Clippy lints enabled for all crates in workspace. + +You need to install clippy via rustup if you haven't already." + :type '(choice + (const "on") + (const "opt-in") + (const "off")) + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-jobs nil + "Number of Cargo jobs to be run in parallel." + :type '(choice + (const :tag "Auto" nil) + (number :tag "Jobs")) + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-all-targets t + "Checks the project as if you were running cargo check --all-targets. +I.e., check all targets and integration tests too." + :type 'boolean + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-target-dir nil + "When specified, it places the generated analysis files at the +specified target directory. By default it is placed target/rls +directory." + :type '(choice + (const :tag "Default" nil) + (string :tag "Directory")) + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-rustfmt-path nil + "When specified, RLS will use the Rustfmt pointed at the path +instead of the bundled one" + :type '(choice + (const :tag "Bundled" nil) + (string :tag "Path")) + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-build-command nil + "EXPERIMENTAL (requires `rust.unstable_features') +If set, executes a given program responsible for rebuilding save-analysis to be +loaded by the RLS. The program given should output a list of resulting .json +files on stdout. + +Implies `rust.build_on_save': true." + :type '(choice + (const :tag "None" nil) + (string :tag "Command")) + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-full-docs nil + "Instructs cargo to enable full documentation extraction during +save-analysis while building the crate." + :type 'boolean + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-rust-show-hover-context t + "Show additional context in hover tooltips when available. This +is often the type local variable declaration." + :type 'boolean + :group 'lsp-rust-rls + :package-version '(lsp-mode . "6.1")) + +(lsp-register-custom-settings + '(("rust.show_hover_context" lsp-rust-show-hover-context t) + ("rust.full_docs" lsp-rust-full-docs t) + ("rust.build_command" lsp-rust-build-command) + ("rust.rustfmt_path" lsp-rust-rustfmt-path) + ("rust.target_dir" lsp-rust-target-dir) + ("rust.all_targets" lsp-rust-all-targets t) + ("rust.jobs" lsp-rust-jobs) + ("rust.clippy_preference" lsp-rust-clippy-preference) + ("rust.racer_completion" lsp-rust-racer-completion t) + ("rust.no_default_features" lsp-rust-no-default-features t) + ("rust.all_features" lsp-rust-all-features t) + ("rust.features" lsp-rust-features) + ("rust.build_on_save" lsp-rust-build-on-save t) + ("rust.crate_blocklist" lsp-rust-crate-blocklist) + ("rust.show_warnings" lsp-rust-show-warnings t) + ("rust.wait_to_build" lsp-rust-wait-to-build) + ("rust.unstable_features" lsp-rust-unstable-features t) + ("rust.cfg_test" lsp-rust-cfg-test t) + ("rust.build_bin" lsp-rust-build-bin) + ("rust.build_lib" lsp-rust-build-lib t) + ("rust.clear_env_rust_log" lsp-rust-clear-env-rust-log t) + ("rust.rustflags" lsp-rust-rustflags) + ("rust.target" lsp-rust-target) + ("rust.sysroot" lsp-rust-sysroot))) + +(defun lsp-clients--rust-window-progress (workspace params) + "Progress report handling. +PARAMS progress report notification data." + (-let [(&v1:ProgressParams :done? :message? :title) params] + (if (or done? (s-blank-str? message?)) + (lsp-workspace-status nil workspace) + (lsp-workspace-status (format "%s - %s" title (or message? "")) workspace)))) + +(lsp-defun lsp-rust--rls-run ((&Command :arguments? params)) + (-let* (((&rls:Cmd :env :binary :args :cwd) (lsp-seq-first params)) + (default-directory (or cwd (lsp-workspace-root) default-directory) )) + (compile + (format "%s %s %s" + (s-join " " (ht-amap (format "%s=%s" key value) env)) + binary + (s-join " " args))))) + +(lsp-register-client + (make-lsp-client :new-connection (lsp-stdio-connection (lambda () lsp-rust-rls-server-command)) + :activation-fn (lsp-activate-on "rust") + :priority (if (eq lsp-rust-server 'rls) 1 -1) + :initialization-options '((omitInitBuild . t) + (cmdRun . t)) + :notification-handlers (ht ("window/progress" 'lsp-clients--rust-window-progress)) + :action-handlers (ht ("rls.run" 'lsp-rust--rls-run)) + :library-folders-fn (lambda (_workspace) lsp-rust-library-directories) + :initialized-fn (lambda (workspace) + (with-lsp-workspace workspace + (lsp--set-configuration + (lsp-configuration-section "rust")))) + :server-id 'rls)) + + +;; rust-analyzer +(defcustom lsp-rust-analyzer-server-command '("rust-analyzer") + "Command to start rust-analyzer." + :type '(repeat string) + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-rust-analyzer-library-directories + '("~/.cargo/registry/src" "~/.rustup/toolchains") + "List of directories which will be considered to be libraries." + :risky t + :type '(repeat string) + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-server-format-inlay-hints t + "Whether to ask rust-analyzer to format inlay hints itself. If +active, the various inlay format settings are not used." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-hide-closure-initialization nil + "Whether to hide inlay type hints for `let` statements that initialize +to a closure. Only applies to closures with blocks, same as +`#rust-analyzer.inlayHints.closureReturnTypeHints.enable#`." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-highlight-breakpoints t + "Enables highlighting of related references while the cursor is on +`break`, `loop`, `while`, or `for` keywords." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-highlight-closure-captures t + "Enables highlighting of all captures of a closure while the +cursor is on the `|` or move keyword of a closure." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-highlight-exit-points t + "Enables highlighting of all exit points while the cursor is on +any `return`, `?`, `fn`, or return type arrow (`->`)." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-highlight-references t + "Enables highlighting of related references while the cursor is on +any identifier." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-highlight-yield-points t + "Enables highlighting of all break points for a loop or block +context while the cursor is on any `async` or `await` keywords." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-closure-return-type-hints "never" + "Whether to show inlay type hints for return types of closures." + :type '(choice + (const "never") + (const "always") + (const "with_block")) + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-discriminants-hints "never" + "Whether to show enum variant discriminant hints." + :type '(choice + (const "never") + (const "always") + (const "fieldless")) + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-expression-adjustment-hints "never" + "Whether to show inlay hints for type adjustments.." + :type '(choice + (const "never") + (const "always") + (const "reborrow")) + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-expression-adjustment-hints-mode "prefix" + "Whether to show inlay hints as postfix ops (`.*` instead of `*`, etc)." + :type '(choice + (const "prefix") + (const "postfix") + (const "prefer_prefix") + (const "prefer_postfix")) + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-expression-adjustment-hide-unsafe nil + "Whether to hide inlay hints for type adjustments outside of +`unsafe` blocks." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-implicit-drops nil + "Whether to show implicit drop hints." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + + +(defcustom lsp-rust-analyzer-closure-capture-hints nil + "Whether to show inlay hints for closure captures." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-closure-style "impl_fn" + "Closure notation in type and chaining inlay hints." + :type 'string + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-hide-named-constructor nil + "Whether to hide inlay type hints for constructors." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-max-inlay-hint-length nil + "Max inlay hint length." + :type 'integer + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.2.2")) + +(defcustom lsp-rust-analyzer-display-chaining-hints nil + "Whether to show inlay type hints for method chains. These +hints will be formatted with the type hint formatting options, if +the mode is not configured to ask the server to format them." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.2.2")) + +(defcustom lsp-rust-analyzer-display-lifetime-elision-hints-enable "never" + "Whether to show elided lifetime inlay hints." + :type '(choice + (const "never") + (const "always") + (const "skip_trivial")) + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-display-lifetime-elision-hints-use-parameter-names nil + "When showing elided lifetime inlay hints, whether to use +parameter names or numeric placeholder names for the lifetimes." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-display-closure-return-type-hints nil + "Whether to show closure return type inlay hints for closures +with block bodies." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-display-parameter-hints nil + "Whether to show function parameter name inlay hints at the call site." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.2.2")) + +(defcustom lsp-rust-analyzer-display-reborrow-hints "never" + "Whether to show inlay type hints for compiler inserted reborrows." + :type '(choice + (const "always") + (const "never") + (const "mutable")) + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-binding-mode-hints nil + "Whether to show inlay type hints for binding modes." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-closing-brace-hints t + "Whether to show inlay hints after a closing `}` to indicate what item it +belongs to." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-closing-brace-hints-min-lines 25 + "Minimum number of lines required before the `}` until the hint is shown +\(set to 0 or 1 to always show them)." + :type 'integer + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-lru-capacity nil + "Number of syntax trees rust-analyzer keeps in memory." + :type 'integer + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.2.2")) + +(defcustom lsp-rust-analyzer-cargo-target nil + "Compilation target (target triple)." + :type '(choice + (string :tag "Target") + (const :tag "None" nil)) + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-cargo-watch-enable t + "Enable Cargo watch." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.2.2")) + +(defcustom lsp-rust-analyzer-cargo-watch-command "check" + "Cargo watch command." + :type 'string + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.2.2")) + +(defcustom lsp-rust-analyzer-cargo-watch-args [] + "Extra arguments for `cargo check`." + :type 'lsp-string-vector + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.2.2")) + +(defcustom lsp-rust-analyzer-cargo-override-command [] + "Advanced option, fully override the command rust-analyzer uses for checking. +The command should include `--message=format=json` or similar option." + :type 'lsp-string-vector + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.2.2")) + +(defcustom lsp-rust-analyzer-check-all-targets t + "Enables --all-targets for `cargo check`." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.2")) + +(defcustom lsp-rust-analyzer-checkonsave-features nil + "List of features to activate. +Corresponds to the `rust-analyzer` setting `rust-analyzer.check.features`. +When set to `nil` (default), the value of `lsp-rust-features' is inherited. +Set this to `\"all\"` to pass `--all-features` to cargo. +Note: setting this to `nil` means \"unset\", whereas setting this +to `[]` (empty vector) means \"set to empty list of features\", +which overrides any value that would otherwise be inherited from +`lsp-rust-features'." + :type 'lsp-string-vector + :group 'lsp-rust-rust-analyzer + :package-version '(lsp-mode . "8.0.2")) + +(defcustom lsp-rust-analyzer-cargo-unset-test [] + "force rust-analyzer to unset `#[cfg(test)]` for the specified crates." + :type 'lsp-string-vector + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-cfg-set-test t + "force rust-analyzer to set `#[cfg(test)]` for the current crate / workspace." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-use-client-watching t + "Use client watching" + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.2.2")) + +(defcustom lsp-rust-analyzer-exclude-globs [] + "Exclude globs" + :type 'lsp-string-vector + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.2.2")) + +(defcustom lsp-rust-analyzer-exclude-dirs [] + "These directories will be ignored by rust-analyzer." + :type 'lsp-string-vector + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-macro-expansion-method 'lsp-rust-analyzer-macro-expansion-default + "Use a different function if you want formatted macro expansion results and +syntax highlighting." + :type 'function + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.2.2")) + +(defcustom lsp-rust-analyzer-diagnostics-enable t + "Whether to show native rust-analyzer diagnostics." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.3.2")) + +(defcustom lsp-rust-analyzer-diagnostics-enable-experimental nil + "Whether to show native rust-analyzer diagnostics that are still experimental +\(might have more false positives than usual)." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-diagnostics-disabled [] + "List of native rust-analyzer diagnostics to disable." + :type 'lsp-string-vector + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-diagnostics-warnings-as-hint [] + "List of warnings that should be displayed with hint severity." + :type 'lsp-string-vector + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-diagnostics-warnings-as-info [] + "List of warnings that should be displayed with info severity." + :type 'lsp-string-vector + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(define-obsolete-variable-alias + 'lsp-rust-analyzer-cargo-load-out-dirs-from-check + 'lsp-rust-analyzer-cargo-run-build-scripts + "8.0.0") + +(defcustom lsp-rust-analyzer-cargo-run-build-scripts t + "Whether to run build scripts (`build.rs`) for more precise code analysis." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-rustfmt-extra-args [] + "Additional arguments to rustfmt." + :type 'lsp-string-vector + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.3.2")) + +(defcustom lsp-rust-analyzer-rustfmt-override-command [] + "Advanced option, fully override the command rust-analyzer uses +for formatting." + :type 'lsp-string-vector + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.3.2")) + +(defcustom lsp-rust-analyzer-rustfmt-rangeformatting-enable nil + "Enables the use of rustfmt's unstable range formatting command for the +`textDocument/rangeFormatting` request. The rustfmt option is unstable and only +available on a nightly build." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-completion-add-call-parenthesis t + "Whether to add parenthesis when completing functions." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.3.2")) + +(defcustom lsp-rust-analyzer-completion-add-call-argument-snippets t + "Whether to add argument snippets when completing functions." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.3.2")) + +(defcustom lsp-rust-analyzer-completion-postfix-enable t + "Whether to show postfix snippets like `dbg`, `if`, `not`, etc." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.3.2")) + +(defcustom lsp-rust-analyzer-call-info-full t + "Whether to show function name and docs in parameter hints." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.3.2")) + +(defcustom lsp-rust-analyzer-proc-macro-enable t + "Enable Proc macro support. +Implies `lsp-rust-analyzer-cargo-run-build-scripts'" + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "6.3.2")) + +(defcustom lsp-rust-analyzer-import-prefix "plain" + "The path structure for newly inserted paths to use. +Valid values are: + - \"plain\": Insert import paths relative to the current module, using up to +one `super' prefix if the parent module contains the requested item. + - \"by_self\": Prefix all import paths with `self' if they don't begin with +`self', `super', `crate' or a crate name. + - \"by_crate\": Force import paths to be absolute by always starting +them with `crate' or the crate name they refer to." + :type '(choice + (const "plain") + (const "by_self") + (const "by_crate")) + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-import-granularity "crate" + "How imports should be grouped into use statements." + :type '(choice + (const "crate" :doc "Merge imports from the same crate into a single use statement. This kind of nesting is only supported in Rust versions later than 1.24.") + (const "module" :doc "Merge imports from the same module into a single use statement.") + (const "item" :doc "Don’t merge imports at all, creating one import per item.") + (const "preserve" :doc "Do not change the granularity of any imports. For auto-import this has the same effect as `\"item\"'")) + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-cargo-auto-reload t + "Automatically refresh project info via `cargo metadata' on `Cargo.toml' changes." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-use-rustc-wrapper-for-build-scripts t + "Use `RUSTC_WRAPPER=rust-analyzer' when running build scripts to avoid +compiling unnecessary things." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-completion-auto-import-enable t + "Toggles the additional completions that automatically add imports when +completed. `lsp-completion-enable-additional-text-edit' must be non-nil + for this feature to be fully enabled." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-completion-auto-self-enable t + "Toggles the additional completions that automatically show method calls +and field accesses with self prefixed to them when inside a method." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-import-enforce-granularity nil + "Whether to enforce the import granularity setting for all files. + If set to nil rust-analyzer will try to keep import styles consistent per file." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-imports-merge-glob t + "Whether to allow import insertion to merge new imports into single path +glob imports like `use std::fmt::*;`." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-import-group t + "Group inserted imports by the following order: +https://rust-analyzer.github.io/manual.html#auto-import. + Groups are separated by newlines." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-highlighting-strings t + "Use semantic tokens for strings." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-rustc-source nil + "Path to the Cargo.toml of the rust compiler workspace." + :type '(choice + (file :tag "Path") + (const :tag "None" nil)) + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-linked-projects [] + "Disable project auto-discovery in favor of explicitly specified set of +projects. Elements must be paths pointing to `Cargo.toml`, `rust-project.json`, +or JSON objects in `rust-project.json` format." + :type 'lsp-string-vector + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-experimental-proc-attr-macros t + "Whether to enable experimental support for expanding proc macro attributes." + :type 'boolean + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-cargo-extra-args [] + "Extra arguments that are passed to every cargo invocation." + :type 'lsp-string-vector + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-cargo-extra-env [] + "Extra environment variables that will be set when running cargo, rustc or +other commands within the workspace. Useful for setting RUSTFLAGS." + :type 'lsp-string-vector + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "9.0.0")) + +(defconst lsp-rust-notification-handlers + '(("rust-analyzer/publishDecorations" . (lambda (_w _p))))) + +(defconst lsp-rust-action-handlers + '()) + +(define-derived-mode lsp-rust-analyzer-syntax-tree-mode special-mode "Rust-Analyzer-Syntax-Tree" + "Mode for the rust-analyzer syntax tree buffer.") + +(defun lsp-rust-analyzer-syntax-tree () + "Display syntax tree for current buffer." + (interactive) + (-let* ((root (lsp-workspace-root default-directory)) + (params (lsp-make-rust-analyzer-syntax-tree-params + :text-document (lsp--text-document-identifier) + :range? (if (use-region-p) + (lsp--region-to-range (region-beginning) (region-end)) + (lsp--region-to-range (point-min) (point-max))))) + (results (lsp-send-request (lsp-make-request + "rust-analyzer/syntaxTree" + params)))) + (let ((buf (get-buffer-create (format "*rust-analyzer syntax tree %s*" root))) + (inhibit-read-only t)) + (with-current-buffer buf + (lsp-rust-analyzer-syntax-tree-mode) + (erase-buffer) + (insert results) + (goto-char (point-min))) + (pop-to-buffer buf)))) + +(define-derived-mode lsp-rust-analyzer-status-mode special-mode "Rust-Analyzer-Status" + "Mode for the rust-analyzer status buffer.") + +(defun lsp-rust-analyzer-status () + "Displays status information for rust-analyzer." + (interactive) + (-let* ((root (lsp-workspace-root default-directory)) + (params (lsp-make-rust-analyzer-analyzer-status-params + :text-document (lsp--text-document-identifier))) + (results (lsp-send-request (lsp-make-request + "rust-analyzer/analyzerStatus" + params)))) + (let ((buf (get-buffer-create (format "*rust-analyzer status %s*" root))) + (inhibit-read-only t)) + (with-current-buffer buf + (lsp-rust-analyzer-status-mode) + (erase-buffer) + (insert results) + (pop-to-buffer buf))))) + +(defun lsp-rust-analyzer-view-item-tree () + "Show item tree of rust file." + (interactive) + (-let* ((params (lsp-make-rust-analyzer-view-item-tree + :text-document (lsp--text-document-identifier))) + (results (lsp-send-request (lsp-make-request + "rust-analyzer/viewItemTree" + params)))) + (let ((buf (get-buffer-create "*rust-analyzer item tree*")) + (inhibit-read-only t)) + (with-current-buffer buf + (special-mode) + (erase-buffer) + (insert (lsp--render-string results "rust")) + (pop-to-buffer buf))))) + +(defun lsp-rust-analyzer-view-hir () + "View Hir of function at point." + (interactive) + (-let* ((params (lsp-make-rust-analyzer-expand-macro-params + :text-document (lsp--text-document-identifier) + :position (lsp--cur-position))) + (results (lsp-send-request (lsp-make-request + "rust-analyzer/viewHir" + params)))) + (let ((buf (get-buffer-create "*rust-analyzer hir*")) + (inhibit-read-only t)) + (with-current-buffer buf + (special-mode) + (erase-buffer) + (insert results) + (pop-to-buffer buf))))) + +(defun lsp-rust-analyzer-join-lines () + "Join selected lines into one, smartly fixing up whitespace and trailing commas." + (interactive) + (let* ((params (lsp-make-rust-analyzer-join-lines-params + :text-document (lsp--text-document-identifier) + :ranges (vector (if (use-region-p) + (lsp--region-to-range (region-beginning) (region-end)) + (lsp--region-to-range (point) (point)))))) + (result (lsp-send-request (lsp-make-request "experimental/joinLines" params)))) + (lsp--apply-text-edits result 'code-action))) + +(defun lsp-rust-analyzer-reload-workspace () + "Reload workspace, picking up changes from Cargo.toml" + (interactive) + (lsp--cur-workspace-check) + (lsp-send-request (lsp-make-request "rust-analyzer/reloadWorkspace"))) + +(defcustom lsp-rust-analyzer-download-url + (let* ((x86 (string-prefix-p "x86_64" system-configuration)) + (arch (if x86 "x86_64" "aarch64"))) + (format "https://github.com/rust-lang/rust-analyzer/releases/latest/download/%s" + (pcase system-type + ('gnu/linux (format "rust-analyzer-%s-unknown-linux-gnu.gz" arch)) + ('darwin (format "rust-analyzer-%s-apple-darwin.gz" arch)) + ('windows-nt (format "rust-analyzer-%s-pc-windows-msvc.zip" arch))))) + "Automatic download url for Rust Analyzer" + :type 'string + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-rust-analyzer-store-path (f-join lsp-server-install-dir "rust" + (pcase system-type + ('windows-nt "rust-analyzer.exe") + (_ "rust-analyzer"))) + "The path to the file in which `rust-analyzer' will be stored." + :type 'file + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +(lsp-dependency + 'rust-analyzer + `(:download :url lsp-rust-analyzer-download-url + :decompress ,(pcase system-type ('windows-nt :zip) (_ :gzip)) + :store-path lsp-rust-analyzer-store-path + :set-executable? t) + `(:system ,(file-name-nondirectory lsp-rust-analyzer-store-path))) + +(lsp-defun lsp-rust--analyzer-run-single ((&Command :arguments?)) + (lsp-rust-analyzer-run (lsp-seq-first arguments?))) + +(lsp-defun lsp-rust--analyzer-show-references + ((&Command :title :arguments? [_uri _filepos references])) + (lsp-show-xrefs (lsp--locations-to-xref-items references) nil + (s-contains-p "reference" title))) + +(declare-function dap-debug "ext:dap-mode" (template) t) + +(lsp-defun lsp-rust--analyzer-debug-lens ((&Command :arguments? [args])) + (lsp-rust-analyzer-debug args)) + +;; Semantic tokens + +;; Modifier faces +(defface lsp-rust-analyzer-documentation-modifier-face + '((t nil)) + "The face modification to use for documentation items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-declaration-modifier-face + '((t nil)) + "The face modification to use for declaration items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-definition-modifier-face + '((t nil)) + "The face modification to use for definition items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-static-modifier-face + '((t nil)) + "The face modification to use for static items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-abstract-modifier-face + '((t nil)) + "The face modification to use for abstract items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-deprecated-modifier-face + '((t nil)) + "The face modification to use for deprecated items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-readonly-modifier-face + '((t nil)) + "The face modification to use for readonly items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-default-library-modifier-face + '((t nil)) + "The face modification to use for default-library items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-async-modifier-face + '((t nil)) + "The face modification to use for async items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-attribute-modifier-face + '((t nil)) + "The face modification to use for attribute items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-callable-modifier-face + '((t nil)) + "The face modification to use for callable items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-constant-modifier-face + '((t nil)) + "The face modification to use for constant items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-consuming-modifier-face + '((t nil)) + "The face modification to use for consuming items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-control-flow-modifier-face + '((t nil)) + "The face modification to use for control-flow items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-crate-root-modifier-face + '((t nil)) + "The face modification to use for crate-root items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-injected-modifier-face + '((t nil)) + "The face modification to use for injected items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-intra-doc-link-modifier-face + '((t nil)) + "The face modification to use for intra-doc-link items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-library-modifier-face + '((t nil)) + "The face modification to use for library items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-mutable-modifier-face + '((t :underline t)) + "The face modification to use for mutable items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-public-modifier-face + '((t nil)) + "The face modification to use for public items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-reference-modifier-face + '((t :bold t)) + "The face modification to use for reference items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-trait-modifier-face + '((t nil)) + "The face modification to use for trait items." + :group 'lsp-rust-analyzer-semantic-tokens) + +(defface lsp-rust-analyzer-unsafe-modifier-face + '((t nil)) + "The face modification to use for unsafe items." + :group 'lsp-rust-analyzer-semantic-tokens) + + +;; --------------------------------------------------------------------- +;; Semantic token modifier face customization + +(defcustom lsp-rust-analyzer-documentation-modifier 'lsp-rust-analyzer-documentation-modifier-face + "Face for semantic token modifier for `documentation' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-declaration-modifier 'lsp-rust-analyzer-declaration-modifier-face + "Face for semantic token modifier for `declaration' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-definition-modifier 'lsp-rust-analyzer-definition-modifier-face + "Face for semantic token modifier for `definition' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-static-modifier 'lsp-rust-analyzer-static-modifier-face + "Face for semantic token modifier for `static' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-abstract-modifier 'lsp-rust-analyzer-abstract-modifier-face + "Face for semantic token modifier for `abstract' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-deprecated-modifier 'lsp-rust-analyzer-deprecated-modifier-face + "Face for semantic token modifier for `deprecated' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-readonly-modifier 'lsp-rust-analyzer-readonly-modifier-face + "Face for semantic token modifier for `readonly' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-default-library-modifier 'lsp-rust-analyzer-default-library-modifier-face + "Face for semantic token modifier for `default' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-async-modifier 'lsp-rust-analyzer-async-modifier-face + "Face for semantic token modifier for `async' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-attribute-modifier 'lsp-rust-analyzer-attribute-modifier-face + "Face for semantic token modifier for `attribute' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-callable-modifier 'lsp-rust-analyzer-callable-modifier-face + "Face for semantic token modifier for `callable' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-constant-modifier 'lsp-rust-analyzer-constant-modifier-face + "Face for semantic token modifier for `constant' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-consuming-modifier 'lsp-rust-analyzer-consuming-modifier-face + "Face for semantic token modifier for `consuming' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-control-flow-modifier 'lsp-rust-analyzer-control-flow-modifier-face + "Face for semantic token modifier for `control_flow' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-crate-root-modifier 'lsp-rust-analyzer-crate-root-modifier-face + "Face for semantic token modifier for `crate_root' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-injected-modifier 'lsp-rust-analyzer-injected-modifier-face + "Face for semantic token modifier for `injected' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-intra-doc-link-modifier 'lsp-rust-analyzer-intra-doc-link-modifier-face + "Face for semantic token modifier for `intra_doc_link' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-library-modifier 'lsp-rust-analyzer-library-modifier-face + "Face for semantic token modifier for `library' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-mutable-modifier 'lsp-rust-analyzer-mutable-modifier-face + "Face for semantic token modifier for `mutable' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-public-modifier 'lsp-rust-analyzer-public-modifier-face + "Face for semantic token modifier for `public' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-reference-modifier 'lsp-rust-analyzer-reference-modifier-face + "Face for semantic token modifier for `reference' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-trait-modifier 'lsp-rust-analyzer-trait-modifier-face + "Face for semantic token modifier for `trait' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-unsafe-modifier 'lsp-rust-analyzer-unsafe-modifier-face + "Face for semantic token modifier for `unsafe' attribute." + :type 'face + :group 'lsp-rust-analyzer-semantic-tokens + :package-version '(lsp-mode . "9.0.0")) + +;; --------------------------------------------------------------------- + +(defun lsp-rust-analyzer--semantic-modifiers () + "Mapping between rust-analyzer keywords and fonts to apply. +The keywords are sent in the initialize response, in the semantic +tokens legend." + `(("documentation" . ,lsp-rust-analyzer-documentation-modifier) + ("declaration" . ,lsp-rust-analyzer-declaration-modifier) + ("definition" . ,lsp-rust-analyzer-definition-modifier) + ("static" . ,lsp-rust-analyzer-static-modifier) + ("abstract" . ,lsp-rust-analyzer-abstract-modifier) + ("deprecated" . ,lsp-rust-analyzer-deprecated-modifier) + ("readonly" . ,lsp-rust-analyzer-readonly-modifier) + ("default_library" . ,lsp-rust-analyzer-default-library-modifier) + ("async" . ,lsp-rust-analyzer-async-modifier) + ("attribute" . ,lsp-rust-analyzer-attribute-modifier) + ("callable" . ,lsp-rust-analyzer-callable-modifier) + ("constant" . ,lsp-rust-analyzer-constant-modifier) + ("consuming" . ,lsp-rust-analyzer-consuming-modifier) + ("control_flow" . ,lsp-rust-analyzer-control-flow-modifier) + ("crate_root" . ,lsp-rust-analyzer-crate-root-modifier) + ("injected" . ,lsp-rust-analyzer-injected-modifier) + ("intra_doc_link" . ,lsp-rust-analyzer-intra-doc-link-modifier) + ("library" . ,lsp-rust-analyzer-library-modifier) + ("mutable" . ,lsp-rust-analyzer-mutable-modifier) + ("public" . ,lsp-rust-analyzer-public-modifier) + ("reference" . ,lsp-rust-analyzer-reference-modifier) + ("trait" . ,lsp-rust-analyzer-trait-modifier) + ("unsafe" . ,lsp-rust-analyzer-unsafe-modifier))) + +(defun lsp-rust-switch-server (&optional lsp-server) + "Switch priorities of lsp servers, unless LSP-SERVER is already active." + (interactive) + (let ((current-server (if (> (lsp--client-priority (gethash 'rls lsp-clients)) 0) + 'rls + 'rust-analyzer))) + (unless (eq lsp-server current-server) + (dolist (server '(rls rust-analyzer)) + (when (natnump (setf (lsp--client-priority (gethash server lsp-clients)) + (* (lsp--client-priority (gethash server lsp-clients)) -1))) + (message (format "Switched to server %s." server))))))) + +;; +;;; Inlay hints + +(defcustom lsp-rust-analyzer-debug-lens-extra-dap-args + '(:MIMode "gdb" :miDebuggerPath "gdb" :stopAtEntry t :externalConsole :json-false) + "Extra arguments to pass to DAP template when debugging a test from code lens. + +As a rule of the thumb, do not add extra keys to this plist unless you exactly +what you are doing, it might break the \"Debug test\" lens otherwise. + +See dap-mode documentation and cpptools documentation for the extra variables +meaning." + :type 'plist + :group 'lsp-rust-analyzer + :package-version '(lsp-mode . "8.0.0")) + +;; +;;; Lenses + +(defgroup lsp-rust-analyzer-lens nil + "LSP lens support for Rust when using rust-analyzer. + +Lenses are (depending on your configuration) clickable links to +the right of function definitions and the like. These display +some useful information in their own right and/or perform a +shortcut action when clicked such as displaying uses of that +function or running an individual test. +" + :prefix "lsp-rust-analyzer-lens-" + :group 'lsp-rust-analyzer + :link '(url-link "https://emacs-lsp.github.io/lsp-mode/") + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-lens-debug-enable t + "Enable or disable the Debug lens." + :type 'boolean + :group 'lsp-rust-analyzer-lens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-lens-enable t + "Master-enable of lenses in Rust files." + :type 'boolean + :group 'lsp-rust-analyzer-lens + :package-version '(lsp-mode . "9.0.0")) + +;; This customisation "works" in that it works as described, but the default is fine and changing it +;; from the default will either stop lenses working or do nothing. +;; +;; If this is ever uncommented to re-enable the option, don't forget to also uncomment it in defun +;; lsp-rust-analyzer--make-init-options too or it'll not do anything. + +;; (defcustom lsp-rust-analyzer-lens-force-custom-commands t +;; "Internal config: use custom client-side commands even when the +;; client doesn't set the corresponding capability." +;; :type 'boolean +;; :group 'lsp-rust-analyzer-lens +;; :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-lens-implementations-enable t + "Enable or disable the Implementations lens. + +The Implementations lens shows `NN implementations' to the right +of the first line of an enum, struct, or union declaration. This +is the count of impl blocks, including derived traits. Clicking +on it gives a list of the impls of that type. +" + :type 'boolean + :group 'lsp-rust-analyzer-lens + :package-version '(lsp-mode . "9.0.0")) + +;; The valid range of values for this is documented in the rust-lang/rust-analyzer repository at the +;; path "editors/code/package.json"; the TL:DR is that it's "above_name" or "above_whole_item". +;; However, setting it to "above_whole_item" causes lenses to disappear in Emacs. I suspect this +;; feature has only ever been tested in some other IDE and it's broken in Emacs. So I've disabled it +;; for now. +;; +;; If this is ever uncommented to re-enable the option, don't forget to also uncomment it in defun +;; lsp-rust-analyzer--make-init-options too or it'll not do anything. + +;; (defcustom lsp-rust-analyzer-lens-location "above_name" +;; "Where to render annotations." +;; :type '(choice +;; (const :tag "Above name" "above_name") +;; (const :tag "Above whole item" "above_whole_item") +;; :group 'lsp-rust-analyzer-lens +;; :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-lens-references-adt-enable nil + "Enable or disable the References lens on enums, structs, and traits. + +The References lens shows `NN references` to the right of the +first line of each enum, struct, or union declaration. This is +the count of uses of that type. Clicking on it gives a list of +where that type is used." + :type 'boolean + :group 'lsp-rust-analyzer-lens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-lens-references-enum-variant-enable nil + "Enable or disable the References lens on enum variants. + +The References lens shows `NN references` to the right of the +first (or only) line of each enum variant. This is the count of +uses of that enum variant. Clicking on it gives a list of where +that enum variant is used." + :type 'boolean + :group 'lsp-rust-analyzer-lens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-lens-references-method-enable nil + "Enable or disable the References lens on functions. + +The References lens shows `NN references` to the right of the +first line of each function declaration. This is the count of +uses of that function. Clicking on it gives a list of where that +function is used." + + :type 'boolean + :group 'lsp-rust-analyzer-lens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-lens-references-trait-enable nil + "Enable or disable the References lens on traits. + +The References lens shows `NN references` to the right of the +first line of each trait declaration. This is a count of uses of +that trait. Clicking on it gives a list of where that trait is +used. + +There is some overlap with the Implementations lens which slows +all of the trait's impl blocks, but this also shows other uses +such as imports and dyn traits." + :type 'boolean + :group 'lsp-rust-analyzer-lens + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-rust-analyzer-lens-run-enable t + "Enable or disable the Run lens." + :type 'boolean + :group 'lsp-rust-analyzer-lens + :package-version '(lsp-mode . "9.0.0")) + +(defun lsp-rust-analyzer-initialized? () + (when-let* ((workspace (lsp-find-workspace 'rust-analyzer (buffer-file-name)))) + (eq 'initialized (lsp--workspace-status workspace)))) + +(defun lsp-rust-analyzer-expand-macro () + "Expands the macro call at point recursively." + (interactive) + (-if-let* ((params (lsp-make-rust-analyzer-expand-macro-params + :text-document (lsp--text-document-identifier) + :position (lsp--cur-position))) + (response (lsp-request + "rust-analyzer/expandMacro" + params)) + ((&rust-analyzer:ExpandedMacro :expansion) response)) + (funcall lsp-rust-analyzer-macro-expansion-method expansion) + (lsp--error "No macro found at point, or it could not be expanded."))) + +(defun lsp-rust-analyzer-macro-expansion-default (result) + "Default method for displaying macro expansion." + (let* ((root (lsp-workspace-root default-directory)) + (buf (get-buffer-create (get-buffer-create (format "*rust-analyzer macro expansion %s*" root))))) + (with-current-buffer buf + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (lsp--render-string result "rust")) + (special-mode))) + (pop-to-buffer buf))) + +;; +;;; Runnables + +(defvar lsp-rust-analyzer--last-runnable nil + "Record the last runnable.") + +(defun lsp-rust-analyzer--runnables () + "Return list of runnables." + (lsp-send-request (lsp-make-request + "experimental/runnables" + (lsp-make-rust-analyzer-runnables-params + :text-document (lsp--text-document-identifier) + :position? (lsp--cur-position))))) + +(defun lsp-rust-analyzer--select-runnable () + "Select runnable." + (lsp--completing-read + "Select runnable:" + (if lsp-rust-analyzer--last-runnable + (cons lsp-rust-analyzer--last-runnable + (-remove (-lambda ((&rust-analyzer:Runnable :label)) + (equal label (lsp-get lsp-rust-analyzer--last-runnable :label))) + (lsp-rust-analyzer--runnables))) + (lsp-rust-analyzer--runnables)) + (-lambda ((&rust-analyzer:Runnable :label)) label))) + +(defun lsp-rust-analyzer--common-runner (runnable) + "Execute a given RUNNABLE. + +Extract the arguments, prepare the minor mode (cargo-process-mode if possible) +and run a compilation" + (-let* (((&rust-analyzer:Runnable :kind :label :args) runnable) + ((&rust-analyzer:RunnableArgs :cargo-args :executable-args :workspace-root? :expect-test?) args) + (default-directory (or workspace-root? default-directory))) + (if (not (string-equal kind "cargo")) + (lsp--error "'%s' runnable is not supported" kind) + (compilation-start + (string-join (append (when expect-test? '("env" "UPDATE_EXPECT=1")) + (list "cargo") cargo-args + (when executable-args '("--")) executable-args '()) " ") + + ;; cargo-process-mode is nice, but try to work without it... + (if (functionp 'cargo-process-mode) 'cargo-process-mode nil) + (lambda (_) (concat "*" label "*")))))) + +(defun lsp-rust-analyzer-run (runnable) + "Select and run a RUNNABLE action." + (interactive (list (lsp-rust-analyzer--select-runnable))) + (when (lsp-rust-analyzer--common-runner runnable) + (setq lsp-rust-analyzer--last-runnable runnable))) + +(defun lsp-rust-analyzer-debug (runnable) + "Select and debug a RUNNABLE action." + (interactive (list (lsp-rust-analyzer--select-runnable))) + (unless (or (featurep 'dap-cpptools) (featurep 'dap-gdb)) + (user-error "You must require `dap-cpptools' or 'dap-gdb'")) + (-let (((&rust-analyzer:Runnable + :args (&rust-analyzer:RunnableArgs :cargo-args :workspace-root? :executable-args) + :label) runnable)) + (pcase (aref cargo-args 0) + ("run" (aset cargo-args 0 "build")) + ("test" (when (-contains? (append cargo-args ()) "--no-run") + (cl-callf append cargo-args (list "--no-run"))))) + (->> (append (list (executable-find "cargo")) + cargo-args + (list "--message-format=json")) + (s-join " ") + (shell-command-to-string) + (s-lines) + (-keep (lambda (s) + (condition-case nil + (-let* ((json-object-type 'plist) + ((msg &as &plist :reason :executable) (json-read-from-string s))) + (when (and executable (string= "compiler-artifact" reason)) + executable)) + (error)))) + (funcall + (lambda (artifact-spec) + (pcase artifact-spec + (`() (user-error "No compilation artifacts or obtaining the runnable artifacts failed")) + (`(,spec) spec) + (_ (user-error "Multiple compilation artifacts are not supported"))))) + (list :type (if (featurep 'dap-gdb) "gdb" "cppdbg") + :request "launch" + :name label + :args executable-args + :cwd workspace-root? + :sourceLanguages ["rust"] + :program) + (append lsp-rust-analyzer-debug-lens-extra-dap-args) + (dap-debug)))) + +(defun lsp-rust-analyzer-rerun (&optional runnable) + (interactive (list (or lsp-rust-analyzer--last-runnable + (lsp-rust-analyzer--select-runnable)))) + (lsp-rust-analyzer-run (or runnable lsp-rust-analyzer--last-runnable))) + +;; goto parent module +(cl-defun lsp-rust-find-parent-module (&key display-action) + "Find parent module of current module." + (interactive) + (lsp-find-locations "experimental/parentModule" nil :display-action display-action)) + +(defun lsp-rust-analyzer-open-cargo-toml (&optional new-window) + "Open the closest Cargo.toml from the current file. + +Rust-Analyzer LSP protocol documented here and added in November 2020 +https://github.com/rust-lang/rust-analyzer/blob/master/docs/dev/lsp-extensions.md#open-cargotoml + +If NEW-WINDOW (interactively the prefix argument) is non-nil, +open in a new window." + (interactive "P") + (-if-let (workspace (lsp-find-workspace 'rust-analyzer (buffer-file-name))) + (-if-let* ((response (with-lsp-workspace workspace + (lsp-send-request (lsp-make-request + "experimental/openCargoToml" + (lsp-make-rust-analyzer-open-cargo-toml-params + :text-document (lsp--text-document-identifier)))))) + ((&Location :uri :range) response)) + (funcall (if new-window #'find-file-other-window #'find-file) + (lsp--uri-to-path uri)) + (lsp--warn "Couldn't find a Cargo.toml file or your version of rust-analyzer doesn't support this extension")) + (lsp--error "OpenCargoToml is an extension available only with rust-analyzer"))) + +(defun lsp-rust-analyzer-open-external-docs () + "Open a URL for documentation related to the current TextDocumentPosition. + +Rust-Analyzer LSP protocol documented here +https://github.com/rust-lang/rust-analyzer/blob/master/docs/dev/lsp-extensions.md#open-external-documentation" + (interactive) + (-if-let* ((params (lsp-make-rust-analyzer-open-external-docs-params + :text-document (lsp--text-document-identifier) + :position (lsp--cur-position))) + (url (lsp-request "experimental/externalDocs" params))) + (browse-url url) + (lsp--warn "Couldn't find documentation URL or your version of rust-analyzer doesn't support this extension"))) + +(defun lsp-rust-analyzer--related-tests () + "Get runnable test items related to the current TextDocumentPosition. +Calls a rust-analyzer LSP extension endpoint that returns a wrapper over +Runnable[]." + (lsp-send-request (lsp-make-request + "rust-analyzer/relatedTests" + (lsp--text-document-position-params)))) + +(defun lsp-rust-analyzer--select-related-test () + "Call the endpoint and ask for user selection. + +Cannot reuse `lsp-rust-analyzer--select-runnable' because the runnables endpoint +responds with Runnable[], while relatedTests responds with TestInfo[], +which is a wrapper over runnable. Also, this method doesn't set +the `lsp-rust-analyzer--last-runnable' variable." + (-if-let* ((resp (lsp-rust-analyzer--related-tests)) + (runnables (seq-map + #'lsp:rust-analyzer-related-tests-runnable + resp))) + (lsp--completing-read + "Select test: " + runnables + #'lsp:rust-analyzer-runnable-label))) + +(defun lsp-rust-analyzer-related-tests (runnable) + "Execute a RUNNABLE test related to the current document position. + +Rust-Analyzer LSP protocol extension +https://github.com/rust-lang/rust-analyzer/blob/master/docs/dev/lsp-extensions.md#related-tests" + (interactive (list (lsp-rust-analyzer--select-related-test))) + (if runnable + (lsp-rust-analyzer--common-runner runnable) + (lsp--info "There are no tests related to the symbol at point"))) + +(defun lsp-rust-analyzer-move-item (direction) + "Move item under cursor or selection in some DIRECTION" + (let* ((params (lsp-make-rust-analyzer-move-item-params + :text-document (lsp--text-document-identifier) + :range (if (use-region-p) + (lsp--region-to-range (region-beginning) (region-end)) + (lsp--region-to-range (point) (point))) + :direction direction)) + (edits (lsp-request "experimental/moveItem" params))) + (lsp--apply-text-edits edits 'code-action))) + +(defun lsp-rust-analyzer-move-item-up () + "Move item under cursor or selection up" + (interactive) + (lsp-rust-analyzer-move-item "Up")) + +(defun lsp-rust-analyzer-move-item-down () + "Move item under cursor or selection down" + (interactive) + (lsp-rust-analyzer-move-item "Down")) + +(defun lsp-rust-analyzer--make-init-options () + "Init options for rust-analyzer" + `(:diagnostics + ( :enable ,(lsp-json-bool lsp-rust-analyzer-diagnostics-enable) + :enableExperimental ,(lsp-json-bool lsp-rust-analyzer-diagnostics-enable-experimental) + :disabled ,lsp-rust-analyzer-diagnostics-disabled + :warningsAsHint ,lsp-rust-analyzer-diagnostics-warnings-as-hint + :warningsAsInfo ,lsp-rust-analyzer-diagnostics-warnings-as-info) + :imports ( :granularity ( :enforce ,(lsp-json-bool lsp-rust-analyzer-import-enforce-granularity) + :group ,lsp-rust-analyzer-import-granularity) + :group ,(lsp-json-bool lsp-rust-analyzer-import-group) + :merge (:glob ,(lsp-json-bool lsp-rust-analyzer-imports-merge-glob)) + :prefix ,lsp-rust-analyzer-import-prefix) + :lruCapacity ,lsp-rust-analyzer-lru-capacity + ;; This `checkOnSave` is called `check` in the `rust-analyzer` docs, not + ;; `checkOnSave`, but the `rust-analyzer` source code shows that both names + ;; work. The `checkOnSave` name has been supported by `rust-analyzer` for a + ;; long time, whereas the `check` name was introduced here in 2023: + ;; https://github.com/rust-lang/rust-analyzer/commit/d2bb62b6a81d26f1e41712e04d4ac760f860d3b3 + :checkOnSave ( :enable ,(lsp-json-bool lsp-rust-analyzer-cargo-watch-enable) + :command ,lsp-rust-analyzer-cargo-watch-command + :extraArgs ,lsp-rust-analyzer-cargo-watch-args + :allTargets ,(lsp-json-bool lsp-rust-analyzer-check-all-targets) + ;; We need to distinguish between setting this to the empty + ;; vector, and not setting it at all, which `rust-analyzer` + ;; interprets as "inherit from + ;; `rust-analyzer.cargo.features`". We use `nil` to mean + ;; "unset". + ,@(when (vectorp lsp-rust-analyzer-checkonsave-features) + `(:features ,lsp-rust-analyzer-checkonsave-features)) + :overrideCommand ,lsp-rust-analyzer-cargo-override-command) + :highlightRelated ( :breakPoints (:enable ,(lsp-json-bool lsp-rust-analyzer-highlight-breakpoints)) + :closureCaptures (:enable ,(lsp-json-bool lsp-rust-analyzer-highlight-closure-captures)) + :exitPoints (:enable ,(lsp-json-bool lsp-rust-analyzer-highlight-exit-points)) + :references (:enable ,(lsp-json-bool lsp-rust-analyzer-highlight-references)) + :yieldPoints (:enable ,(lsp-json-bool lsp-rust-analyzer-highlight-yield-points))) + :files ( :exclude ,lsp-rust-analyzer-exclude-globs + :watcher ,(if lsp-rust-analyzer-use-client-watching "client" "notify") + :excludeDirs ,lsp-rust-analyzer-exclude-dirs) + :cfg ( :setTest ,(lsp-json-bool lsp-rust-analyzer-cfg-set-test) ) + :cargo ( :allFeatures ,(lsp-json-bool lsp-rust-all-features) + :noDefaultFeatures ,(lsp-json-bool lsp-rust-no-default-features) + :features ,lsp-rust-features + :extraArgs ,lsp-rust-analyzer-cargo-extra-args + :extraEnv ,lsp-rust-analyzer-cargo-extra-env + :target ,lsp-rust-analyzer-cargo-target + :runBuildScripts ,(lsp-json-bool lsp-rust-analyzer-cargo-run-build-scripts) + ;; Obsolete, but used by old Rust-Analyzer versions + :loadOutDirsFromCheck ,(lsp-json-bool lsp-rust-analyzer-cargo-run-build-scripts) + :autoreload ,(lsp-json-bool lsp-rust-analyzer-cargo-auto-reload) + :useRustcWrapperForBuildScripts ,(lsp-json-bool lsp-rust-analyzer-use-rustc-wrapper-for-build-scripts) + :unsetTest ,lsp-rust-analyzer-cargo-unset-test) + :rustfmt ( :extraArgs ,lsp-rust-analyzer-rustfmt-extra-args + :overrideCommand ,lsp-rust-analyzer-rustfmt-override-command + :rangeFormatting (:enable ,(lsp-json-bool lsp-rust-analyzer-rustfmt-rangeformatting-enable))) + :lens ( :debug (:enable ,(lsp-json-bool lsp-rust-analyzer-lens-debug-enable)) + :enable ,(lsp-json-bool lsp-rust-analyzer-lens-enable) + ;; :forceCustomCommands ,(lsp-json-bool lsp-rust-analyzer-lens-force-custom-commands) + :implementations (:enable ,(lsp-json-bool lsp-rust-analyzer-lens-implementations-enable)) + ;; :location ,lsp-rust-analyzer-lens-location + :references ( :adt (:enable ,(lsp-json-bool lsp-rust-analyzer-lens-references-adt-enable)) + :enumVariant (:enable ,(lsp-json-bool lsp-rust-analyzer-lens-references-enum-variant-enable)) + :method (:enable ,(lsp-json-bool lsp-rust-analyzer-lens-references-method-enable)) + :trait (:enable ,(lsp-json-bool lsp-rust-analyzer-lens-references-trait-enable))) + :run (:enable ,(lsp-json-bool lsp-rust-analyzer-lens-run-enable))) + + :inlayHints ( :bindingModeHints (:enable ,(lsp-json-bool lsp-rust-analyzer-binding-mode-hints)) + :chainingHints (:enable ,(lsp-json-bool lsp-rust-analyzer-display-chaining-hints)) + :closingBraceHints ( :enable ,(lsp-json-bool lsp-rust-analyzer-closing-brace-hints) + :minLines ,lsp-rust-analyzer-closing-brace-hints-min-lines) + :closureCaptureHints (:enable ,(lsp-json-bool lsp-rust-analyzer-closure-capture-hints)) + :closureReturnTypeHints (:enable ,lsp-rust-analyzer-closure-return-type-hints) + :closureStyle ,lsp-rust-analyzer-closure-style + :discriminantHints (:enable ,lsp-rust-analyzer-discriminants-hints) + + :expressionAdjustmentHints ( :enable ,lsp-rust-analyzer-expression-adjustment-hints + :hideOutsideUnsafe ,(lsp-json-bool lsp-rust-analyzer-expression-adjustment-hide-unsafe) + :mode ,lsp-rust-analyzer-expression-adjustment-hints-mode) + :implicitDrops (:enable ,(lsp-json-bool lsp-rust-analyzer-implicit-drops)) + :lifetimeElisionHints ( :enable ,lsp-rust-analyzer-display-lifetime-elision-hints-enable + :useParameterNames ,(lsp-json-bool lsp-rust-analyzer-display-lifetime-elision-hints-use-parameter-names)) + :maxLength ,lsp-rust-analyzer-max-inlay-hint-length + :parameterHints (:enable ,(lsp-json-bool lsp-rust-analyzer-display-parameter-hints)) + :reborrowHints (:enable ,lsp-rust-analyzer-display-reborrow-hints) + :renderColons ,(lsp-json-bool lsp-rust-analyzer-server-format-inlay-hints) + :typeHints ( :enable ,(lsp-json-bool lsp-inlay-hint-enable) + :hideClosureInitialization ,(lsp-json-bool lsp-rust-analyzer-hide-closure-initialization) + :hideNamedConstructor ,(lsp-json-bool lsp-rust-analyzer-hide-named-constructor))) + :completion ( :addCallParenthesis ,(lsp-json-bool lsp-rust-analyzer-completion-add-call-parenthesis) + :addCallArgumentSnippets ,(lsp-json-bool lsp-rust-analyzer-completion-add-call-argument-snippets) + :postfix (:enable ,(lsp-json-bool lsp-rust-analyzer-completion-postfix-enable)) + :autoimport (:enable ,(lsp-json-bool lsp-rust-analyzer-completion-auto-import-enable)) + :autoself (:enable ,(lsp-json-bool lsp-rust-analyzer-completion-auto-self-enable))) + :callInfo (:full ,(lsp-json-bool lsp-rust-analyzer-call-info-full)) + :procMacro (:enable ,(lsp-json-bool lsp-rust-analyzer-proc-macro-enable)) + :rustcSource ,lsp-rust-analyzer-rustc-source + :linkedProjects ,lsp-rust-analyzer-linked-projects + :highlighting (:strings ,(lsp-json-bool lsp-rust-analyzer-highlighting-strings)) + :experimental (:procAttrMacros ,(lsp-json-bool lsp-rust-analyzer-experimental-proc-attr-macros)))) + +(lsp-register-client + (make-lsp-client + :new-connection (lsp-stdio-connection + (lambda () + `(,(or (executable-find + (cl-first lsp-rust-analyzer-server-command)) + (lsp-package-path 'rust-analyzer) + "rust-analyzer") + ,@(cl-rest lsp-rust-analyzer-server-command)))) + :activation-fn (lsp-activate-on "rust") + :priority (if (eq lsp-rust-server 'rust-analyzer) 1 -1) + :initialization-options 'lsp-rust-analyzer--make-init-options + :notification-handlers (ht<-alist lsp-rust-notification-handlers) + :action-handlers (ht ("rust-analyzer.runSingle" #'lsp-rust--analyzer-run-single) + ("rust-analyzer.debugSingle" #'lsp-rust--analyzer-debug-lens) + ("rust-analyzer.showReferences" #'lsp-rust--analyzer-show-references) + ("rust-analyzer.triggerParameterHints" #'lsp--action-trigger-parameter-hints)) + :library-folders-fn (lambda (_workspace) lsp-rust-analyzer-library-directories) + :semantic-tokens-faces-overrides `( :discard-default-modifiers t + :modifiers ,(lsp-rust-analyzer--semantic-modifiers)) + :server-id 'rust-analyzer + :custom-capabilities `((experimental . + ((snippetTextEdit . ,(and lsp-enable-snippet (fboundp 'yas-minor-mode))) + (commands . ((commands . + [ + "rust-analyzer.runSingle" + "rust-analyzer.debugSingle" + "rust-analyzer.showReferences" + ;; "rust-analyzer.gotoLocation" + "rust-analyzer.triggerParameterHints" + ;; "rust-analyzer.rename" + ])))))) + :download-server-fn (lambda (_client callback error-callback _update?) + (lsp-package-ensure 'rust-analyzer callback error-callback)))) + +(cl-defmethod lsp-clients-extract-signature-on-hover (contents (_server-id (eql rust-analyzer))) + "Extract first non-comment line from rust-analyzer's hover CONTENTS. +The first line of the hover contents is usally about memory layout or notable +traits starting with //, with the actual signature follows." + (let* ((lines (s-lines (s-trim (lsp--render-element contents)))) + (non-comment-lines (--filter (not (s-prefix? "//" it)) lines))) + (if non-comment-lines + (car non-comment-lines) + (car lines)))) + +(lsp-consistency-check lsp-rust) + +(provide 'lsp-rust) +;;; lsp-rust.el ends here diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-rust.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-rust.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-semantic-tokens.el b/emacs/elpa/lsp-mode-20241119.828/lsp-semantic-tokens.el @@ -0,0 +1,920 @@ +;;; lsp-semantic-tokens.el --- Semantic tokens -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2020 emacs-lsp maintainers +;; +;; 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: +;; +;; Semantic tokens +;; https://microsoft.github.io/language-server-protocol/specifications/specification-current/#textDocument_semanticTokens +;; +;;; Code: + +(require 'lsp-mode) +(require 'dash) + +(defgroup lsp-semantic-tokens nil + "LSP support for semantic-tokens." + :prefix "lsp-semantic-tokens-" + :group 'lsp-mode + :tag "LSP Semantic tokens") + +(define-obsolete-variable-alias 'lsp-semantic-highlighting-warn-on-missing-face 'lsp-semantic-tokens-warn-on-missing-face "lsp-mode 8.0.0") + +(defcustom lsp-semantic-tokens-warn-on-missing-face nil + "Warning on missing face for token type/modifier. +When non-nil, this option will emit a warning any time a token +or modifier type returned by a language server has no face associated with it." + :group 'lsp-semantic-tokens + :type 'boolean) + +(defcustom lsp-semantic-tokens-apply-modifiers t + "Whether semantic tokens should take token modifiers into account." + :group 'lsp-semantic-tokens + :type 'boolean) + +(defcustom lsp-semantic-tokens-allow-ranged-requests t + "Whether to use ranged semantic token requests when available. + +Note that even when this is set to t, delta requests will +be preferred whenever possible, unless +`lsp-semantic-tokens-allow-delta-requests' is false." + :group 'lsp-semantic-tokens + :type 'boolean) + +(defcustom lsp-semantic-tokens-allow-delta-requests t + "Whether to use semantic token delta requests when available. + +When supported by the language server, delta requests are always +preferred over both full and ranged token requests." + :group 'lsp-semantic-tokens + :type 'boolean) + +(defcustom lsp-semantic-tokens-honor-refresh-requests nil + "Whether to honor semanticTokens/refresh requests. + +When set to nil, refresh requests will be silently discarded. +When set to t, semantic tokens will be re-requested for all buffers +associated with the requesting language server." + :group 'lsp-semantic-tokens + :type 'boolean) + +(defcustom lsp-semantic-tokens-enable-multiline-token-support t + "When set to nil, tokens will be truncated after end-of-line." + :group 'lsp-semantic-tokens + :type 'boolean) + +(defface lsp-face-semhl-constant + '((t :inherit font-lock-constant-face)) + "Face used for semantic highlighting scopes matching constant scopes." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-variable + '((t :inherit font-lock-variable-name-face)) + "Face used for semantic highlighting scopes matching variable.*. +Unless overridden by a more specific face association." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-function + '((t :inherit font-lock-function-name-face)) + "Face used for semantic highlighting scopes matching entity.name.function.*. +Unless overridden by a more specific face association." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-method + '((t :inherit lsp-face-semhl-function)) + "Face used for semantic highlighting scopes matching entity.name.method.*. +Unless overridden by a more specific face association." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-namespace + '((t :inherit font-lock-type-face :weight bold)) + "Face used for semantic highlighting scopes matching entity.name.namespace.*. +Unless overridden by a more specific face association." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-comment + '((t (:inherit font-lock-comment-face))) + "Face used for comments." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-keyword + '((t (:inherit font-lock-keyword-face))) + "Face used for keywords." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-string + '((t (:inherit font-lock-string-face))) + "Face used for keywords." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-number + '((t (:inherit font-lock-constant-face))) + "Face used for numbers." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-regexp + '((t (:inherit font-lock-string-face :slant italic))) + "Face used for regexps." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-operator + '((t (:inherit font-lock-function-name-face))) + "Face used for operators." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-namespace + '((t (:inherit font-lock-keyword-face))) + "Face used for namespaces." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-type + '((t (:inherit font-lock-type-face))) + "Face used for types." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-struct + '((t (:inherit font-lock-type-face))) + "Face used for structs." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-class + '((t (:inherit font-lock-type-face))) + "Face used for classes." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-interface + '((t (:inherit font-lock-type-face))) + "Face used for interfaces." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-enum + '((t (:inherit font-lock-type-face))) + "Face used for enums." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-type-parameter + '((t (:inherit font-lock-type-face))) + "Face used for type parameters." + :group 'lsp-semantic-tokens) + +;; function face already defined, move here when support +;; for theia highlighting gets removed +(defface lsp-face-semhl-member + '((t (:inherit font-lock-variable-name-face))) + "Face used for members." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-property + '((t (:inherit font-lock-variable-name-face))) + "Face used for properties." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-event + '((t (:inherit font-lock-variable-name-face))) + "Face used for event properties." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-macro + '((t (:inherit font-lock-preprocessor-face))) + "Face used for macros." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-variable + '((t (:inherit font-lock-variable-name-face))) + "Face used for variables." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-parameter + '((t (:inherit font-lock-variable-name-face))) + "Face used for parameters." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-label + '((t (:inherit font-lock-comment-face))) + "Face used for labels." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-deprecated + '((t :strike-through t)) + "Face used for semantic highlighting scopes matching constant scopes." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-definition + '((t :inherit font-lock-function-name-face :weight bold)) + "Face used for definition modifier." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-implementation + '((t :inherit font-lock-function-name-face :weight bold)) + "Face used for implementation modifier." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-default-library + '((t :inherit font-lock-builtin-face)) + "Face used for defaultLibrary modifier." + :group 'lsp-semantic-tokens) + +(defface lsp-face-semhl-static + '((t :inherit font-lock-keyword-face)) + "Face used for static modifier." + :group 'lsp-semantic-tokens) + +(defvar-local lsp-semantic-token-faces + '(("comment" . lsp-face-semhl-comment) + ("keyword" . lsp-face-semhl-keyword) + ("string" . lsp-face-semhl-string) + ("number" . lsp-face-semhl-number) + ("regexp" . lsp-face-semhl-regexp) + ("operator" . lsp-face-semhl-operator) + ("namespace" . lsp-face-semhl-namespace) + ("type" . lsp-face-semhl-type) + ("struct" . lsp-face-semhl-struct) + ("class" . lsp-face-semhl-class) + ("interface" . lsp-face-semhl-interface) + ("enum" . lsp-face-semhl-enum) + ("typeParameter" . lsp-face-semhl-type-parameter) + ("function" . lsp-face-semhl-function) + ("method" . lsp-face-semhl-method) + ("member" . lsp-face-semhl-member) + ("property" . lsp-face-semhl-property) + ("event" . lsp-face-semhl-event) + ("macro" . lsp-face-semhl-macro) + ("variable" . lsp-face-semhl-variable) + ("parameter" . lsp-face-semhl-parameter) + ("label" . lsp-face-semhl-label) + ("enumConstant" . lsp-face-semhl-constant) + ("enumMember" . lsp-face-semhl-constant) + ("dependent" . lsp-face-semhl-type) + ("concept" . lsp-face-semhl-interface)) + "Faces to use for semantic tokens.") + +(defvar-local lsp-semantic-token-modifier-faces + '(("declaration" . lsp-face-semhl-interface) + ("definition" . lsp-face-semhl-definition) + ("implementation" . lsp-face-semhl-implementation) + ("readonly" . lsp-face-semhl-constant) + ("static" . lsp-face-semhl-static) + ("deprecated" . lsp-face-semhl-deprecated) + ("abstract" . lsp-face-semhl-keyword) + ("async" . lsp-face-semhl-macro) + ("modification" . lsp-face-semhl-operator) + ("documentation" . lsp-face-semhl-comment) + ("defaultLibrary" . lsp-face-semhl-default-library)) + "Semantic tokens modifier faces. +Faces to use for semantic token modifiers if +`lsp-semantic-tokens-apply-modifiers' is non-nil.") + +(defun lsp--semantic-tokens-capabilities () + `((semanticTokens + . ((dynamicRegistration . t) + (requests . ((range . t) (full . t))) + (tokenModifiers . ,(if lsp-semantic-tokens-apply-modifiers + (apply 'vector (mapcar #'car (lsp-semantic-tokens--modifier-faces-for (lsp--workspace-client lsp--cur-workspace)))) + [])) + (overlappingTokenSupport . t) + (multilineTokenSupport . ,(if lsp-semantic-tokens-enable-multiline-token-support t json-false)) + (tokenTypes . ,(apply 'vector (mapcar #'car (lsp-semantic-tokens--type-faces-for (lsp--workspace-client lsp--cur-workspace))))) + (formats . ["relative"]))))) + +(defvar lsp--semantic-tokens-pending-full-token-requests '() + "Buffers which should have their semantic tokens refreshed on idle. + +This is an alist of the form ((buffer_i . fontify_immediately_i) ...); entries +with fontify_immediately set to t will immediately refontify once their +token request is answered.") + +;; NOTE: doesn't keep track of outstanding requests, so might still produce large latency outliers +;; if the language server doesn't process all outstanding token requests within one lsp-idle-delay +(defcustom lsp-semantic-tokens-max-concurrent-idle-requests 1 + "Maximum number of on-idle token requests to be dispatched simultaneously." + :group 'lsp-semantic-tokens + :type 'integer) + +(defvar lsp--semantic-tokens-idle-timer nil) + +(defun lsp--semantic-tokens-process-pending-requests () + (let ((fuel lsp-semantic-tokens-max-concurrent-idle-requests)) + (while (and lsp--semantic-tokens-pending-full-token-requests (> fuel 0)) + (-let (((buffer . fontify-immediately) (pop lsp--semantic-tokens-pending-full-token-requests))) + (when (buffer-live-p buffer) + (setq fuel (1- fuel)) + (with-current-buffer buffer + (lsp--semantic-tokens-request nil fontify-immediately)))))) + (unless lsp--semantic-tokens-pending-full-token-requests + (cancel-timer lsp--semantic-tokens-idle-timer) + (setq lsp--semantic-tokens-idle-timer nil))) + +(defun lsp--semantic-tokens-sort-pending-requests (pending-requests) + ;; service currently visible buffers first, otherwise prefer immediate-fontification requests + (-sort (lambda (entry-a entry-b) + (let ((a-hidden (eq nil (get-buffer-window (car entry-a)))) + (b-hidden (eq nil (get-buffer-window (car entry-b))))) + (cond ((and b-hidden (not a-hidden)) t) ; sort a before b + ((and a-hidden (not b-hidden)) nil) ; sort b before a + ((and (not (cdr entry-a)) (cdr entry-b)) nil) ; otherwise sort b before a only if b is immediate and a is not + (t t)))) + (--filter (buffer-live-p (car it)) pending-requests))) + +(defun lsp--semantic-tokens-request-full-token-set-when-idle (buffer fontify-immediately) + "Request full token set after an idle timeout of `lsp-idle-delay'. + +If FONTIFY-IMMEDIATELY is non-nil, fontification will be performed immediately + once the corresponding response is received." + (let ((do-fontify-immediately (or fontify-immediately + (cdr (assoc buffer lsp--semantic-tokens-pending-full-token-requests))))) + (setq lsp--semantic-tokens-pending-full-token-requests + (lsp--semantic-tokens-sort-pending-requests + (cons (cons buffer do-fontify-immediately) + (--remove (eq buffer (car it)) lsp--semantic-tokens-pending-full-token-requests))))) + (unless lsp--semantic-tokens-idle-timer + (setq lsp--semantic-tokens-idle-timer + (run-with-idle-timer lsp-idle-delay t #'lsp--semantic-tokens-process-pending-requests)))) + +(defun lsp--semantic-tokens-refresh-if-enabled (buffer) + (when (buffer-local-value 'lsp-semantic-tokens-mode buffer) + (lsp--semantic-tokens-request-full-token-set-when-idle buffer t))) + +(defvar-local lsp--semantic-tokens-cache nil + "Previously returned token set. + +When non-nil, `lsp--semantic-tokens-cache' should adhere to the +following lsp-interface: +`(_SemanticTokensCache + (:_documentVersion) + (:response :_region :_truncated))'.") + +(defsubst lsp--semantic-tokens-putcache (k v) + "Set key K of `lsp--semantic-tokens-cache' to V." + (setq lsp--semantic-tokens-cache + (plist-put lsp--semantic-tokens-cache k v))) + +(defvar-local lsp--semantic-tokens-teardown nil) + +(defun lsp--semantic-tokens-ingest-range-response (response) + "Handle RESPONSE to semanticTokens/range request." + (lsp--semantic-tokens-putcache :response response) + (cl-assert (plist-get lsp--semantic-tokens-cache :_region)) + (lsp--semantic-tokens-request-full-token-set-when-idle (current-buffer) nil)) + +(defun lsp--semantic-tokens-ingest-full-response (response) + "Handle RESPONSE to semanticTokens/full request." + (lsp--semantic-tokens-putcache :response response) + (cl-assert (not (plist-get lsp--semantic-tokens-cache :_region)))) + +(defsubst lsp--semantic-tokens-apply-delta-edits (old-data edits) + "Apply EDITS obtained from full/delta request to OLD-DATA." + (let* ((old-token-count (length old-data)) + (old-token-index 0) + (substrings)) + (cl-loop + for edit across edits + do + (when (< old-token-index (lsp-get edit :start)) + (push (substring old-data old-token-index (lsp-get edit :start)) substrings)) + (push (lsp-get edit :data) substrings) + (setq old-token-index (+ (lsp-get edit :start) (lsp-get edit :deleteCount))) + finally do (push (substring old-data old-token-index old-token-count) substrings)) + (apply #'vconcat (nreverse substrings)))) + +(defun lsp--semantic-tokens-ingest-full/delta-response (response) + "Handle RESPONSE to semanticTokens/full/delta request." + (if (lsp-get response :edits) + (let ((old-data (--> lsp--semantic-tokens-cache (plist-get it :response) (lsp-get it :data)))) + (cl-assert (not (plist-get lsp--semantic-tokens-cache :_region))) + (when old-data + (lsp--semantic-tokens-putcache + :response (lsp-put response + :data (lsp--semantic-tokens-apply-delta-edits + old-data (lsp-get response :edits)))))) + ;; server decided to send full response instead + (lsp--semantic-tokens-ingest-full-response response))) + + +(defun lsp--semantic-tokens-request (region fontify-immediately) + "Send semantic tokens request to the language server. + +A full/delta request will be sent if delta requests are supported by +the language server, allowed via `lsp-semantic-tokens-allow-delta-requests', +and if a full set of tokens had previously been received. +Otherwise, a ranged request will be dispatched if REGION is non-nil, +ranged requests are supported by the language server, and allowed via +`lsp-semantic-tokens-allow-delta-requests'. In all other cases, a full +tokens request will be dispatched. + +If FONTIFY-IMMEDIATELY is non-nil, fontification will be performed immediately + upon receiving the response." + (let ((request-type "textDocument/semanticTokens/full") + (request `(:textDocument ,(lsp--text-document-identifier))) + (response-handler nil) + (final-region nil)) + (cond + ((and lsp-semantic-tokens-allow-delta-requests + (lsp-feature? "textDocument/semanticTokensFull/Delta") + (--> lsp--semantic-tokens-cache + (plist-get it :response) + (and (lsp-get it :resultId) (lsp-get it :data) + (not (plist-get lsp--semantic-tokens-cache :_region))))) + (setq request-type "textDocument/semanticTokens/full/delta") + (setq response-handler #'lsp--semantic-tokens-ingest-full/delta-response) + (setq request + (plist-put request :previousResultId + (lsp-get (plist-get lsp--semantic-tokens-cache :response) :resultId)))) + ((and lsp-semantic-tokens-allow-ranged-requests region + (lsp-feature? "textDocument/semanticTokensRangeProvider")) + (setq request-type "textDocument/semanticTokens/range") + (setq final-region region) + (setq request + (plist-put request :range (lsp--region-to-range (car final-region) (cdr final-region)))) + (setq response-handler #'lsp--semantic-tokens-ingest-range-response)) + (t (setq response-handler #'lsp--semantic-tokens-ingest-full-response))) + (lsp-request-async + request-type request + (lambda (response) + (lsp--semantic-tokens-putcache :_documentVersion lsp--cur-version) + (lsp--semantic-tokens-putcache :_region final-region) + (funcall response-handler response) + (when (or fontify-immediately (plist-get lsp--semantic-tokens-cache :_truncated)) (font-lock-flush))) + :error-handler ;; buffer is not captured in `error-handler', it is in `callback' + (let ((buf (current-buffer))) + (lambda (&rest _) + (when (buffer-live-p buf) + (lsp--semantic-tokens-request-full-token-set-when-idle buf t)))) + :mode 'tick + :cancel-token (format "semantic-tokens-%s" (lsp--buffer-uri))))) + + +;;;###autoload +(defvar-local semantic-token-modifier-cache (make-hash-table) + "A cache of modifier values to the selected fonts. +This allows whole-bitmap lookup instead of checking each bit. The +expectation is that usage of modifiers will tend to cluster, so +we will not have the full range of possible usages, hence a +tractable hash map. + +This is set as buffer-local. It should probably be shared in a +given workspace/language-server combination. + +This cache should be flushed every time any modifier +configuration changes.") + +(defun lsp-semantic-tokens--fontify (old-fontify-region beg-orig end-orig &optional loudly) + "Apply fonts to retrieved semantic tokens. +OLD-FONTIFY-REGION is the underlying region fontification function, +e.g., `font-lock-fontify-region'. +BEG-ORIG and END-ORIG deliminate the requested fontification region and maybe +modified by OLD-FONTIFY-REGION. +LOUDLY will be forwarded to OLD-FONTIFY-REGION as-is." + ;; TODO: support multiple language servers per buffer? + (let ((faces (seq-some #'lsp--workspace-semantic-tokens-faces lsp--buffer-workspaces)) + (modifier-faces + (when lsp-semantic-tokens-apply-modifiers + (seq-some #'lsp--workspace-semantic-tokens-modifier-faces lsp--buffer-workspaces))) + old-bounds + beg end) + (cond + ((or (eq nil faces) + (eq nil lsp--semantic-tokens-cache) + (eq nil (plist-get lsp--semantic-tokens-cache :response))) + ;; default to non-semantic highlighting until first response has arrived + (funcall old-fontify-region beg-orig end-orig loudly)) + ((not (= lsp--cur-version (plist-get lsp--semantic-tokens-cache :_documentVersion))) + ;; delay fontification until we have fresh tokens + '(jit-lock-bounds 0 . 0)) + (t + (setq old-bounds (funcall old-fontify-region beg-orig end-orig loudly)) + ;; this is to prevent flickering when semantic token highlighting + ;; is layered on top of, e.g., tree-sitter-hl, or clojure-mode's syntax highlighting. + (setq beg (min beg-orig (cadr old-bounds)) + end (max end-orig (cddr old-bounds))) + ;; if we're using the response to a ranged request, we'll only be able to fontify within + ;; that range (and hence shouldn't clear any highlights outside of that range) + (let ((token-region (plist-get lsp--semantic-tokens-cache :_region))) + (if token-region + (progn + (lsp--semantic-tokens-putcache :_truncated (or (< beg (car token-region)) + (> end (cdr token-region)))) + (setq beg (max beg (car token-region))) + (setq end (min end (cdr token-region)))) + (lsp--semantic-tokens-putcache :_truncated nil))) + (-let* ((inhibit-field-text-motion t) + (data (lsp-get (plist-get lsp--semantic-tokens-cache :response) :data)) + (i0 0) + (i-max (1- (length data))) + (current-line 1) + (line-delta) + (column 0) + (face) + (line-start-pos) + (line-min) + (line-max-inclusive) + (text-property-beg) + (text-property-end)) + (save-mark-and-excursion + (save-restriction + (widen) + (goto-char beg) + (goto-char (line-beginning-position)) + (setq line-min (line-number-at-pos)) + (with-silent-modifications + (goto-char end) + (goto-char (line-end-position)) + (setq line-max-inclusive (line-number-at-pos)) + (forward-line (- line-min line-max-inclusive)) + (let ((skip-lines (- line-min current-line))) + (while (and (<= i0 i-max) (< (aref data i0) skip-lines)) + (setq skip-lines (- skip-lines (aref data i0))) + (setq i0 (+ i0 5))) + (setq current-line (- line-min skip-lines))) + (forward-line (- current-line line-min)) + (setq line-start-pos (point)) + (cl-loop + for i from i0 to i-max by 5 do + (setq line-delta (aref data i)) + (unless (= line-delta 0) + (forward-line line-delta) + (setq line-start-pos (point)) + (setq column 0) + (setq current-line (+ current-line line-delta))) + (setq column (+ column (aref data (1+ i)))) + (setq face (aref faces (aref data (+ i 3)))) + (setq text-property-beg (+ line-start-pos column)) + (setq text-property-end + (min (if lsp-semantic-tokens-enable-multiline-token-support + (point-max) (line-end-position)) + (+ text-property-beg (aref data (+ i 2))))) + (when face + (put-text-property text-property-beg text-property-end 'face face)) + ;; Deal with modifiers. We cache common combinations of + ;; modifiers, storing the faces they resolve to. + (let* ((modifier-code (aref data (+ i 4))) + (faces-to-apply (gethash modifier-code semantic-token-modifier-cache 'not-found))) + (when (eq 'not-found faces-to-apply) + (setq faces-to-apply nil) + (cl-loop for j from 0 to (1- (length modifier-faces)) do + (when (and (aref modifier-faces j) + (> (logand modifier-code (ash 1 j)) 0)) + (push (aref modifier-faces j) faces-to-apply))) + (puthash modifier-code faces-to-apply semantic-token-modifier-cache)) + (dolist (face faces-to-apply) + (add-face-text-property text-property-beg text-property-end face))) + when (> current-line line-max-inclusive) return nil))))) + `(jit-lock-bounds ,beg . ,end))))) + +(defun lsp-semantic-tokens--request-update () + "Request semantic-tokens update." + ;; when dispatching ranged requests, we'll over-request by several chunks in both directions, + ;; which should minimize those occasions where font-lock region extension extends beyond the + ;; region covered by our freshly requested tokens (see lsp-mode issue #3154), while still limiting + ;; requests to fairly small regions even if the underlying buffer is large + (when (lsp-feature? "textDocument/semanticTokensFull") + (lsp--semantic-tokens-request + (cons (max (point-min) (- (window-start) (* 5 jit-lock-chunk-size))) + (min (point-max) (+ (window-end) (* 5 jit-lock-chunk-size)))) t))) + +(defun lsp--semantic-tokens-as-defined-by-workspace (workspace) + "Return plist of token-types and token-modifiers defined by WORKSPACE, +or nil if none are defined." + (when-let* ((token-capabilities + (or + (-some-> + (lsp--registered-capability "textDocument/semanticTokens") + (lsp--registered-capability-options)) + (lsp:server-capabilities-semantic-tokens-provider? + (lsp--workspace-server-capabilities workspace))))) + (-let* (((&SemanticTokensOptions :legend) token-capabilities)) + `(:token-types ,(lsp:semantic-tokens-legend-token-types legend) + :token-modifiers ,(lsp:semantic-tokens-legend-token-modifiers legend))))) + +(defun lsp-semantic-tokens-suggest-overrides () + "Suggest face overrides that best match the faces +chosen by `font-lock-fontify-region'." + (interactive) + (-when-let* ((token-info (-some #'lsp--semantic-tokens-as-defined-by-workspace lsp--buffer-workspaces)) + ((&plist :token-types token-types :token-modifiers token-modifiers) token-info)) + (let* ((tokens (lsp-request + "textDocument/semanticTokens/full" + `(:textDocument, (lsp--text-document-identifier)))) + (inhibit-field-text-motion t) + (data (lsp-get tokens :data)) + (associated-faces '()) + (line-delta) + ;; KLUDGE: clear cache so our font-lock advice won't apply semantic-token faces + (old-cache lsp--semantic-tokens-cache) + (face-or-faces)) + (setq lsp--semantic-tokens-cache nil) + (save-restriction + (save-excursion + (widen) + (font-lock-fontify-region (point-min) (point-max) t) + (save-mark-and-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (cl-loop + for i from 0 to (1- (length data)) by 5 do + (setq line-delta (aref data i)) + (unless (= line-delta 0) (forward-line line-delta)) + (forward-char (aref data (+ i 1))) + (setq face-or-faces (get-text-property (point) 'face)) + ;; TODO: consider modifiers? + (when face-or-faces + (--each (if (listp face-or-faces) face-or-faces (list face-or-faces)) + (cl-pushnew `(,(aref data (+ i 3)) . ,it) associated-faces :test #'equal)))) + (setq lsp--semantic-tokens-cache old-cache) + (font-lock-flush))))) + (switch-to-buffer (get-buffer-create "*Suggested Overrides*")) + (insert "(") + ;; TODO: sort alternatives by frequency + (--each-indexed (-group-by #'car associated-faces) + (insert (if (= it-index 0) "(" "\n (")) + (insert (format "%s . " (aref token-types (car it)))) + (--each-indexed (mapcar #'cdr (cdr it)) + (insert (if (= it-index 0) (format "%s)" (prin1-to-string it)) + (format " ; Alternative: %s" (prin1-to-string it)))))) + (insert ")")))) + +(declare-function tree-sitter-hl-mode "ext:tree-sitter-hl") + +(with-eval-after-load 'tree-sitter-hl + (add-hook + 'tree-sitter-hl-mode-hook + (lambda () + (when (and lsp-mode lsp--semantic-tokens-teardown + (boundp 'tree-sitter-hl-mode) tree-sitter-hl-mode) + (lsp-warn "It seems you have configured tree-sitter-hl to activate after lsp-mode. +To prevent tree-sitter-hl from overriding lsp-mode's semantic token highlighting, lsp-mode +will now disable both semantic highlighting and tree-sitter-hl mode and subsequently re-enable both, +starting with tree-sitter-hl-mode. + +Please adapt your config to prevent unnecessary mode reinitialization in the future.") + (tree-sitter-hl-mode -1) + (funcall lsp--semantic-tokens-teardown) + (setq lsp--semantic-tokens-teardown nil) + (tree-sitter-hl-mode t) + (lsp--semantic-tokens-initialize-buffer))))) + +;;;###autoload +(defun lsp--semantic-tokens-initialize-buffer () + "Initialize the buffer for semantic tokens. +IS-RANGE-PROVIDER is non-nil when server supports range requests." + (let* ((old-extend-region-functions font-lock-extend-region-functions) + ;; make sure font-lock always fontifies entire lines (TODO: do we also have + ;; to change some jit-lock-...-region functions/variables?) + (new-extend-region-functions + (if (memq 'font-lock-extend-region-wholelines old-extend-region-functions) + old-extend-region-functions + (cons 'font-lock-extend-region-wholelines old-extend-region-functions))) + (buffer (current-buffer))) + (setq lsp--semantic-tokens-cache nil) + (setq font-lock-extend-region-functions new-extend-region-functions) + (add-function :around (local 'font-lock-fontify-region-function) #'lsp-semantic-tokens--fontify) + (add-hook 'lsp-on-change-hook #'lsp-semantic-tokens--request-update nil t) + (lsp-semantic-tokens--request-update) + (setq lsp--semantic-tokens-teardown + (lambda () + (setq lsp--semantic-tokens-pending-full-token-requests + (--remove (eq buffer (car it)) lsp--semantic-tokens-pending-full-token-requests)) + (setq font-lock-extend-region-functions old-extend-region-functions) + (setq lsp--semantic-tokens-cache nil) + (remove-function (local 'font-lock-fontify-region-function) + #'lsp-semantic-tokens--fontify) + (remove-hook 'lsp-on-change-hook #'lsp-semantic-tokens--request-update t))))) + +(defun lsp--semantic-tokens-build-face-map (identifiers faces category varname) + "Build map of FACES for IDENTIFIERS using CATEGORY and VARNAME." + (apply 'vector + (mapcar (lambda (id) + (let ((maybe-face (cdr (assoc id faces)))) + (when (and lsp-semantic-tokens-warn-on-missing-face (not maybe-face)) + (lsp-warn "No face has been associated to the %s '%s': consider adding a corresponding definition to %s" + category id varname)) maybe-face)) identifiers))) + +(defun lsp-semantic-tokens--apply-alist-overrides (base overrides discard-defaults) + "Merge or replace BASE with OVERRIDES, depending on DISCARD-DEFAULTS. +For keys present in both alists, the assignments made by +OVERRIDES will take precedence." + (if discard-defaults + overrides + (let* ((copy-base (copy-alist base))) + (mapc (-lambda ((key . value)) (setf (alist-get key copy-base nil nil #'string=) value)) overrides) + copy-base))) + +(defun lsp-semantic-tokens--type-faces-for (client) + "Return the semantic token type faces for CLIENT." + (lsp-semantic-tokens--apply-alist-overrides + lsp-semantic-token-faces + (plist-get (lsp--client-semantic-tokens-faces-overrides client) :types) + (plist-get (lsp--client-semantic-tokens-faces-overrides client) :discard-default-types))) + +(defun lsp-semantic-tokens--modifier-faces-for (client) + "Return the semantic token type faces for CLIENT." + (lsp-semantic-tokens--apply-alist-overrides + lsp-semantic-token-modifier-faces + (plist-get (lsp--client-semantic-tokens-faces-overrides client) :modifiers) + (plist-get (lsp--client-semantic-tokens-faces-overrides client) :discard-default-modifiers))) + +(defun lsp--semantic-tokens-on-refresh (workspace) + "Clear semantic tokens within all buffers of WORKSPACE, +refresh in currently active buffer." + (cl-assert (not (eq nil workspace))) + (when lsp-semantic-tokens-honor-refresh-requests + (cl-loop + for ws-buffer in (lsp--workspace-buffers workspace) do + (let ((fontify-immediately (equal (current-buffer) ws-buffer))) + (with-current-buffer ws-buffer (lsp--semantic-tokens-request nil fontify-immediately)))))) + +;;;###autoload +(defun lsp--semantic-tokens-initialize-workspace (workspace) + "Initialize semantic tokens for WORKSPACE." + (cl-assert workspace) + (-let (((&plist :token-types types :token-modifiers modifiers) + (lsp--semantic-tokens-as-defined-by-workspace workspace)) + (client (lsp--workspace-client workspace))) + (setf (lsp--workspace-semantic-tokens-faces workspace) + (lsp--semantic-tokens-build-face-map + types (lsp-semantic-tokens--type-faces-for client) + "semantic token" "lsp-semantic-token-faces")) + (setf (lsp--workspace-semantic-tokens-modifier-faces workspace) + (lsp--semantic-tokens-build-face-map + modifiers (lsp-semantic-tokens--modifier-faces-for client) + "semantic token modifier" "lsp-semantic-token-modifier-faces")))) + +;;;###autoload +(defun lsp-semantic-tokens--warn-about-deprecated-setting () + "Warn about deprecated semantic highlighting variable." + (when (boundp 'lsp-semantic-highlighting) + (pcase lsp-semantic-highlighting + (:semantic-tokens + (lsp-warn "It seems you wish to use semanticTokens-based + highlighting. To do so, please remove any references to the + deprecated variable `lsp-semantic-highlighting' from your + configuration and set `lsp-semantic-tokens-enable' to `t' + instead.") + (setq lsp-semantic-tokens-enable t)) + ((or :immediate :deferred) + (lsp-warn "It seems you wish to use Theia-based semantic + highlighting. This protocol has been superseded by the + semanticTokens protocol specified by LSP v3.16 and is no longer + supported by lsp-mode. If your language server provides + semanticToken support, please set + `lsp-semantic-tokens-enable' to `t' to use it."))))) + +;;;###autoload +(defun lsp-semantic-tokens--enable () + "Enable semantic tokens mode." + (when (and lsp-semantic-tokens-enable + (lsp-feature? "textDocument/semanticTokensFull")) + (lsp-semantic-tokens--warn-about-deprecated-setting) + (lsp-semantic-tokens-mode 1))) + +(defun lsp-semantic-tokens--disable () + "Disable semantic tokens mode." + (lsp-semantic-tokens-mode -1)) + +;;;###autoload +(define-minor-mode lsp-semantic-tokens-mode + "Toggle semantic-tokens support." + :group 'lsp-semantic-tokens + :global nil + (cond + ((and lsp-semantic-tokens-mode (lsp-feature? "textDocument/semanticTokensFull")) + (add-hook 'lsp-configure-hook #'lsp-semantic-tokens--enable nil t) + (add-hook 'lsp-unconfigure-hook #'lsp-semantic-tokens--disable nil t) + (mapc #'lsp--semantic-tokens-initialize-workspace + (lsp--find-workspaces-for "textDocument/semanticTokensFull")) + (lsp--semantic-tokens-initialize-buffer)) + (t + (remove-hook 'lsp-configure-hook #'lsp-semantic-tokens--enable t) + (remove-hook 'lsp-unconfigure-hook #'lsp-semantic-tokens--disable t) + (when lsp--semantic-tokens-teardown + (funcall lsp--semantic-tokens-teardown)) + (lsp-semantic-tokens--request-update) + (setq lsp--semantic-tokens-cache nil + lsp--semantic-tokens-teardown nil)))) + +;; debugging helpers +(defun lsp--semantic-tokens-verify () + "Store current token set and compare with the response to a full token request." + (interactive) + (let ((old-tokens (--> lsp--semantic-tokens-cache (plist-get it :response) (lsp-get it :data))) + (old-version (--> lsp--semantic-tokens-cache (plist-get it :_documentVersion)))) + (if (not (equal lsp--cur-version old-version)) + (message "Stored documentVersion %d differs from current version %d" old-version lsp--cur-version) + (lsp-request-async + "textDocument/semanticTokens/full" `(:textDocument ,(lsp--text-document-identifier)) + (lambda (response) + (let ((new-tokens (lsp-get response :data))) + (if (equal old-tokens new-tokens) + (message "New tokens (total count %d) are identical to previously held token set" + (length new-tokens)) + (message "Newly returned tokens differ from old token set") + (print old-tokens) + (print new-tokens)))) + :mode 'tick + :cancel-token (format "semantic-tokens-%s" (lsp--buffer-uri)))))) + +(defvar-local lsp-semantic-tokens--log '()) + +(defvar-local lsp-semantic-tokens--prev-response nil) + +(defun lsp-semantic-tokens--log-buffer-contents (tag) + "Log buffer contents for TAG." + (save-restriction + (save-excursion + (widen) (push `(:tag ,tag + :buffer-contents ,(buffer-substring (point-min) (point-max)) + :prev-response ,lsp-semantic-tokens--prev-response) + lsp-semantic-tokens--log)))) + +(defun lsp-semantic-tokens-enable-log () + "Enable logging of intermediate fontification states. + +This is a debugging tool, and may incur significant performance penalties." + (setq lsp-semantic-tokens--log '()) + (defun lsp-advice-tokens-fontify (orig-func old-fontify-region beg-orig end-orig &optional loudly) + (lsp-semantic-tokens--log-buffer-contents 'before) + (let ((result (funcall orig-func old-fontify-region beg-orig end-orig loudly))) + (lsp-semantic-tokens--log-buffer-contents 'after) + result)) + (advice-add 'lsp-semantic-tokens--fontify :around 'lsp-advice-tokens-fontify) + + (defun lsp-log-delta-response (response) + (setq lsp-semantic-tokens--prev-response `(:request-type "delta" + :response ,response + :version ,lsp--cur-version))) + (advice-add 'lsp--semantic-tokens-ingest-full/delta-response :before 'lsp-log-delta-response) + + (defun lsp-log-full-response (response) + (setq lsp-semantic-tokens--prev-response `(:request-type "full" + :response ,response + :version ,lsp--cur-version))) + (advice-add 'lsp--semantic-tokens-ingest-full-response :before 'lsp-log-full-response) + + (defun lsp-log-range-response (response) + (setq lsp-semantic-tokens--prev-response `(:request-type "range" + :response ,response + :version ,lsp--cur-version))) + (advice-add 'lsp--semantic-tokens-ingest-range-response :before 'lsp-log-range-response)) + +(defun lsp-semantic-tokens-disable-log () + "Disable logging of intermediate fontification states." + (advice-remove 'lsp-semantic-tokens--fontify 'lsp-advice-tokens-fontify) + (advice-remove 'lsp--semantic-tokens-ingest-full/delta-response 'lsp-log-delta-response) + (advice-remove 'lsp--semantic-tokens-ingest-full-response 'lsp-log-full-response) + (advice-remove 'lsp--semantic-tokens-ingest-range-response 'lsp-log-range-response)) + +(declare-function htmlize-buffer "ext:htmlize") + +(defun lsp-semantic-tokens-export-log () + "Write HTML-formatted snapshots of previous fontification results to /tmp." + (require 'htmlize) + (let* ((outdir (f-join "/tmp" "semantic-token-snapshots")) + (progress-reporter + (make-progress-reporter + (format "Writing buffer snapshots to %s..." outdir) + 0 (length lsp-semantic-tokens--log)))) + (f-mkdir outdir) + (--each-indexed (reverse lsp-semantic-tokens--log) + (-let* (((&plist :tag tag + :buffer-contents buffer-contents + :prev-response prev-response) it) + (html-buffer)) + ;; FIXME: doesn't update properly; sit-for helps... somewhat, + ;; but unreliably + (when (= (% it-index 5) 0) + (progress-reporter-update progress-reporter it-index) + (sit-for 0.01)) + ;; we're emitting 2 snapshots (before & after) per update, so request + ;; parameters should only change on every 2nd invocation + (when (cl-evenp it-index) + (with-temp-buffer + (insert (prin1-to-string prev-response)) + (write-file (f-join outdir (format "parameters_%d.el" (/ it-index 2)))))) + (with-temp-buffer + (insert buffer-contents) + (setq html-buffer (htmlize-buffer)) + (with-current-buffer html-buffer + ;; some configs such as emacs-doom may autoformat on save; switch to + ;; fundamental-mode to avoid this + (fundamental-mode) + (write-file (f-join outdir (format "buffer_%d_%s.html" (/ it-index 2) tag))))) + (kill-buffer html-buffer))) + (progress-reporter-done progress-reporter))) + +(lsp-consistency-check lsp-semantic-tokens) + +(provide 'lsp-semantic-tokens) +;;; lsp-semantic-tokens.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-semantic-tokens.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-semantic-tokens.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-semgrep.el b/emacs/elpa/lsp-mode-20241119.828/lsp-semgrep.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-semgrep.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-semgrep.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-sml.el b/emacs/elpa/lsp-mode-20241119.828/lsp-sml.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-sml.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-sml.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-solargraph.el b/emacs/elpa/lsp-mode-20241119.828/lsp-solargraph.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-solargraph.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-solargraph.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-solidity.el b/emacs/elpa/lsp-mode-20241119.828/lsp-solidity.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-solidity.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-solidity.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-sorbet.el b/emacs/elpa/lsp-mode-20241119.828/lsp-sorbet.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-sorbet.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-sorbet.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-sql.el b/emacs/elpa/lsp-mode-20241119.828/lsp-sql.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-sql.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-sql.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-sqls.el b/emacs/elpa/lsp-mode-20241119.828/lsp-sqls.el @@ -0,0 +1,201 @@ +;;; lsp-sqls.el --- SQL Client settings -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Shunya Ishii + +;; Author: Shunya Ishii +;; Keywords: sql lsp + +;; 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: + +;; LSP client for SQL + +;;; Code: + +(require 'lsp-mode) + +(defgroup lsp-sqls nil + "LSP support for SQL, using sqls." + :group 'lsp-mode + :link '(url-link "https://github.com/sqls-server/sqls") + :package-version `(lsp-mode . "7.0")) + +(defcustom lsp-sqls-server "sqls" + "Path to the `sqls` binary." + :group 'lsp-sqls + :risky t + :type 'file + :package-version `(lsp-mode . "7.0")) + +(defcustom lsp-sqls-workspace-config-path "workspace" + "If non-nil then setup workspace configuration with json file path." + :group 'lsp-sqls + :risky t + :type '(choice (const "workspace") + (const "root")) + :package-version `(lsp-mode . "7.0")) + +(defun lsp-sqls--make-launch-cmd () + (-let [base `(,lsp-sqls-server)] + ;; we can add some options to command. (e.g. "-config") + base)) + + +(defcustom lsp-sqls-timeout 0.5 + "Timeout to use for `sqls' requests." + :type 'number + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-sqls-connections nil + "The connections to the SQL server(s)." + :type '(repeat (alist :key-type (choice + (const :tag "Driver" driver) + (const :tag "Connection String" dataSourceName)) + :value-type string))) + +(defun lsp-sqls-setup-workspace-configuration () + "Setup workspace configuration using json file. +Depending on `lsp-sqls-workspace-config-path'." + + (if lsp-sqls-connections + (lsp--set-configuration `(:sqls (:connections ,(apply #'vector lsp-sqls-connections)))) + (when-let* ((config-json-path (cond + ((equal lsp-sqls-workspace-config-path "workspace") + ".sqls/config.json") + ((equal lsp-sqls-workspace-config-path "root") + (-> (lsp-workspace-root) + (f-join ".sqls/config.json")))))) + (when (file-exists-p config-json-path) + (lsp--set-configuration (lsp--read-json-file config-json-path)))))) + +(defun lsp-sqls--show-results (result) + (with-current-buffer (get-buffer-create "*sqls results*") + (with-help-window (buffer-name) + (erase-buffer) + (insert result)))) + +(defun lsp-sql-execute-query (&optional command start end) + "Execute COMMAND on buffer text against current database. +Buffer text is between START and END. If START and END are nil, +use the current region if set, otherwise the entire buffer." + (interactive) + (lsp-sqls--show-results + (lsp-request + "workspace/executeCommand" + (list :command "executeQuery" + :arguments (or + (when command + (lsp:command-arguments? command)) + (vector (lsp--buffer-uri))) + :timeout lsp-sqls-timeout + :range (list + :start (lsp--point-to-position + (cond + (start start) + ((use-region-p) (region-beginning)) + (t (point-min)))) + :end (lsp--point-to-position + (cond + (end end) + ((use-region-p) (region-end)) + (t (point-max))))))))) + +(defun lsp-sql-execute-paragraph (&optional command) + "Execute COMMAND on paragraph against current database." + (interactive) + (let ((start (save-excursion (backward-paragraph) (point))) + (end (save-excursion (forward-paragraph) (point)))) + (lsp-sql-execute-query command start end))) + +(defun lsp-sql-show-databases (&optional _command) + "Show databases." + (interactive) + (lsp-sqls--show-results + (lsp-request + "workspace/executeCommand" + (list :command "showDatabases" :timeout lsp-sqls-timeout)))) + +(defun lsp-sql-show-schemas (&optional _command) + "Show schemas." + (interactive) + (lsp-sqls--show-results + (lsp-request + "workspace/executeCommand" + (list :command "showSchemas" :timeout lsp-sqls-timeout)))) + +(defun lsp-sql-show-connections (&optional _command) + "Show connections." + (interactive) + (lsp-sqls--show-results + (lsp-request + "workspace/executeCommand" + (list :command "showConnections" :timeout lsp-sqls-timeout)))) + +(defun lsp-sql-show-tables (&optional _command) + "Show tables." + (interactive) + (lsp-sqls--show-results + (lsp-request + "workspace/executeCommand" + (list :command "showTables" :timeout lsp-sqls-timeout)))) + +(defun lsp-sql-switch-database (&optional _command) + "Switch database." + (interactive) + (lsp-workspace-command-execute + "switchDatabase" + (vector (completing-read + "Select database: " + (s-lines (lsp-workspace-command-execute "showDatabases")) + nil + t)))) + +(defun lsp-sql-switch-connection (&optional _command) + "Switch connection." + (interactive) + (lsp-workspace-command-execute + "switchConnections" + (vector (cl-first + (s-match "\\([[:digit:]]*\\)" + (completing-read + "Select connection: " + (s-lines (lsp-workspace-command-execute "showConnections")) + nil + t)))))) + +(lsp-register-client + (make-lsp-client :new-connection (lsp-stdio-connection #'lsp-sqls--make-launch-cmd) + :major-modes '(sql-mode) + :priority -2 + :action-handlers (ht ("executeParagraph" #'lsp-sql-execute-paragraph) + ("executeQuery" #'lsp-sql-execute-query) + ("showDatabases" #'lsp-sql-show-databases) + ("showSchemas" #'lsp-sql-show-schemas) + ("showConnections" #'lsp-sql-show-connections) + ("showTables" #'lsp-sql-show-tables) + ("switchDatabase" #'lsp-sql-switch-database) + ("switchConnections" #'lsp-sql-switch-connection)) + :server-id 'sqls + :initialized-fn (lambda (workspace) + (-> workspace + (lsp--workspace-server-capabilities) + (lsp:set-server-capabilities-execute-command-provider? t)) + (with-lsp-workspace workspace + (lsp-sqls-setup-workspace-configuration))))) + +(lsp-consistency-check lsp-sqls) + +(provide 'lsp-sqls) +;;; lsp-sqls.el ends here diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-sqls.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-sqls.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-steep.el b/emacs/elpa/lsp-mode-20241119.828/lsp-steep.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-steep.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-steep.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-svelte.el b/emacs/elpa/lsp-mode-20241119.828/lsp-svelte.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-svelte.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-svelte.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-terraform.el b/emacs/elpa/lsp-mode-20241119.828/lsp-terraform.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-terraform.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-terraform.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-tex.el b/emacs/elpa/lsp-mode-20241119.828/lsp-tex.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-tex.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-tex.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-tilt.el b/emacs/elpa/lsp-mode-20241119.828/lsp-tilt.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-tilt.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-tilt.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-toml.el b/emacs/elpa/lsp-mode-20241119.828/lsp-toml.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-toml.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-toml.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-trunk.el b/emacs/elpa/lsp-mode-20241119.828/lsp-trunk.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-trunk.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-trunk.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-ttcn3.el b/emacs/elpa/lsp-mode-20241119.828/lsp-ttcn3.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-ttcn3.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-ttcn3.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-typeprof.el b/emacs/elpa/lsp-mode-20241119.828/lsp-typeprof.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-typeprof.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-typeprof.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-typespec.el b/emacs/elpa/lsp-mode-20241119.828/lsp-typespec.el @@ -0,0 +1,87 @@ +;;; lsp-typespec.el --- Typespec Client settings -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 jeremy.ymeng@gmail.com + +;; Author: Jeremy Meng <jeremy.ymeng@gmail.com> +;; Keywords: languages,tools + +;; 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: + +;; lsp-typespec client + +;;; Code: + +(require 'lsp-mode) +(require 'lsp-semantic-tokens) + +(defgroup lsp-typespec nil + "LSP support for Typespec." + :link '(url-link "https://github.com/microsoft/typespec/blob/9c95ccda8c84c7c6afa24b2f4b21cf1ecbe680dd/packages/compiler/cmd/tsp-server.js") + :group 'lsp-mode + :tag "Lsp Typespec") + +(defcustom lsp-typespec-custom-server-command nil + "The typespec-lisp server command." + :group 'lsp-typespec + :risky t + :type '(repeat string)) + +(lsp-dependency + 'typespec-lsp + '(:npm :package "@typespec/compiler" + :path "tsp-server") + '(:system "tsp-server")) + +(defun lsp-typespec--server-executable-path () + "Return the typespec-lsp server command." + (or + (when-let* ((workspace-folder (lsp-find-session-folder (lsp-session) default-directory))) + (let ((tsp-server-local-path (f-join workspace-folder "node_modules" ".bin" + (if (eq system-type 'windows-nt) "tsp-server.cmd" "tsp-server")))) + (when (f-exists? tsp-server-local-path) + tsp-server-local-path))) + (executable-find "tsp-server") + (lsp-package-path 'tsp-server) + "tsp-server")) + +(lsp-register-client + (make-lsp-client + :semantic-tokens-faces-overrides '(:types (("docCommentTag" . font-lock-keyword-face) + ("event" . default))) + :new-connection (lsp-stdio-connection `(,(lsp-typespec--server-executable-path) "--stdio")) + :activation-fn (lsp-activate-on "typespec") + :major-modes '(typespec-mode) + :server-id 'typespec-lsp)) + +(lsp-consistency-check lsp-typespec) + +(defun lsp-typespec-semantic-tokens-refresh (&rest _) + "Force refresh semantic tokens." + (when-let* ((workspace (and lsp-semantic-tokens-enable + (lsp-find-workspace 'typespec-lsp (buffer-file-name))))) + (--each (lsp--workspace-buffers workspace) + (when (lsp-buffer-live-p it) + (lsp-with-current-buffer it + (lsp-semantic-tokens--enable)))))) + +(with-eval-after-load 'typespec + (when lsp-semantic-tokens-enable + ;; refresh tokens + (add-hook 'typespec-mode-hook #'lsp-typespec-semantic-tokens-refresh))) + +(provide 'lsp-typespec) +;;; lsp-typespec.el ends here + diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-typespec.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-typespec.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-v.el b/emacs/elpa/lsp-mode-20241119.828/lsp-v.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-v.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-v.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-vala.el b/emacs/elpa/lsp-mode-20241119.828/lsp-vala.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-vala.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-vala.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-verilog.el b/emacs/elpa/lsp-mode-20241119.828/lsp-verilog.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-verilog.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-verilog.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-vetur.el b/emacs/elpa/lsp-mode-20241119.828/lsp-vetur.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-vetur.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-vetur.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-vhdl.el b/emacs/elpa/lsp-mode-20241119.828/lsp-vhdl.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-vhdl.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-vhdl.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-vimscript.el b/emacs/elpa/lsp-mode-20241119.828/lsp-vimscript.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-vimscript.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-vimscript.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-volar.el b/emacs/elpa/lsp-mode-20241119.828/lsp-volar.el @@ -0,0 +1,152 @@ +;;; lsp-volar.el --- A lsp-mode client for Vue3 -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2021 JadeStrong +;; +;; Author: JadeStrong <https://github.com/jadestrong> +;; Maintainer: JadeStrong <jadestrong@163.com> +;; Created: November 08, 2021 +;; Modified: November 08, 2021 +;; Keywords: abbrev bib c calendar comm convenience data docs emulations extensions faces files frames games hardware help hypermedia i18n internal languages lisp local maint mail matching mouse multimedia news outlines processes terminals tex tools unix vc wp +;; Homepage: https://github.com/jadestrong/lsp-volar +;; Package-Requires: ((emacs "25.1")) +;; +;; This file is not part of GNU Emacs. + +;; This file 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. + +;; For a full copy of the GNU General Public License +;; see <http://www.gnu.org/licenses/>. + +;; +;;; Commentary: +;; +;; provide the connection to lsp-mode and volar language server +;; +;;; Code: +(require 'lsp-mode) +(require 'json) + +(defgroup lsp-volar nil + "Lsp support for vue3." + :group 'lsp-mode + :link '(url-link "https://github.com/vuejs/language-tools") + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-volar-take-over-mode t + "Enable Take Over Mode." + :type 'boolean + :group 'lsp-volar + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-volar-hybrid-mode nil + "Enable Hybrid Mode." + :type 'boolean + :group 'lsp-volar + :package-version '(lsp-mode . "9.0.1")) + +(defcustom lsp-volar-activate-file ".volarrc" + "A file with a custom name placed in WORKSPACE-ROOT is used to force enable + volar when there is no package.json in the WORKSPACE-ROOT." + :type 'string + :group 'lsp-volar + :package-version '(lsp-mode . "9.0.0")) + +(defconst lsp-volar--is-windows (memq system-type '(cygwin windows-nt ms-dos))) +(defun lsp-volar-get-typescript-tsdk-path () + "Get tsserver lib*.d.ts directory path." + (if-let* ((package-path (lsp-package-path 'typescript)) + (system-tsdk-path (f-join (file-truename package-path) + (if lsp-volar--is-windows + "../node_modules/typescript/lib" + "../../lib"))) + ((file-exists-p system-tsdk-path))) + system-tsdk-path + (prog1 "" + (lsp--error "[lsp-volar] Typescript is not detected correctly. Please ensure the npm package typescript is installed in your project or system (npm install -g typescript), otherwise open an issue")))) + +(lsp-dependency 'typescript + '(:system "tsserver") + '(:npm :package "typescript" + :path "tsserver")) + +(lsp-dependency 'volar-language-server + '(:system "vue-language-server") + '(:npm :package "@vue/language-server" :path "vue-language-server")) + +(lsp-register-custom-settings + '(("typescript.tsdk" + (lambda () + (if-let* ((project-root (lsp-workspace-root)) + (tsdk-path (f-join project-root "node_modules/typescript/lib")) + ((file-exists-p tsdk-path))) + tsdk-path + (lsp-volar-get-typescript-tsdk-path))) + t))) + +(lsp-register-custom-settings + '(("vue.hybridMode" lsp-volar-hybrid-mode t))) + +(defun lsp-volar--vue-project-p (workspace-root) + "Check if the `Vue' package is present in the package.json file +in the WORKSPACE-ROOT." + (if-let* ((package-json (f-join workspace-root "package.json")) + (exist (f-file-p package-json)) + (config (json-read-file package-json)) + (dependencies (alist-get 'dependencies config))) + (alist-get 'vue (append dependencies (alist-get 'devDependencies config))) + nil)) + +(defun lsp-volar--activate-p (filename &optional _) + "Check if the volar-language-server should be enabled base on FILENAME." + (if lsp-volar-take-over-mode + (or (or + (and (lsp-workspace-root) (lsp-volar--vue-project-p (lsp-workspace-root))) + (and (lsp-workspace-root) lsp-volar-activate-file (f-file-p (f-join (lsp-workspace-root) lsp-volar-activate-file)))) + (or (or (string-match-p "\\.mjs\\|\\.[jt]sx?\\'" filename) + (and (derived-mode-p 'js-mode 'typescript-mode 'typescript-ts-mode) + (not (derived-mode-p 'json-mode)))) + (string= (file-name-extension filename) "vue"))) + (string= (file-name-extension filename) "vue"))) + +(lsp-register-client + (make-lsp-client + :new-connection (lsp-stdio-connection + (lambda () + `(,(lsp-package-path 'volar-language-server) "--stdio"))) + :activation-fn 'lsp-volar--activate-p + :priority 0 + :multi-root nil + :server-id 'vue-semantic-server + :initialization-options (lambda () (ht-merge (lsp-configuration-section "typescript") + (lsp-configuration-section "vue") + (ht ("serverMode" 0) + ("diagnosticModel" 1) + ("textDocumentSync" 2)))) + :initialized-fn (lambda (workspace) + (with-lsp-workspace workspace + (lsp--server-register-capability + (lsp-make-registration + :id "random-id" + :method "workspace/didChangeWatchedFiles" + :register-options? (lsp-make-did-change-watched-files-registration-options + :watchers + `[,(lsp-make-file-system-watcher :glob-pattern "**/*.js") + ,(lsp-make-file-system-watcher :glob-pattern "**/*.ts") + ,(lsp-make-file-system-watcher :glob-pattern "**/*.vue") + ,(lsp-make-file-system-watcher :glob-pattern "**/*.jsx") + ,(lsp-make-file-system-watcher :glob-pattern "**/*.tsx") + ,(lsp-make-file-system-watcher :glob-pattern "**/*.json")]))))) + :download-server-fn (lambda (_client callback error-callback _update?) + (lsp-package-ensure 'volar-language-server + callback error-callback)))) + +(provide 'lsp-volar) +;;; lsp-volar.el ends here diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-volar.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-volar.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-wgsl.el b/emacs/elpa/lsp-mode-20241119.828/lsp-wgsl.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-wgsl.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-wgsl.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-xml.el b/emacs/elpa/lsp-mode-20241119.828/lsp-xml.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-xml.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-xml.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-yaml.el b/emacs/elpa/lsp-mode-20241119.828/lsp-yaml.el @@ -0,0 +1,247 @@ +;;; lsp-yaml.el --- LSP YAML server integration -*- lexical-binding: t; -*- + +;; Copyright (C) 2019 Aya Igarashi + +;; Author: Aya Igarashi <ladiclexxx@gmail.com> +;; Keywords: + +;; 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: + +;; + +;;; Code: + +(require 'lsp-mode) +(require 'dash) + +(defgroup lsp-yaml nil + "LSP support for YAML, using yaml-language-server." + :group 'lsp-mode + :link '(url-link "https://github.com/redhat-developer/yaml-language-server") + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-yaml-format-enable t + "Enable/disable default YAML formatter." + :type 'boolean + :group 'lsp-yaml + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-yaml-single-quote nil + "Use single quote instead of double quotes." + :type 'boolean + :group 'lsp-yaml + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-yaml-bracket-spacing t + "Print spaces between brackets in objects." + :type 'boolean + :group 'lsp-yaml + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-yaml-prose-wrap "preserve" + "Options for prose-wrap. + Always: wrap prose if it exceeds the print width. + Never: never wrap the prose. + Preserve: wrap prose as-is." + :type '(choice + (const "always") + (const "never") + (const "preserve")) + :group 'lsp-yaml + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-yaml-print-width 80 + "Specify the line length that the printer will wrap on." + :type 'number + :group 'lsp-yaml + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-yaml-validate t + "Enable/disable validation feature." + :type 'boolean + :group 'lsp-yaml + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-yaml-hover t + "Enable/disable hover feature." + :type 'boolean + :group 'lsp-yaml + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-yaml-completion t + "Enable/disable completion feature." + :type 'boolean + :group 'lsp-yaml + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-yaml-schemas '() + "Associate schemas to YAML files in a glob pattern." + :type '(alist :key-type (symbol :tag "schema") :value-type (lsp-string-vector :tag "files (glob)")) + :group 'lsp-yaml + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-yaml-schema-store-enable t + "Enable/disable JSON Schema store. When set to true, available YAML + schemas will be automatically pulled from the store." + :type 'boolean + :group 'lsp-yaml + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-yaml-custom-tags nil + "Custom tags for the parser to use." + :type '(lsp-repeatable-vector string) + :group 'lsp-yaml + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-yaml-schema-store-uri "https://www.schemastore.org/api/json/catalog.json" + "URL of schema store catalog to use." + :type 'string + :group 'lsp-yaml) + +(defcustom lsp-yaml-schema-store-local-db (expand-file-name + (locate-user-emacs-file + (f-join ".cache" "lsp" "lsp-yaml-schemas.json"))) + "Cached database of schema store." + :type 'file + :group 'lsp-yaml) + +(defcustom lsp-yaml-max-items-computed 5000 + "The maximum number of outline symbols and folding regions computed. +Limited for performance reasons." + :type 'number + :group 'lsp-yaml + :package-version '(lsp-mode . "8.0.0")) + + +(defvar lsp-yaml--schema-store-schemas-alist nil + "A list of schemas fetched from schema stores.") + +(lsp-register-custom-settings + '(("yaml.format.enable" lsp-yaml-format-enable t) + ("yaml.format.singleQuote" lsp-yaml-single-quote t) + ("yaml.format.bracketSpacing" lsp-yaml-bracket-spacing) + ("yaml.format.proseWrap" lsp-yaml-prose-wrap) + ("yaml.format.printWidth" lsp-yaml-print-width) + ("yaml.validate" lsp-yaml-validate t) + ("yaml.hover" lsp-yaml-hover t) + ("yaml.completion" lsp-yaml-completion t) + ("yaml.schemas" lsp-yaml-schemas) + ("yaml.schemaStore.enable" lsp-yaml-schema-store-enable t) + ("yaml.schemaStore.url" lsp-yaml-schema-store-uri) + ("yaml.customTags" lsp-yaml-custom-tags) + ("yaml.maxItemsComputed" lsp-yaml-max-items-computed))) + +(defcustom lsp-yaml-server-command '("yaml-language-server" "--stdio") + "Command to start yaml-languageserver." + :type '(repeat string) + :group 'lsp-yaml + :package-version '(lsp-mode . "6.2")) + +(lsp-dependency 'yaml-language-server + '(:system "yaml-language-server") + '(:npm :package "yaml-language-server" + :path "yaml-language-server")) + +(lsp-register-client + (make-lsp-client :new-connection (lsp-stdio-connection + (lambda () + `(,(or (executable-find (cl-first lsp-yaml-server-command)) + (lsp-package-path 'yaml-language-server)) + ,@(cl-rest lsp-yaml-server-command)))) + :activation-fn (lsp-activate-on "yaml") + :priority 0 + :server-id 'yamlls + :initialized-fn (lambda (workspace) + (with-lsp-workspace workspace + (lsp--set-configuration + (lsp-configuration-section "yaml")))) + :download-server-fn (lambda (_client callback error-callback _update?) + (lsp-package-ensure 'yaml-language-server + callback error-callback)))) + +(defcustom lsp-yaml-schema-extensions '(((name . "Kubernetes v1.30.3") + (description . "Kubernetes v1.30.3 manifest schema definition") + (url . "https://raw.githubusercontent.com/yannh/kubernetes-json-schema/master/v1.30.3-standalone-strict/all.json") + (fileMatch . ["*-k8s.yaml" "*-k8s.yml"]))) + "User defined schemas that extend default schema store. +Used in `lsp-yaml--get-supported-schemas' to supplement schemas provided by +`lsp-yaml-schema-store-uri'." + :type '(list alist) + :group 'lsp-yaml + :package-version '(lsp-mode . "9.0.1")) + +(defun lsp-yaml-download-schema-store-db (&optional force-downloading) + "Download remote schema store at `lsp-yaml-schema-store-uri' into local cache. +Set FORCE-DOWNLOADING to non-nil to force re-download the database." + (interactive "P") + (when (or force-downloading (not (file-exists-p lsp-yaml-schema-store-local-db))) + (unless (file-directory-p (file-name-directory lsp-yaml-schema-store-local-db)) + (mkdir (file-name-directory lsp-yaml-schema-store-local-db) t)) + (url-copy-file lsp-yaml-schema-store-uri lsp-yaml-schema-store-local-db force-downloading))) + +(defun lsp-yaml--get-supported-schemas () + "Get out the list of supported schemas." + (when (and lsp-yaml-schema-store-enable + (not lsp-yaml--schema-store-schemas-alist)) + (lsp-yaml-download-schema-store-db) + (setq lsp-yaml--schema-store-schemas-alist + (alist-get 'schemas (json-read-file lsp-yaml-schema-store-local-db)))) + (seq-concatenate 'list lsp-yaml-schema-extensions lsp-yaml--schema-store-schemas-alist)) + +(defun lsp-yaml-set-buffer-schema (uri-string) + "Set yaml schema for the current buffer to URI-STRING." + (interactive "MURI: ") + (let* ((uri (intern uri-string)) + (workspace-path (file-relative-name + (lsp--uri-to-path (lsp--buffer-uri)) + (lsp-workspace-root (lsp--buffer-uri)))) + (glob (concat "/" workspace-path)) + (current-config (assoc uri lsp-yaml-schemas)) + (current-patterns (and current-config (cdr current-config)))) + (if current-config + (or (member glob (append current-patterns nil)) + (setq lsp-yaml-schemas + (cl-acons uri + (vconcat (vector glob) current-patterns) + (assq-delete-all uri + (mapcar (lambda (x) (lsp-yaml--remove-glob x glob)) + lsp-yaml-schemas))))) + (setq lsp-yaml-schemas + (cl-acons uri (vector glob) (mapcar (lambda (x) (lsp-yaml--remove-glob x glob)) + lsp-yaml-schemas)))) + (lsp--set-configuration (lsp-configuration-section "yaml")))) + +(defun lsp-yaml-select-buffer-schema () + "Select schema for the current buffer based on the list of supported schemas." + (interactive) + (let* ((schema (lsp--completing-read "Select buffer schema: " + (lsp-yaml--get-supported-schemas) + (lambda (schema) + (format "%s: %s" (alist-get 'name schema)(alist-get 'description schema))) + nil t)) + (uri (alist-get 'url schema))) + (lsp-yaml-set-buffer-schema uri))) + +(defun lsp-yaml--remove-glob (mapping glob) + (let ((patterns (cdr mapping))) + (cons (car mapping) + (vconcat (-filter (lambda (p) (not (equal p glob))) + (append patterns nil)) nil)))) + +(lsp-consistency-check lsp-yaml) + +(provide 'lsp-yaml) +;;; lsp-yaml.el ends here diff --git a/emacs/elpa/lsp-mode-20241119.828/lsp-yaml.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-yaml.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-yang.el b/emacs/elpa/lsp-mode-20241119.828/lsp-yang.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-yang.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-yang.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-zig.el b/emacs/elpa/lsp-mode-20241119.828/lsp-zig.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp-zig.elc b/emacs/elpa/lsp-mode-20241119.828/lsp-zig.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp.el b/emacs/elpa/lsp-mode-20241119.828/lsp.el diff --git a/emacs/elpa/lsp-mode-20241113.743/lsp.elc b/emacs/elpa/lsp-mode-20241119.828/lsp.elc Binary files differ. diff --git a/emacs/elpa/markdown-mode-20241117.307/markdown-mode-autoloads.el b/emacs/elpa/markdown-mode-20241117.1510/markdown-mode-autoloads.el diff --git a/emacs/elpa/markdown-mode-20241117.1510/markdown-mode-pkg.el b/emacs/elpa/markdown-mode-20241117.1510/markdown-mode-pkg.el @@ -0,0 +1,10 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "markdown-mode" "20241117.1510" + "Major mode for Markdown-formatted text." + '((emacs "27.1")) + :url "https://github.com/jrblevin/markdown-mode" + :commit "b8637bae075231d70fe7f845305eaba2c0240d89" + :revdesc "b8637bae0752" + :keywords '("markdown" "github flavored markdown" "itex") + :authors '(("Jason R. Blevins" . "jblevins@xbeta.org")) + :maintainers '(("Jason R. Blevins" . "jblevins@xbeta.org"))) diff --git a/emacs/elpa/markdown-mode-20241117.1510/markdown-mode.el b/emacs/elpa/markdown-mode-20241117.1510/markdown-mode.el @@ -0,0 +1,10399 @@ +;;; markdown-mode.el --- Major mode for Markdown-formatted text -*- lexical-binding: t; -*- + +;; Copyright (C) 2007-2023 Jason R. Blevins and markdown-mode +;; contributors (see the commit log for details). + +;; Author: Jason R. Blevins <jblevins@xbeta.org> +;; Maintainer: Jason R. Blevins <jblevins@xbeta.org> +;; Created: May 24, 2007 +;; Package-Version: 20241117.1510 +;; Package-Revision: b8637bae0752 +;; Package-Requires: ((emacs "27.1")) +;; Keywords: Markdown, GitHub Flavored Markdown, itex +;; URL: https://jblevins.org/projects/markdown-mode/ + +;; 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 this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; See the README.md file for details. + + +;;; Code: + +(require 'easymenu) +(require 'outline) +(require 'thingatpt) +(require 'cl-lib) +(require 'url-parse) +(require 'button) +(require 'color) +(require 'rx) +(require 'subr-x) + +(defvar jit-lock-start) +(defvar jit-lock-end) +(defvar flyspell-generic-check-word-predicate) +(defvar electric-pair-pairs) +(defvar sh-ancestor-alist) + +(declare-function project-roots "project") +(declare-function sh-set-shell "sh-script") +(declare-function mailcap-file-name-to-mime-type "mailcap") +(declare-function dnd-get-local-file-name "dnd") + +;; for older emacs<29 +(declare-function mailcap-mime-type-to-extension "mailcap") +(declare-function file-name-with-extension "files") +(declare-function yank-media-handler "yank-media") + + +;;; Constants ================================================================= + +(defconst markdown-mode-version "2.7-alpha" + "Markdown mode version number.") + +(defconst markdown-output-buffer-name "*markdown-output*" + "Name of temporary buffer for markdown command output.") + + +;;; Global Variables ========================================================== + +(defvar markdown-reference-label-history nil + "History of used reference labels.") + +(defvar markdown-live-preview-mode nil + "Sentinel variable for command `markdown-live-preview-mode'.") + +(defvar markdown-gfm-language-history nil + "History list of languages used in the current buffer in GFM code blocks.") + +(defvar markdown-follow-link-functions nil + "Functions used to follow a link. +Each function is called with one argument, the link's URL. It +should return non-nil if it followed the link, or nil if not. +Functions are called in order until one of them returns non-nil; +otherwise the default link-following function is used.") + + +;;; Customizable Variables ==================================================== + +(defvar markdown-mode-hook nil + "Hook run when entering Markdown mode.") + +(defvar markdown-before-export-hook nil + "Hook run before running Markdown to export XHTML output. +The hook may modify the buffer, which will be restored to it's +original state after exporting is complete.") + +(defvar markdown-after-export-hook nil + "Hook run after XHTML output has been saved. +Any changes to the output buffer made by this hook will be saved.") + +(defgroup markdown nil + "Major mode for editing text files in Markdown format." + :prefix "markdown-" + :group 'text + :link '(url-link "https://jblevins.org/projects/markdown-mode/")) + +(defcustom markdown-command (let ((command (cl-loop for cmd in '("markdown" "pandoc" "markdown_py") + when (executable-find cmd) + return (file-name-nondirectory it)))) + (or command "markdown")) + "Command to run markdown." + :group 'markdown + :type '(choice (string :tag "Shell command") (repeat (string)) function)) + +(defcustom markdown-command-needs-filename nil + "Set to non-nil if `markdown-command' does not accept input from stdin. +Instead, it will be passed a filename as the final command line +option. As a result, you will only be able to run Markdown from +buffers which are visiting a file." + :group 'markdown + :type 'boolean) + +(defcustom markdown-open-command nil + "Command used for opening Markdown files directly. +For example, a standalone Markdown previewer. This command will +be called with a single argument: the filename of the current +buffer. It can also be a function, which will be called without +arguments." + :group 'markdown + :type '(choice file function (const :tag "None" nil))) + +(defcustom markdown-open-image-command nil + "Command used for opening image files directly. +This is used at `markdown-follow-link-at-point'." + :group 'markdown + :type '(choice file function (const :tag "None" nil))) + +(defcustom markdown-hr-strings + '("-------------------------------------------------------------------------------" + "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *" + "---------------------------------------" + "* * * * * * * * * * * * * * * * * * * *" + "---------" + "* * * * *") + "Strings to use when inserting horizontal rules. +The first string in the list will be the default when inserting a +horizontal rule. Strings should be listed in decreasing order of +prominence (as in headings from level one to six) for use with +promotion and demotion functions." + :group 'markdown + :type '(repeat string)) + +(defcustom markdown-bold-underscore nil + "Use two underscores when inserting bold text instead of two asterisks." + :group 'markdown + :type 'boolean) + +(defcustom markdown-italic-underscore nil + "Use underscores when inserting italic text instead of asterisks." + :group 'markdown + :type 'boolean) + +(defcustom markdown-marginalize-headers nil + "When non-nil, put opening atx header markup in a left margin. + +This setting goes well with `markdown-asymmetric-header'. But +sadly it conflicts with `linum-mode' since they both use the +same margin." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-marginalize-headers-margin-width 6 + "Character width of margin used for marginalized headers. +The default value is based on there being six heading levels +defined by Markdown and HTML. Increasing this produces extra +whitespace on the left. Decreasing it may be preferred when +fewer than six nested heading levels are used." + :group 'markdown + :type 'integer + :safe 'natnump + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-asymmetric-header nil + "Determines if atx header style will be asymmetric. +Set to a non-nil value to use asymmetric header styling, placing +header markup only at the beginning of the line. By default, +balanced markup will be inserted at the beginning and end of the +line around the header title." + :group 'markdown + :type 'boolean) + +(defcustom markdown-indent-function 'markdown-indent-line + "Function to use to indent." + :group 'markdown + :type 'function) + +(defcustom markdown-indent-on-enter t + "Determines indentation behavior when pressing \\[newline]. +Possible settings are nil, t, and \\='indent-and-new-item. + +When non-nil, pressing \\[newline] will call `newline-and-indent' +to indent the following line according to the context using +`markdown-indent-function'. In this case, note that +\\[electric-newline-and-maybe-indent] can still be used to insert +a newline without indentation. + +When set to \\='indent-and-new-item and the point is in a list item +when \\[newline] is pressed, the list will be continued on the next +line, where a new item will be inserted. + +When set to nil, simply call `newline' as usual. In this case, +you can still indent lines using \\[markdown-cycle] and continue +lists with \\[markdown-insert-list-item]. + +Note that this assumes the variable `electric-indent-mode' is +non-nil (enabled). When it is *disabled*, the behavior of +\\[newline] and `\\[electric-newline-and-maybe-indent]' are +reversed." + :group 'markdown + :type '(choice (const :tag "Don't automatically indent" nil) + (const :tag "Automatically indent" t) + (const :tag "Automatically indent and insert new list items" indent-and-new-item))) + +(defcustom markdown-enable-wiki-links nil + "Syntax highlighting for wiki links. +Set this to a non-nil value to turn on wiki link support by default. +Support can be toggled later using the `markdown-toggle-wiki-links' +function or \\[markdown-toggle-wiki-links]." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.2")) + +(defcustom markdown-wiki-link-alias-first t + "When non-nil, treat aliased wiki links like [[alias text|PageName]]. +Otherwise, they will be treated as [[PageName|alias text]]." + :group 'markdown + :type 'boolean + :safe 'booleanp) + +(defcustom markdown-wiki-link-search-subdirectories nil + "When non-nil, search for wiki link targets in subdirectories. +This is the default search behavior for GitHub and is +automatically set to t in `gfm-mode'." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.2")) + +(defcustom markdown-wiki-link-search-parent-directories nil + "When non-nil, search for wiki link targets in parent directories. +This is the default search behavior of Ikiwiki." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.2")) + +(defcustom markdown-wiki-link-search-type nil + "Searching type for markdown wiki link. + +sub-directories: search for wiki link targets in sub directories +parent-directories: search for wiki link targets in parent directories +project: search for wiki link targets under project root" + :group 'markdown + :type '(set + (const :tag "search wiki link from subdirectories" sub-directories) + (const :tag "search wiki link from parent directories" parent-directories) + (const :tag "search wiki link under project root" project)) + :package-version '(markdown-mode . "2.5")) + +(make-obsolete-variable 'markdown-wiki-link-search-subdirectories 'markdown-wiki-link-search-type "2.5") +(make-obsolete-variable 'markdown-wiki-link-search-parent-directories 'markdown-wiki-link-search-type "2.5") + +(defcustom markdown-wiki-link-fontify-missing nil + "When non-nil, change wiki link face according to existence of target files. +This is expensive because it requires checking for the file each time the buffer +changes or the user switches windows. It is disabled by default because it may +cause lag when typing on slower machines." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.2")) + +(defcustom markdown-uri-types + '("acap" "cid" "data" "dav" "fax" "file" "ftp" + "geo" "gopher" "http" "https" "imap" "ldap" "mailto" + "mid" "message" "modem" "news" "nfs" "nntp" + "pop" "prospero" "rtsp" "service" "sip" "tel" + "telnet" "tip" "urn" "vemmi" "wais") + "Link types for syntax highlighting of URIs." + :group 'markdown + :type '(repeat (string :tag "URI scheme"))) + +(defcustom markdown-url-compose-char + '(?∞ ?… ?⋯ ?# ?★ ?⚓) + "Placeholder character for hidden URLs. +This may be a single character or a list of characters. In case +of a list, the first one that satisfies `char-displayable-p' will +be used." + :type '(choice + (character :tag "Single URL replacement character") + (repeat :tag "List of possible URL replacement characters" + character)) + :package-version '(markdown-mode . "2.3")) + +(defcustom markdown-blockquote-display-char + '("▌" "┃" ">") + "String to display when hiding blockquote markup. +This may be a single string or a list of string. In case of a +list, the first one that satisfies `char-displayable-p' will be +used." + :type '(choice + (string :tag "Single blockquote display string") + (repeat :tag "List of possible blockquote display strings" string)) + :package-version '(markdown-mode . "2.3")) + +(defcustom markdown-hr-display-char + '(?─ ?━ ?-) + "Character for hiding horizontal rule markup. +This may be a single character or a list of characters. In case +of a list, the first one that satisfies `char-displayable-p' will +be used." + :group 'markdown + :type '(choice + (character :tag "Single HR display character") + (repeat :tag "List of possible HR display characters" character)) + :package-version '(markdown-mode . "2.3")) + +(defcustom markdown-definition-display-char + '(?⁘ ?⁙ ?≡ ?⌑ ?◊ ?:) + "Character for replacing definition list markup. +This may be a single character or a list of characters. In case +of a list, the first one that satisfies `char-displayable-p' will +be used." + :type '(choice + (character :tag "Single definition list character") + (repeat :tag "List of possible definition list characters" character)) + :package-version '(markdown-mode . "2.3")) + +(defcustom markdown-enable-math nil + "Syntax highlighting for inline LaTeX and itex expressions. +Set this to a non-nil value to turn on math support by default. +Math support can be enabled, disabled, or toggled later using +`markdown-toggle-math' or \\[markdown-toggle-math]." + :group 'markdown + :type 'boolean + :safe 'booleanp) +(make-variable-buffer-local 'markdown-enable-math) + +(defcustom markdown-enable-html t + "Enable font-lock support for HTML tags and attributes." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-enable-highlighting-syntax nil + "Enable highlighting syntax." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.5")) + +(defcustom markdown-css-paths nil + "List of URLs of CSS files to link to in the output XHTML." + :group 'markdown + :safe (lambda (x) (and (listp x) (cl-every #'stringp x))) + :type '(repeat (string :tag "CSS File Path"))) + +(defcustom markdown-content-type "text/html" + "Content type string for the http-equiv header in XHTML output. +When set to an empty string, this attribute is omitted. Defaults to +`text/html'." + :group 'markdown + :type 'string) + +(defcustom markdown-coding-system nil + "Character set string for the http-equiv header in XHTML output. +Defaults to `buffer-file-coding-system' (and falling back to +`utf-8' when not available). Common settings are `iso-8859-1' +and `iso-latin-1'. Use `list-coding-systems' for more choices." + :group 'markdown + :type 'coding-system) + +(defcustom markdown-export-kill-buffer t + "Kill output buffer after HTML export. +When non-nil, kill the HTML output buffer after +exporting with `markdown-export'." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-xhtml-header-content "" + "Additional content to include in the XHTML <head> block." + :group 'markdown + :type 'string) + +(defcustom markdown-xhtml-body-preamble "" + "Content to include in the XHTML <body> block, before the output." + :group 'markdown + :type 'string + :safe 'stringp + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-xhtml-body-epilogue "" + "Content to include in the XHTML <body> block, after the output." + :group 'markdown + :type 'string + :safe 'stringp + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-xhtml-standalone-regexp + "^\\(<\\?xml\\|<!DOCTYPE\\|<html\\)" + "Regexp indicating whether `markdown-command' output is standalone XHTML." + :group 'markdown + :type 'regexp) + +(defcustom markdown-link-space-sub-char "_" + "Character to use instead of spaces when mapping wiki links to filenames." + :group 'markdown + :type 'string) + +(defcustom markdown-reference-location 'header + "Position where new reference definitions are inserted in the document." + :group 'markdown + :type '(choice (const :tag "At the end of the document" end) + (const :tag "Immediately after the current block" immediately) + (const :tag "At the end of the subtree" subtree) + (const :tag "Before next header" header))) + +(defcustom markdown-footnote-location 'end + "Position where new footnotes are inserted in the document." + :group 'markdown + :type '(choice (const :tag "At the end of the document" end) + (const :tag "Immediately after the current block" immediately) + (const :tag "At the end of the subtree" subtree) + (const :tag "Before next header" header))) + +(defcustom markdown-footnote-display '((raise 0.2) (height 0.8)) + "Display specification for footnote markers and inline footnotes. +By default, footnote text is reduced in size and raised. Set to +nil to disable this." + :group 'markdown + :type '(choice (sexp :tag "Display specification") + (const :tag "Don't set display property" nil)) + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-sub-superscript-display + '(((raise -0.3) (height 0.7)) . ((raise 0.3) (height 0.7))) + "Display specification for subscript and superscripts. +The car is used for subscript, the cdr is used for superscripts." + :group 'markdown + :type '(cons (choice (sexp :tag "Subscript form") + (const :tag "No lowering" nil)) + (choice (sexp :tag "Superscript form") + (const :tag "No raising" nil))) + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-unordered-list-item-prefix " * " + "String inserted before unordered list items." + :group 'markdown + :type 'string) + +(defcustom markdown-ordered-list-enumeration t + "When non-nil, use enumerated numbers(1. 2. 3. etc.) for ordered list marker. +While nil, always uses '1.' for the marker" + :group 'markdown + :type 'boolean + :package-version '(markdown-mode . "2.5")) + +(defcustom markdown-nested-imenu-heading-index t + "Use nested or flat imenu heading index. +A nested index may provide more natural browsing from the menu, +but a flat list may allow for faster keyboard navigation via tab +completion." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.2")) + +(defcustom markdown-add-footnotes-to-imenu t + "Add footnotes to end of imenu heading index." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-make-gfm-checkboxes-buttons t + "When non-nil, make GFM checkboxes into buttons." + :group 'markdown + :type 'boolean) + +(defcustom markdown-use-pandoc-style-yaml-metadata nil + "When non-nil, allow YAML metadata anywhere in the document." + :group 'markdown + :type 'boolean) + +(defcustom markdown-split-window-direction 'any + "Preference for splitting windows for static and live preview. +The default value is \\='any, which instructs Emacs to use +`split-window-sensibly' to automatically choose how to split +windows based on the values of `split-width-threshold' and +`split-height-threshold' and the available windows. To force +vertically split (left and right) windows, set this to \\='vertical +or \\='right. To force horizontally split (top and bottom) windows, +set this to \\='horizontal or \\='below. + +If this value is \\='any and `display-buffer-alist' is set then +`display-buffer' is used for open buffer function" + :group 'markdown + :type '(choice (const :tag "Automatic" any) + (const :tag "Right (vertical)" right) + (const :tag "Below (horizontal)" below)) + :package-version '(markdown-mode . "2.2")) + +(defcustom markdown-live-preview-window-function + #'markdown-live-preview-window-eww + "Function to display preview of Markdown output within Emacs. +Function must update the buffer containing the preview and return +the buffer." + :group 'markdown + :type 'function) + +(defcustom markdown-live-preview-delete-export 'delete-on-destroy + "Delete exported HTML file when using `markdown-live-preview-export'. +If set to \\='delete-on-export, delete on every export. When set to +\\='delete-on-destroy delete when quitting from command +`markdown-live-preview-mode'. Never delete if set to nil." + :group 'markdown + :type '(choice + (const :tag "Delete on every export" delete-on-export) + (const :tag "Delete when quitting live preview" delete-on-destroy) + (const :tag "Never delete" nil))) + +(defcustom markdown-list-indent-width 4 + "Depth of indentation for markdown lists. +Used in `markdown-demote-list-item' and +`markdown-promote-list-item'." + :group 'markdown + :type 'integer) + +(defcustom markdown-enable-prefix-prompts t + "Display prompts for certain prefix commands. +Set to nil to disable these prompts." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.3")) + +(defcustom markdown-gfm-additional-languages nil + "Extra languages made available when inserting GFM code blocks. +Language strings must have be trimmed of whitespace and not +contain any curly braces. They may be of arbitrary +capitalization, though." + :group 'markdown + :type '(repeat (string :validate markdown-validate-language-string))) + +(defcustom markdown-gfm-use-electric-backquote t + "Use `markdown-electric-backquote' when backquote is hit three times." + :group 'markdown + :type 'boolean) + +(defcustom markdown-gfm-downcase-languages t + "If non-nil, downcase suggested languages. +This applies to insertions done with +`markdown-electric-backquote'." + :group 'markdown + :type 'boolean) + +(defcustom markdown-edit-code-block-default-mode 'normal-mode + "Default mode to use for editing code blocks. +This mode is used when automatic detection fails, such as for GFM +code blocks with no language specified." + :group 'markdown + :type '(choice function (const :tag "None" nil)) + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-gfm-uppercase-checkbox nil + "If non-nil, use [X] for completed checkboxes, [x] otherwise." + :group 'markdown + :type 'boolean + :safe 'booleanp) + +(defcustom markdown-hide-urls nil + "Hide URLs of inline links and reference tags of reference links. +Such URLs will be replaced by a single customizable +character, defined by `markdown-url-compose-char', but are still part +of the buffer. Links can be edited interactively with +\\[markdown-insert-link] or, for example, by deleting the final +parenthesis to remove the invisibility property. You can also +hover your mouse pointer over the link text to see the URL. +Set this to a non-nil value to turn this feature on by default. +You can interactively set the value of this variable by calling +`markdown-toggle-url-hiding', pressing \\[markdown-toggle-url-hiding], +or from the menu Markdown > Links & Images menu." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.3")) +(make-variable-buffer-local 'markdown-hide-urls) + +(defcustom markdown-translate-filename-function #'identity + "Function to use to translate filenames when following links. +\\<markdown-mode-map>\\[markdown-follow-thing-at-point] and \\[markdown-follow-link-at-point] +call this function with the filename as only argument whenever +they encounter a filename (instead of a URL) to be visited and +use its return value instead of the filename in the link. For +example, if absolute filenames are actually relative to a server +root directory, you can set +`markdown-translate-filename-function' to a function that +prepends the root directory to the given filename." + :group 'markdown + :type 'function + :risky t + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-max-image-size nil + "Maximum width and height for displayed inline images. +This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT). +When nil, use the actual size. Otherwise, use ImageMagick to +resize larger images to be of the given maximum dimensions. This +requires Emacs to be built with ImageMagick support." + :group 'markdown + :package-version '(markdown-mode . "2.4") + :type '(choice + (const :tag "Use actual image width" nil) + (cons (choice (sexp :tag "Maximum width in pixels") + (const :tag "No maximum width" nil)) + (choice (sexp :tag "Maximum height in pixels") + (const :tag "No maximum height" nil))))) + +(defcustom markdown-mouse-follow-link t + "Non-nil means mouse on a link will follow the link. +This variable must be set before loading markdown-mode." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.5")) + +(defcustom markdown-table-align-p t + "Non-nil means that table is aligned after table operation." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.5")) + +(defcustom markdown-fontify-whole-heading-line nil + "Non-nil means fontify the whole line for headings. +This is useful when setting a background color for the +markdown-header-face-* faces." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.5")) + +(defcustom markdown-special-ctrl-a/e nil + "Non-nil means `C-a' and `C-e' behave specially in headlines and items. + +When t, `C-a' will bring back the cursor to the beginning of the +headline text. In an item, this will be the position after bullet +and check-box, if any. When the cursor is already at that +position, another `C-a' will bring it to the beginning of the +line. + +`C-e' will jump to the end of the headline, ignoring the presence +of closing tags in the headline. A second `C-e' will then jump to +the true end of the line, after closing tags. This also means +that, when this variable is non-nil, `C-e' also will never jump +beyond the end of the heading of a folded section, i.e. not after +the ellipses. + +When set to the symbol `reversed', the first `C-a' or `C-e' works +normally, going to the true line boundary first. Only a directly +following, identical keypress will bring the cursor to the +special positions. + +This may also be a cons cell where the behavior for `C-a' and +`C-e' is set separately." + :group 'markdown + :type '(choice + (const :tag "off" nil) + (const :tag "on: after hashes/bullet and before closing tags first" t) + (const :tag "reversed: true line boundary first" reversed) + (cons :tag "Set C-a and C-e separately" + (choice :tag "Special C-a" + (const :tag "off" nil) + (const :tag "on: after hashes/bullet first" t) + (const :tag "reversed: before hashes/bullet first" reversed)) + (choice :tag "Special C-e" + (const :tag "off" nil) + (const :tag "on: before closing tags first" t) + (const :tag "reversed: after closing tags first" reversed)))) + :package-version '(markdown-mode . "2.7")) + +;;; Markdown-Specific `rx' Macro ============================================== + +;; Based on python-rx from python.el. +(defmacro markdown-rx (&rest regexps) + "Markdown mode specialized rx macro. +This variant of `rx' supports common Markdown named REGEXPS." + `(rx-let ((newline "\n") + ;; Note: #405 not consider markdown-list-indent-width however this is never used + (indent (or (repeat 4 " ") "\t")) + (block-end (and (or (one-or-more (zero-or-more blank) "\n") line-end))) + (numeral (and (one-or-more (any "0-9#")) ".")) + (bullet (any "*+:-")) + (list-marker (or (and (one-or-more (any "0-9#")) ".") + (any "*+:-"))) + (checkbox (seq "[" (any " xX") "]"))) + (rx ,@regexps))) + + +;;; Regular Expressions ======================================================= + +(defconst markdown-regex-comment-start + "<!--" + "Regular expression matches HTML comment opening.") + +(defconst markdown-regex-comment-end + "--[ \t]*>" + "Regular expression matches HTML comment closing.") + +(defconst markdown-regex-link-inline + "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)" + "Regular expression for a [text](file) or an image link ![text](file). +Group 1 matches the leading exclamation point (optional). +Group 2 matches the opening square bracket. +Group 3 matches the text inside the square brackets. +Group 4 matches the closing square bracket. +Group 5 matches the opening parenthesis. +Group 6 matches the URL. +Group 7 matches the title (optional). +Group 8 matches the closing parenthesis.") + +(defconst markdown-regex-link-reference + "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:[^]^][^]]*\\|\\)\\(?4:\\]\\)\\(?5:\\[\\)\\(?6:[^]]*?\\)\\(?7:\\]\\)" + "Regular expression for a reference link [text][id]. +Group 1 matches the leading exclamation point (optional). +Group 2 matches the opening square bracket for the link text. +Group 3 matches the text inside the square brackets. +Group 4 matches the closing square bracket for the link text. +Group 5 matches the opening square bracket for the reference label. +Group 6 matches the reference label. +Group 7 matches the closing square bracket for the reference label.") + +(defconst markdown-regex-reference-definition + "^ \\{0,3\\}\\(?1:\\[\\)\\(?2:[^]\n]+?\\)\\(?3:\\]\\)\\(?4::\\)\\s *\\(?5:.*?\\)\\s *\\(?6: \"[^\"]*\"$\\|$\\)" + "Regular expression for a reference definition. +Group 1 matches the opening square bracket. +Group 2 matches the reference label. +Group 3 matches the closing square bracket. +Group 4 matches the colon. +Group 5 matches the URL. +Group 6 matches the title attribute (optional).") + +(defconst markdown-regex-footnote + "\\(?1:\\[\\^\\)\\(?2:.+?\\)\\(?3:\\]\\)" + "Regular expression for a footnote marker [^fn]. +Group 1 matches the opening square bracket and carat. +Group 2 matches only the label, without the surrounding markup. +Group 3 matches the closing square bracket.") + +(defconst markdown-regex-header + "^\\(?:\\(?1:[^\r\n\t -].*\\)\n\\(?:\\(?2:=+\\)\\|\\(?3:-+\\)\\)\\|\\(?4:#+[ \t]+\\)\\(?5:.*?\\)\\(?6:[ \t]+#+\\)?\\)$" + "Regexp identifying Markdown headings. +Group 1 matches the text of a setext heading. +Group 2 matches the underline of a level-1 setext heading. +Group 3 matches the underline of a level-2 setext heading. +Group 4 matches the opening hash marks of an atx heading and whitespace. +Group 5 matches the text, without surrounding whitespace, of an atx heading. +Group 6 matches the closing whitespace and hash marks of an atx heading.") + +(defconst markdown-regex-header-setext + "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$" + "Regular expression for generic setext-style (underline) headers.") + +(defconst markdown-regex-header-atx + "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$" + "Regular expression for generic atx-style (hash mark) headers.") + +(defconst markdown-regex-hr + (rx line-start + (group (or (and (repeat 3 (and "*" (? " "))) (* (any "* "))) + (and (repeat 3 (and "-" (? " "))) (* (any "- "))) + (and (repeat 3 (and "_" (? " "))) (* (any "_ "))))) + line-end) + "Regular expression for matching Markdown horizontal rules.") + +(defconst markdown-regex-code + "\\(?:\\`\\|[^\\]\\)\\(?1:\\(?2:`+\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(?4:\\2\\)\\)\\(?:[^`]\\|\\'\\)" + "Regular expression for matching inline code fragments. + +Group 1 matches the entire code fragment including the backquotes. +Group 2 matches the opening backquotes. +Group 3 matches the code fragment itself, without backquotes. +Group 4 matches the closing backquotes. + +The leading, unnumbered group ensures that the leading backquote +character is not escaped. +The last group, also unnumbered, requires that the character +following the code fragment is not a backquote. +Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines, +but not two newlines in a row.") + +(defconst markdown-regex-kbd + "\\(?1:<kbd>\\)\\(?2:\\(?:.\\|\n[^\n]\\)*?\\)\\(?3:</kbd>\\)" + "Regular expression for matching <kbd> tags. +Groups 1 and 3 match the opening and closing tags. +Group 2 matches the key sequence.") + +(defconst markdown-regex-gfm-code-block-open + "^[[:blank:]]*\\(?1:```\\)\\(?2:[[:blank:]]*{?[[:blank:]]*\\)\\(?3:[^`[:space:]]+?\\)?\\(?:[[:blank:]]+\\(?4:.+?\\)\\)?\\(?5:[[:blank:]]*}?[[:blank:]]*\\)$" + "Regular expression matching opening of GFM code blocks. +Group 1 matches the opening three backquotes and any following whitespace. +Group 2 matches the opening brace (optional) and surrounding whitespace. +Group 3 matches the language identifier (optional). +Group 4 matches the info string (optional). +Group 5 matches the closing brace (optional), whitespace, and newline. +Groups need to agree with `markdown-regex-tilde-fence-begin'.") + +(defconst markdown-regex-gfm-code-block-close + "^[[:blank:]]*\\(?1:```\\)\\(?2:\\s *?\\)$" + "Regular expression matching closing of GFM code blocks. +Group 1 matches the closing three backquotes. +Group 2 matches any whitespace and the final newline.") + +(defconst markdown-regex-pre + "^\\( \\|\t\\).*$" + "Regular expression for matching preformatted text sections.") + +(defconst markdown-regex-list + (markdown-rx line-start + ;; 1. Leading whitespace + (group (* blank)) + ;; 2. List marker: a numeral, bullet, or colon + (group list-marker) + ;; 3. Trailing whitespace + (group (+ blank)) + ;; 4. Optional checkbox for GFM task list items + (opt (group (and checkbox (* blank))))) + "Regular expression for matching list items.") + +(defconst markdown-regex-bold + "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:\\*\\*\\|__\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:\\3\\)\\)" + "Regular expression for matching bold text. +Group 1 matches the character before the opening asterisk or +underscore, if any, ensuring that it is not a backslash escape. +Group 2 matches the entire expression, including delimiters. +Groups 3 and 5 matches the opening and closing delimiters. +Group 4 matches the text inside the delimiters.") + +(defconst markdown-regex-italic + "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?4:\\2\\)\\)" + "Regular expression for matching italic text. +The leading unnumbered matches the character before the opening +asterisk or underscore, if any, ensuring that it is not a +backslash escape. +Group 1 matches the entire expression, including delimiters. +Groups 2 and 4 matches the opening and closing delimiters. +Group 3 matches the text inside the delimiters.") + +(defconst markdown-regex-strike-through + "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:~~\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:~~\\)\\)" + "Regular expression for matching strike-through text. +Group 1 matches the character before the opening tilde, if any, +ensuring that it is not a backslash escape. +Group 2 matches the entire expression, including delimiters. +Groups 3 and 5 matches the opening and closing delimiters. +Group 4 matches the text inside the delimiters.") + +(defconst markdown-regex-gfm-italic + "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\2\\)\\)" + "Regular expression for matching italic text in GitHub Flavored Markdown. +Underscores in words are not treated as special. +Group 1 matches the entire expression, including delimiters. +Groups 2 and 4 matches the opening and closing delimiters. +Group 3 matches the text inside the delimiters.") + +(defconst markdown-regex-blockquote + "^[ \t]*\\(?1:[A-Z]?>\\)\\(?2:[ \t]*\\)\\(?3:.*\\)$" + "Regular expression for matching blockquote lines. +Also accounts for a potential capital letter preceding the angle +bracket, for use with Leanpub blocks (asides, warnings, info +blocks, etc.). +Group 1 matches the leading angle bracket. +Group 2 matches the separating whitespace. +Group 3 matches the text.") + +(defconst markdown-regex-line-break + "[^ \n\t][ \t]*\\( \\)\n" + "Regular expression for matching line breaks.") + +(defconst markdown-regex-escape + "\\(\\\\\\)." + "Regular expression for matching escape sequences.") + +(defconst markdown-regex-wiki-link + "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:\\[\\[\\)\\(?3:[^]|]+\\)\\(?:\\(?4:|\\)\\(?5:[^]]+\\)\\)?\\(?6:\\]\\]\\)\\)" + "Regular expression for matching wiki links. +This matches typical bracketed [[WikiLinks]] as well as \\='aliased +wiki links of the form [[PageName|link text]]. +The meanings of the first and second components depend +on the value of `markdown-wiki-link-alias-first'. + +Group 1 matches the entire link. +Group 2 matches the opening square brackets. +Group 3 matches the first component of the wiki link. +Group 4 matches the pipe separator, when present. +Group 5 matches the second component of the wiki link, when present. +Group 6 matches the closing square brackets.") + +(defconst markdown-regex-uri + (concat "\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>; ]+\\)") + "Regular expression for matching inline URIs.") + +;; CommanMark specification says scheme length is 2-32 characters +(defconst markdown-regex-angle-uri + (concat "\\(<\\)\\([a-z][a-z0-9.+-]\\{1,31\\}:[^]\t\n\r<>,;()]+\\)\\(>\\)") + "Regular expression for matching inline URIs in angle brackets.") + +(defconst markdown-regex-email + "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>" + "Regular expression for matching inline email addresses.") + +(defsubst markdown-make-regex-link-generic () + "Make regular expression for matching any recognized link." + (concat "\\(?:" markdown-regex-link-inline + (when markdown-enable-wiki-links + (concat "\\|" markdown-regex-wiki-link)) + "\\|" markdown-regex-link-reference + "\\|" markdown-regex-angle-uri "\\)")) + +(defconst markdown-regex-gfm-checkbox + " \\(\\[[ xX]\\]\\) " + "Regular expression for matching GFM checkboxes. +Group 1 matches the text to become a button.") + +(defconst markdown-regex-blank-line + "^[[:blank:]]*$" + "Regular expression that matches a blank line.") + +(defconst markdown-regex-block-separator + "\n[\n\t\f ]*\n" + "Regular expression for matching block boundaries.") + +(defconst markdown-regex-block-separator-noindent + (concat "\\(\\`\\|\\(" markdown-regex-block-separator "\\)[^\n\t\f ]\\)") + "Regexp for block separators before lines with no indentation.") + +(defconst markdown-regex-math-inline-single + "\\(?:^\\|[^\\]\\)\\(?1:\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\)" + "Regular expression for itex $..$ math mode expressions. +Groups 1 and 3 match the opening and closing dollar signs. +Group 2 matches the mathematical expression contained within.") + +(defconst markdown-regex-math-inline-double + "\\(?:^\\|[^\\]\\)\\(?1:\\$\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\$\\)" + "Regular expression for itex $$..$$ math mode expressions. +Groups 1 and 3 match opening and closing dollar signs. +Group 2 matches the mathematical expression contained within.") + +(defconst markdown-regex-math-display + (rx line-start (* blank) + (group (group (repeat 1 2 "\\")) "[") + (group (*? anything)) + (group (backref 2) "]") + line-end) + "Regular expression for \[..\] or \\[..\\] display math. +Groups 1 and 4 match the opening and closing markup. +Group 3 matches the mathematical expression contained within. +Group 2 matches the opening slashes, and is used internally to +match the closing slashes.") + +(defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line) + "Return regexp matching a tilde code fence at least NUM-TILDES long. +END-OF-LINE is the regexp construct to indicate end of line; $ if +missing." + (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes ",\\}\\)" + (or end-of-line "$"))) + +(defconst markdown-regex-tilde-fence-begin + (markdown-make-tilde-fence-regex + 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$") + "Regular expression for matching tilde-fenced code blocks. +Group 1 matches the opening tildes. +Group 2 matches (optional) opening brace and surrounding whitespace. +Group 3 matches the language identifier (optional). +Group 4 matches the info string (optional). +Group 5 matches the closing brace (optional) and any surrounding whitespace. +Groups need to agree with `markdown-regex-gfm-code-block-open'.") + +(defconst markdown-regex-declarative-metadata + "^[ \t]*\\(?:-[ \t]*\\)?\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$" + "Regular expression for matching declarative metadata statements. +This matches MultiMarkdown metadata as well as YAML and TOML +assignments such as the following: + + variable: value + +or + + variable = value") + +(defconst markdown-regex-pandoc-metadata + "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)" + "Regular expression for matching Pandoc metadata.") + +(defconst markdown-regex-yaml-metadata-border + "\\(-\\{3\\}\\)$" + "Regular expression for matching YAML metadata.") + +(defconst markdown-regex-yaml-pandoc-metadata-end-border + "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$" + "Regular expression for matching YAML metadata end borders.") + +(defsubst markdown-get-yaml-metadata-start-border () + "Return YAML metadata start border depending upon whether Pandoc is used." + (concat + (if markdown-use-pandoc-style-yaml-metadata "^" "\\`") + markdown-regex-yaml-metadata-border)) + +(defsubst markdown-get-yaml-metadata-end-border (_) + "Return YAML metadata end border depending upon whether Pandoc is used." + (if markdown-use-pandoc-style-yaml-metadata + markdown-regex-yaml-pandoc-metadata-end-border + markdown-regex-yaml-metadata-border)) + +(defconst markdown-regex-inline-attributes + "[ \t]*\\(?:{:?\\)[ \t]*\\(?:\\(?:#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"}]*['\"]?\\),?[ \t]*\\)+\\(?:}\\)[ \t]*$" + "Regular expression for matching inline identifiers or attribute lists. +Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.") + +(defconst markdown-regex-leanpub-sections + (concat + "^\\({\\)\\(" + (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak")) + "\\)\\(}\\)[ \t]*\n") + "Regular expression for Leanpub section markers and related syntax.") + +(defconst markdown-regex-sub-superscript + "\\(?:^\\|[^\\~^]\\)\\(?1:\\(?2:[~^]\\)\\(?3:[+-\u2212]?[[:alnum:]]+\\)\\(?4:\\2\\)\\)" + "The regular expression matching a sub- or superscript. +The leading un-numbered group matches the character before the +opening tilde or carat, if any, ensuring that it is not a +backslash escape, carat, or tilde. +Group 1 matches the entire expression, including markup. +Group 2 matches the opening markup--a tilde or carat. +Group 3 matches the text inside the delimiters. +Group 4 matches the closing markup--a tilde or carat.") + +(defconst markdown-regex-include + "^\\(?1:<<\\)\\(?:\\(?2:\\[\\)\\(?3:.*\\)\\(?4:\\]\\)\\)?\\(?:\\(?5:(\\)\\(?6:.*\\)\\(?7:)\\)\\)?\\(?:\\(?8:{\\)\\(?9:.*\\)\\(?10:}\\)\\)?$" + "Regular expression matching common forms of include syntax. +Marked 2, Leanpub, and other processors support some of these forms: + +<<[sections/section1.md] +<<(folder/filename) +<<[Code title](folder/filename) +<<{folder/raw_file.html} + +Group 1 matches the opening two angle brackets. +Groups 2-4 match the opening square bracket, the text inside, +and the closing square bracket, respectively. +Groups 5-7 match the opening parenthesis, the text inside, and +the closing parenthesis. +Groups 8-10 match the opening brace, the text inside, and the brace.") + +(defconst markdown-regex-pandoc-inline-footnote + "\\(?1:\\^\\)\\(?2:\\[\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\]\\)" + "Regular expression for Pandoc inline footnote^[footnote text]. +Group 1 matches the opening caret. +Group 2 matches the opening square bracket. +Group 3 matches the footnote text, without the surrounding markup. +Group 4 matches the closing square bracket.") + +(defconst markdown-regex-html-attr + "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?" + "Regular expression for matching HTML attributes and values. +Group 1 matches the attribute name. +Group 2 matches the following whitespace, equals sign, and value, if any. +Group 3 matches the equals sign, if any. +Group 4 matches single-, double-, or un-quoted attribute values.") + +(defconst markdown-regex-html-tag + (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr + "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)") + "Regular expression for matching HTML tags. +Groups 1 and 9 match the beginning and ending angle brackets and slashes. +Group 2 matches the tag name. +Group 3 matches all attributes and whitespace following the tag name.") + +(defconst markdown-regex-html-entity + "\\(&#?[[:alnum:]]+;\\)" + "Regular expression for matching HTML entities.") + +(defconst markdown-regex-highlighting + "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:==\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:==\\)\\)" +"Regular expression for matching highlighting text. +Group 1 matches the character before the opening equal, if any, +ensuring that it is not a backslash escape. +Group 2 matches the entire expression, including delimiters. +Groups 3 and 5 matches the opening and closing delimiters. +Group 4 matches the text inside the delimiters.") + + +;;; Syntax ==================================================================== + +(defvar markdown--syntax-properties + (list 'markdown-tilde-fence-begin nil + 'markdown-tilde-fence-end nil + 'markdown-fenced-code nil + 'markdown-yaml-metadata-begin nil + 'markdown-yaml-metadata-end nil + 'markdown-yaml-metadata-section nil + 'markdown-gfm-block-begin nil + 'markdown-gfm-block-end nil + 'markdown-gfm-code nil + 'markdown-list-item nil + 'markdown-pre nil + 'markdown-blockquote nil + 'markdown-hr nil + 'markdown-comment nil + 'markdown-heading nil + 'markdown-heading-1-setext nil + 'markdown-heading-2-setext nil + 'markdown-heading-1-atx nil + 'markdown-heading-2-atx nil + 'markdown-heading-3-atx nil + 'markdown-heading-4-atx nil + 'markdown-heading-5-atx nil + 'markdown-heading-6-atx nil + 'markdown-metadata-key nil + 'markdown-metadata-value nil + 'markdown-metadata-markup nil) + "Property list of all Markdown syntactic properties.") + +(defvar markdown-literal-faces + '(markdown-code-face + markdown-inline-code-face + markdown-pre-face + markdown-math-face + markdown-url-face + markdown-plain-url-face + markdown-language-keyword-face + markdown-language-info-face + markdown-metadata-key-face + markdown-metadata-value-face + markdown-html-entity-face + markdown-html-tag-name-face + markdown-html-tag-delimiter-face + markdown-html-attr-name-face + markdown-html-attr-value-face + markdown-reference-face + markdown-footnote-marker-face + markdown-line-break-face + markdown-comment-face) + "A list of markdown-mode faces that contain literal text. +Literal text treats backslashes literally, rather than as an +escape character (see `markdown-match-escape').") + +(defsubst markdown-in-comment-p (&optional pos) + "Return non-nil if POS is in a comment. +If POS is not given, use point instead." + (get-text-property (or pos (point)) 'markdown-comment)) + +(defun markdown--face-p (pos faces) + "Return non-nil if face of POS contain FACES." + (let ((face-prop (get-text-property pos 'face))) + (if (listp face-prop) + (cl-loop for face in face-prop + thereis (memq face faces)) + (memq face-prop faces)))) + +(defsubst markdown--math-block-p (&optional pos) + (when markdown-enable-math + (markdown--face-p (or pos (point)) '(markdown-math-face)))) + +(defun markdown-syntax-propertize-extend-region (start end) + "Extend START to END region to include an entire block of text. +This helps improve syntax analysis for block constructs. +Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made. +Function is called repeatedly until it returns nil. For details, see +`syntax-propertize-extend-region-functions'." + (save-match-data + (save-excursion + (let* ((new-start (progn (goto-char start) + (skip-chars-forward "\n") + (if (re-search-backward "\n\n" nil t) + (min start (match-end 0)) + (point-min)))) + (new-end (progn (goto-char end) + (skip-chars-backward "\n") + (if (re-search-forward "\n\n" nil t) + (max end (match-beginning 0)) + (point-max)))) + (code-match (markdown-code-block-at-pos new-start)) + ;; FIXME: The `code-match' can return bogus values + ;; when text has been inserted/deleted! + (new-start (min (or (and code-match (cl-first code-match)) + (point-max)) + new-start)) + (code-match (and (< end (point-max)) + (markdown-code-block-at-pos end))) + (new-end (max (or (and code-match (cl-second code-match)) 0) + new-end))) + + (unless (and (eq new-start start) (eq new-end end)) + (cons new-start (min new-end (point-max)))))))) + +(defun markdown-font-lock-extend-region-function (start end _) + "Used in `jit-lock-after-change-extend-region-functions'. +Delegates to `markdown-syntax-propertize-extend-region'. START +and END are the previous region to refontify." + (let ((res (markdown-syntax-propertize-extend-region start end))) + (when res + ;; syntax-propertize-function is not called when character at + ;; (point-max) is deleted, but font-lock-extend-region-functions + ;; are called. Force a syntax property update in that case. + (when (= end (point-max)) + ;; This function is called in a buffer modification hook. + ;; `markdown-syntax-propertize' doesn't save the match data, + ;; so we have to do it here. + (save-match-data + (markdown-syntax-propertize (car res) (cdr res)))) + (setq jit-lock-start (car res) + jit-lock-end (cdr res))))) + +(defun markdown--cur-list-item-bounds () + "Return a list describing the list item at point. +Assumes that match data is set for `markdown-regex-list'. See the +documentation for `markdown-cur-list-item-bounds' for the format of +the returned list." + (save-excursion + (let* ((begin (match-beginning 0)) + (indent (length (match-string-no-properties 1))) + (nonlist-indent (- (match-end 3) (match-beginning 0))) + (marker (buffer-substring-no-properties + (match-beginning 2) (match-end 3))) + (checkbox (match-string-no-properties 4)) + (match (butlast (match-data t))) + (end (markdown-cur-list-item-end nonlist-indent))) + (list begin end indent nonlist-indent marker checkbox match)))) + +(defun markdown--append-list-item-bounds (marker indent cur-bounds bounds) + "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS. +Here, MARKER is a string representing the type of list and INDENT +is an integer giving the indentation, in spaces, of the current +block. CUR-BOUNDS is a list of the form returned by +`markdown-cur-list-item-bounds' and BOUNDS is a list of bounds +values for parent list items. When BOUNDS is nil, it means we are +at baseline (not inside of a nested list)." + (let ((prev-indent (or (cl-third (car bounds)) 0))) + (cond + ;; New list item at baseline. + ((and marker (null bounds)) + (list cur-bounds)) + ;; List item with greater indentation (four or more spaces). + ;; Increase list level by consing CUR-BOUNDS onto BOUNDS. + ((and marker (>= indent (+ prev-indent markdown-list-indent-width))) + (cons cur-bounds bounds)) + ;; List item with greater or equal indentation (less than four spaces). + ;; Keep list level the same by replacing the car of BOUNDS. + ((and marker (>= indent prev-indent)) + (cons cur-bounds (cdr bounds))) + ;; Lesser indentation level. + ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser + ;; indentation could move back more than one list level). Note + ;; that this block need not be the beginning of list item. + ((< indent prev-indent) + (while (and (> (length bounds) 1) + (setq prev-indent (cl-third (cadr bounds))) + (< indent (+ prev-indent markdown-list-indent-width))) + (setq bounds (cdr bounds))) + (cons cur-bounds bounds)) + ;; Otherwise, do nothing. + (t bounds)))) + +(defun markdown-syntax-propertize-list-items (start end) + "Propertize list items from START to END. +Stores nested list item information in the `markdown-list-item' +text property to make later syntax analysis easier. The value of +this property is a list with elements of the form (begin . end) +giving the bounds of the current and parent list items." + (save-excursion + (goto-char start) + (let ((prev-list-line -100) + bounds level pre-regexp) + ;; Find a baseline point with zero list indentation + (markdown-search-backward-baseline) + ;; Search for all list items between baseline and END + (while (and (< (point) end) + (re-search-forward markdown-regex-list end 'limit)) + ;; Level of list nesting + (setq level (length bounds)) + ;; Pre blocks need to be indented one level past the list level + (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ level))) + (beginning-of-line) + (cond + ;; Reset at headings, horizontal rules, and top-level blank lines. + ;; Propertize baseline when in range. + ((markdown-new-baseline) + (setq bounds nil)) + ;; Make sure this is not a line from a pre block + ((and (looking-at-p pre-regexp) + ;; too indented line is also treated as list if previous line is list + (>= (- (line-number-at-pos) prev-list-line) 2))) + ;; If not, then update levels and propertize list item when in range. + (t + (let* ((indent (current-indentation)) + (cur-bounds (markdown--cur-list-item-bounds)) + (first (cl-first cur-bounds)) + (last (cl-second cur-bounds)) + (marker (cl-fifth cur-bounds))) + (setq bounds (markdown--append-list-item-bounds + marker indent cur-bounds bounds)) + (when (and (<= start (point)) (<= (point) end)) + (setq prev-list-line (line-number-at-pos first)) + (put-text-property first last 'markdown-list-item bounds))))) + (end-of-line))))) + +(defun markdown-syntax-propertize-pre-blocks (start end) + "Match preformatted text blocks from START to END." + (save-excursion + (goto-char start) + (let (finish) + ;; Use loop for avoiding too many recursive calls + ;; https://github.com/jrblevin/markdown-mode/issues/512 + (while (not finish) + (let ((levels (markdown-calculate-list-levels)) + indent pre-regexp close-regexp open close) + (while (and (< (point) end) (not close)) + ;; Search for a region with sufficient indentation + (if (null levels) + (setq indent 1) + (setq indent (1+ (length levels)))) + (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" indent)) + (setq close-regexp (format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent))) + + (cond + ;; If not at the beginning of a line, move forward + ((not (bolp)) (forward-line)) + ;; Move past blank lines + ((markdown-cur-line-blank-p) (forward-line)) + ;; At headers and horizontal rules, reset levels + ((markdown-new-baseline) (forward-line) (setq levels nil)) + ;; If the current line has sufficient indentation, mark out pre block + ;; The opening should be preceded by a blank line. + ((and (markdown-prev-line-blank) (looking-at pre-regexp)) + (setq open (match-beginning 0)) + (while (and (or (looking-at-p pre-regexp) (markdown-cur-line-blank-p)) + (not (eobp))) + (forward-line)) + (skip-syntax-backward "-") + (forward-line) + (setq close (point))) + ;; If current line has a list marker, update levels, move to end of block + ((looking-at markdown-regex-list) + (setq levels (markdown-update-list-levels + (match-string 2) (current-indentation) levels)) + (markdown-end-of-text-block)) + ;; If this is the end of the indentation level, adjust levels accordingly. + ;; Only match end of indentation level if levels is not the empty list. + ((and (car levels) (looking-at-p close-regexp)) + (setq levels (markdown-update-list-levels + nil (current-indentation) levels)) + (markdown-end-of-text-block)) + (t (markdown-end-of-text-block)))) + + (if (and open close) + ;; Set text property data and continue to search + (put-text-property open close 'markdown-pre (list open close)) + (setq finish t)))) + nil))) + +(defconst markdown-fenced-block-pairs + `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin) + (markdown-make-tilde-fence-regex markdown-tilde-fence-end) + markdown-fenced-code) + ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin) + (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end) + markdown-yaml-metadata-section) + ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin) + (,markdown-regex-gfm-code-block-close markdown-gfm-block-end) + markdown-gfm-code)) + "Mapping of regular expressions to \"fenced-block\" constructs. +These constructs are distinguished by having a distinctive start +and end pattern, both of which take up an entire line of text, +but no special pattern to identify text within the fenced +blocks (unlike blockquotes and indented-code sections). + +Each element within this list takes the form: + + ((START-REGEX-OR-FUN START-PROPERTY) + (END-REGEX-OR-FUN END-PROPERTY) + MIDDLE-PROPERTY) + +Each *-REGEX-OR-FUN element can be a regular expression as a string, or a +function which evaluates to same. Functions for START-REGEX-OR-FUN accept no +arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument +which is the length of the first group of the START-REGEX-OR-FUN match, which +can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to +evaluate these into \"real\" regexps. + +The *-PROPERTY elements are the text properties applied to each part of the +block construct when it is matched using +`markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied +to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and +MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the +`match-data' when the regexp was matched to the text. In the case of +MIDDLE-PROPERTY, the value is a false match data of the form \\='(begin end), with +begin and end set to the edges of the \"middle\" text. This makes fontification +easier.") + +(defun markdown-text-property-at-point (prop) + (get-text-property (point) prop)) + +(defsubst markdown-maybe-funcall-regexp (object &optional arg) + (cond ((functionp object) + (if arg (funcall object arg) (funcall object))) + ((stringp object) object) + (t (error "Object cannot be turned into regex")))) + +(defsubst markdown-get-start-fence-regexp () + "Return regexp to find all \"start\" sections of fenced block constructs. +Which construct is actually contained in the match must be found separately." + (mapconcat + #'identity + (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry))) + markdown-fenced-block-pairs) + "\\|")) + +(defun markdown-get-fenced-block-begin-properties () + (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs)) + +(defun markdown-get-fenced-block-end-properties () + (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs)) + +(defun markdown-get-fenced-block-middle-properties () + (cl-mapcar #'cl-third markdown-fenced-block-pairs)) + +(defun markdown-find-previous-prop (prop &optional lim) + "Find previous place where property PROP is non-nil, up to LIM. +Return a cons of (pos . property). pos is point if point contains +non-nil PROP." + (let ((res + (if (get-text-property (point) prop) (point) + (previous-single-property-change + (point) prop nil (or lim (point-min)))))) + (when (and (not (get-text-property res prop)) + (> res (point-min)) + (get-text-property (1- res) prop)) + (cl-decf res)) + (when (and res (get-text-property res prop)) (cons res prop)))) + +(defun markdown-find-next-prop (prop &optional lim) + "Find next place where property PROP is non-nil, up to LIM. +Return a cons of (POS . PROPERTY) where POS is point if point +contains non-nil PROP." + (let ((res + (if (get-text-property (point) prop) (point) + (next-single-property-change + (point) prop nil (or lim (point-max)))))) + (when (and res (get-text-property res prop)) (cons res prop)))) + +(defun markdown-min-of-seq (map-fn seq) + "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN." + (cl-loop for el in seq + with min = 1.0e+INF ; infinity + with min-el = nil + do (let ((res (funcall map-fn el))) + (when (< res min) + (setq min res) + (setq min-el el))) + finally return min-el)) + +(defun markdown-max-of-seq (map-fn seq) + "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN." + (cl-loop for el in seq + with max = -1.0e+INF ; negative infinity + with max-el = nil + do (let ((res (funcall map-fn el))) + (when (and res (> res max)) + (setq max res) + (setq max-el el))) + finally return max-el)) + +(defun markdown-find-previous-block () + "Find previous block. +Detect whether `markdown-syntax-propertize-fenced-block-constructs' was +unable to propertize the entire block, but was able to propertize the beginning +of the block. If so, return a cons of (pos . property) where the beginning of +the block was propertized." + (let ((start-pt (point)) + (closest-open + (markdown-max-of-seq + #'car + (cl-remove-if + #'null + (cl-mapcar + #'markdown-find-previous-prop + (markdown-get-fenced-block-begin-properties)))))) + (when closest-open + (let* ((length-of-open-match + (let ((match-d + (get-text-property (car closest-open) (cdr closest-open)))) + (- (cl-fourth match-d) (cl-third match-d)))) + (end-regexp + (markdown-maybe-funcall-regexp + (cl-caadr + (cl-find-if + (lambda (entry) (eq (cl-cadar entry) (cdr closest-open))) + markdown-fenced-block-pairs)) + length-of-open-match)) + (end-prop-loc + (save-excursion + (save-match-data + (goto-char (car closest-open)) + (and (re-search-forward end-regexp start-pt t) + (match-beginning 0)))))) + (and (not end-prop-loc) closest-open))))) + +(defun markdown-get-fenced-block-from-start (prop) + "Return limits of an enclosing fenced block from its start, using PROP. +Return value is a list usable as `match-data'." + (catch 'no-rest-of-block + (let* ((correct-entry + (cl-find-if + (lambda (entry) (eq (cl-cadar entry) prop)) + markdown-fenced-block-pairs)) + (begin-of-begin (cl-first (markdown-text-property-at-point prop))) + (middle-prop (cl-third correct-entry)) + (end-prop (cl-cadadr correct-entry)) + (end-of-end + (save-excursion + (goto-char (match-end 0)) ; end of begin + (unless (eobp) (forward-char)) + (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) + (if (not mid-prop-v) ; no middle + (progn + ;; try to find end by advancing one + (let ((end-prop-v + (markdown-text-property-at-point end-prop))) + (if end-prop-v (cl-second end-prop-v) + (throw 'no-rest-of-block nil)))) + (set-match-data mid-prop-v) + (goto-char (match-end 0)) ; end of middle + (beginning-of-line) ; into end + (cl-second (markdown-text-property-at-point end-prop))))))) + (list begin-of-begin end-of-end)))) + +(defun markdown-get-fenced-block-from-middle (prop) + "Return limits of an enclosing fenced block from its middle, using PROP. +Return value is a list usable as `match-data'." + (let* ((correct-entry + (cl-find-if + (lambda (entry) (eq (cl-third entry) prop)) + markdown-fenced-block-pairs)) + (begin-prop (cl-cadar correct-entry)) + (begin-of-begin + (save-excursion + (goto-char (match-beginning 0)) + (unless (bobp) (forward-line -1)) + (beginning-of-line) + (cl-first (markdown-text-property-at-point begin-prop)))) + (end-prop (cl-cadadr correct-entry)) + (end-of-end + (save-excursion + (goto-char (match-end 0)) + (beginning-of-line) + (cl-second (markdown-text-property-at-point end-prop))))) + (list begin-of-begin end-of-end))) + +(defun markdown-get-fenced-block-from-end (prop) + "Return limits of an enclosing fenced block from its end, using PROP. +Return value is a list usable as `match-data'." + (let* ((correct-entry + (cl-find-if + (lambda (entry) (eq (cl-cadadr entry) prop)) + markdown-fenced-block-pairs)) + (end-of-end (cl-second (markdown-text-property-at-point prop))) + (middle-prop (cl-third correct-entry)) + (begin-prop (cl-cadar correct-entry)) + (begin-of-begin + (save-excursion + (goto-char (match-beginning 0)) ; beginning of end + (unless (bobp) (backward-char)) ; into middle + (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) + (if (not mid-prop-v) + (progn + (beginning-of-line) + (cl-first (markdown-text-property-at-point begin-prop))) + (set-match-data mid-prop-v) + (goto-char (match-beginning 0)) ; beginning of middle + (unless (bobp) (forward-line -1)) ; into beginning + (beginning-of-line) + (cl-first (markdown-text-property-at-point begin-prop))))))) + (list begin-of-begin end-of-end))) + +(defun markdown-get-enclosing-fenced-block-construct (&optional pos) + "Get \"fake\" match data for block enclosing POS. +Returns fake match data which encloses the start, middle, and end +of the block construct enclosing POS, if it exists. Used in +`markdown-code-block-at-pos'." + (save-excursion + (when pos (goto-char pos)) + (beginning-of-line) + (car + (cl-remove-if + #'null + (cl-mapcar + (lambda (fun-and-prop) + (cl-destructuring-bind (fun prop) fun-and-prop + (when prop + (save-match-data + (set-match-data (markdown-text-property-at-point prop)) + (funcall fun prop))))) + `((markdown-get-fenced-block-from-start + ,(cl-find-if + #'markdown-text-property-at-point + (markdown-get-fenced-block-begin-properties))) + (markdown-get-fenced-block-from-middle + ,(cl-find-if + #'markdown-text-property-at-point + (markdown-get-fenced-block-middle-properties))) + (markdown-get-fenced-block-from-end + ,(cl-find-if + #'markdown-text-property-at-point + (markdown-get-fenced-block-end-properties))))))))) + +(defun markdown-propertize-end-match (reg end fence-spec middle-begin) + "Get match for REG up to END, if exists, and propertize appropriately. +FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and +MIDDLE-BEGIN is the start of the \"middle\" section of the block." + (when (re-search-forward reg end t) + (let ((close-begin (match-beginning 0)) ; Start of closing line. + (close-end (match-end 0)) ; End of closing line. + (close-data (match-data t))) ; Match data for closing line. + ;; Propertize middle section of fenced block. + (put-text-property middle-begin close-begin + (cl-third fence-spec) + (list middle-begin close-begin)) + ;; If the block is a YAML block, propertize the declarations inside + (when (< middle-begin close-begin) ;; workaround #634 + (markdown-syntax-propertize-yaml-metadata middle-begin close-begin)) + ;; Propertize closing line of fenced block. + (put-text-property close-begin close-end + (cl-cadadr fence-spec) close-data)))) + +(defun markdown--triple-quote-single-line-p (begin) + (save-excursion + (goto-char begin) + (save-match-data + (and (search-forward "```" nil t) + (search-forward "```" (line-end-position) t))))) + +(defun markdown-syntax-propertize-fenced-block-constructs (start end) + "Propertize according to `markdown-fenced-block-pairs' from START to END. +If unable to propertize an entire block (if the start of a block is within START +and END, but the end of the block is not), propertize the start section of a +block, then in a subsequent call propertize both middle and end by finding the +start which was previously propertized." + (let ((start-reg (markdown-get-start-fence-regexp))) + (save-excursion + (goto-char start) + ;; start from previous unclosed block, if exists + (let ((prev-begin-block (markdown-find-previous-block))) + (when prev-begin-block + (let* ((correct-entry + (cl-find-if (lambda (entry) + (eq (cdr prev-begin-block) (cl-cadar entry))) + markdown-fenced-block-pairs)) + (enclosed-text-start (1+ (car prev-begin-block))) + (start-length + (save-excursion + (goto-char (car prev-begin-block)) + (string-match + (markdown-maybe-funcall-regexp + (caar correct-entry)) + (buffer-substring + (line-beginning-position) (line-end-position))) + (- (match-end 1) (match-beginning 1)))) + (end-reg (markdown-maybe-funcall-regexp + (cl-caadr correct-entry) start-length))) + (markdown-propertize-end-match + end-reg end correct-entry enclosed-text-start)))) + ;; find all new blocks within region + (while (re-search-forward start-reg end t) + ;; we assume the opening constructs take up (only) an entire line, + ;; so we re-check the current line + (let* ((block-start (match-beginning 0)) + (cur-line (buffer-substring (line-beginning-position) (line-end-position))) + ;; find entry in `markdown-fenced-block-pairs' corresponding + ;; to regex which was matched + (correct-entry + (cl-find-if + (lambda (fenced-pair) + (string-match-p + (markdown-maybe-funcall-regexp (caar fenced-pair)) + cur-line)) + markdown-fenced-block-pairs)) + (enclosed-text-start + (save-excursion (1+ (line-end-position)))) + (end-reg + (markdown-maybe-funcall-regexp + (cl-caadr correct-entry) + (if (and (match-beginning 1) (match-end 1)) + (- (match-end 1) (match-beginning 1)) + 0))) + (prop (cl-cadar correct-entry))) + (when (or (not (eq prop 'markdown-gfm-block-begin)) + (not (markdown--triple-quote-single-line-p block-start))) + ;; get correct match data + (save-excursion + (beginning-of-line) + (re-search-forward + (markdown-maybe-funcall-regexp (caar correct-entry)) + (line-end-position))) + ;; mark starting, even if ending is outside of region + (put-text-property (match-beginning 0) (match-end 0) prop (match-data t)) + (markdown-propertize-end-match + end-reg end correct-entry enclosed-text-start))))))) + +(defun markdown-syntax-propertize-blockquotes (start end) + "Match blockquotes from START to END." + (save-excursion + (goto-char start) + (while (and (re-search-forward markdown-regex-blockquote end t) + (not (markdown-code-block-at-pos (match-beginning 0)))) + (put-text-property (match-beginning 0) (match-end 0) + 'markdown-blockquote + (match-data t))))) + +(defun markdown-syntax-propertize-hrs (start end) + "Match horizontal rules from START to END." + (save-excursion + (goto-char start) + (while (re-search-forward markdown-regex-hr end t) + (let ((beg (match-beginning 0)) + (end (match-end 0))) + (goto-char beg) + (unless (or (markdown-on-heading-p) + (markdown-code-block-at-point-p)) + (put-text-property beg end 'markdown-hr (match-data t))) + (goto-char end))))) + +(defun markdown-syntax-propertize-yaml-metadata (start end) + "Propertize elements inside YAML metadata blocks from START to END. +Assumes region from START and END is already known to be the interior +region of a YAML metadata block as propertized by +`markdown-syntax-propertize-fenced-block-constructs'." + (save-excursion + (goto-char start) + (cl-loop + while (re-search-forward markdown-regex-declarative-metadata end t) + do (progn + (put-text-property (match-beginning 1) (match-end 1) + 'markdown-metadata-key (match-data t)) + (put-text-property (match-beginning 2) (match-end 2) + 'markdown-metadata-markup (match-data t)) + (put-text-property (match-beginning 3) (match-end 3) + 'markdown-metadata-value (match-data t)))))) + +(defun markdown-syntax-propertize-headings (start end) + "Match headings of type SYMBOL with REGEX from START to END." + (goto-char start) + (while (re-search-forward markdown-regex-header end t) + (unless (markdown-code-block-at-pos (match-beginning 0)) + (put-text-property + (match-beginning 0) (match-end 0) 'markdown-heading + (match-data t)) + (put-text-property + (match-beginning 0) (match-end 0) + (cond ((match-string-no-properties 2) 'markdown-heading-1-setext) + ((match-string-no-properties 3) 'markdown-heading-2-setext) + (t (let ((atx-level (length (markdown-trim-whitespace + (match-string-no-properties 4))))) + (intern (format "markdown-heading-%d-atx" atx-level))))) + (match-data t))))) + +(defun markdown-syntax-propertize-comments (start end) + "Match HTML comments from the START to END." + ;; Implement by loop instead of recursive call for avoiding + ;; exceed max-lisp-eval-depth issue + ;; https://github.com/jrblevin/markdown-mode/issues/536 + (let (finish) + (goto-char start) + (while (not finish) + (let* ((in-comment (nth 4 (syntax-ppss))) + (comment-begin (nth 8 (syntax-ppss)))) + (cond + ;; Comment start + ((and (not in-comment) + (re-search-forward markdown-regex-comment-start end t) + (not (markdown-inline-code-at-point-p)) + (not (markdown-code-block-at-point-p))) + (let ((open-beg (match-beginning 0))) + (put-text-property open-beg (1+ open-beg) + 'syntax-table (string-to-syntax "<")) + (goto-char (min (1+ (match-end 0)) end (point-max))))) + ;; Comment end + ((and in-comment comment-begin + (re-search-forward markdown-regex-comment-end end t)) + (let ((comment-end (match-end 0))) + (put-text-property (1- comment-end) comment-end + 'syntax-table (string-to-syntax ">")) + ;; Remove any other text properties inside the comment + (remove-text-properties comment-begin comment-end + markdown--syntax-properties) + (put-text-property comment-begin comment-end + 'markdown-comment (list comment-begin comment-end)) + (goto-char (min comment-end end (point-max))))) + ;; Nothing found + (t (setq finish t))))) + nil)) + +(defun markdown-syntax-propertize (start end) + "Function used as `syntax-propertize-function'. +START and END delimit region to propertize." + (with-silent-modifications + (save-excursion + (remove-text-properties start end markdown--syntax-properties) + (markdown-syntax-propertize-fenced-block-constructs start end) + (markdown-syntax-propertize-list-items start end) + (markdown-syntax-propertize-pre-blocks start end) + (markdown-syntax-propertize-blockquotes start end) + (markdown-syntax-propertize-headings start end) + (markdown-syntax-propertize-hrs start end) + (markdown-syntax-propertize-comments start end)))) + + +;;; Markup Hiding ============================================================= + +(defconst markdown-markup-properties + '(face markdown-markup-face invisible markdown-markup) + "List of properties and values to apply to markup.") + +(defconst markdown-line-break-properties + '(face markdown-line-break-face invisible markdown-markup) + "List of properties and values to apply to line break markup.") + +(defconst markdown-language-keyword-properties + '(face markdown-language-keyword-face invisible markdown-markup) + "List of properties and values to apply to code block language names.") + +(defconst markdown-language-info-properties + '(face markdown-language-info-face invisible markdown-markup) + "List of properties and values to apply to code block language info strings.") + +(defconst markdown-include-title-properties + '(face markdown-link-title-face invisible markdown-markup) + "List of properties and values to apply to included code titles.") + +(defcustom markdown-hide-markup nil + "Determines whether markup in the buffer will be hidden. +When set to nil, all markup is displayed in the buffer as it +appears in the file. An exception is when `markdown-hide-urls' +is non-nil. +Set this to a non-nil value to turn this feature on by default. +You can interactively toggle the value of this variable with +`markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding], +or from the Markdown > Show & Hide menu. + +Markup hiding works by adding text properties to positions in the +buffer---either the `invisible' property or the `display' property +in cases where alternative glyphs are used (e.g., list bullets). +This does not, however, affect printing or other output. +Functions such as `htmlfontify-buffer' and `ps-print-buffer' will +not honor these text properties. For printing, it would be better +to first convert to HTML or PDF (e.g,. using Pandoc)." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.3")) +(make-variable-buffer-local 'markdown-hide-markup) + +(defun markdown-toggle-markup-hiding (&optional arg) + "Toggle the display or hiding of markup. +With a prefix argument ARG, enable markup hiding if ARG is positive, +and disable it otherwise. +See `markdown-hide-markup' for additional details." + (interactive (list (or current-prefix-arg 'toggle))) + (setq markdown-hide-markup + (if (eq arg 'toggle) + (not markdown-hide-markup) + (> (prefix-numeric-value arg) 0))) + (if markdown-hide-markup + (add-to-invisibility-spec 'markdown-markup) + (remove-from-invisibility-spec 'markdown-markup)) + (when (called-interactively-p 'interactive) + (message "markdown-mode markup hiding %s" (if markdown-hide-markup "enabled" "disabled"))) + (markdown-reload-extensions)) + + +;;; Font Lock ================================================================= + +(require 'font-lock) + +(defgroup markdown-faces nil + "Faces used in Markdown Mode." + :group 'markdown + :group 'faces) + +(defface markdown-italic-face + '((t (:inherit italic))) + "Face for italic text." + :group 'markdown-faces) + +(defface markdown-bold-face + '((t (:inherit bold))) + "Face for bold text." + :group 'markdown-faces) + +(defface markdown-strike-through-face + '((t (:strike-through t))) + "Face for strike-through text." + :group 'markdown-faces) + +(defface markdown-markup-face + '((t (:inherit shadow :slant normal :weight normal))) + "Face for markup elements." + :group 'markdown-faces) + +(defface markdown-header-rule-face + '((t (:inherit markdown-markup-face))) + "Base face for headers rules." + :group 'markdown-faces) + +(defface markdown-header-delimiter-face + '((t (:inherit markdown-markup-face))) + "Base face for headers hash delimiter." + :group 'markdown-faces) + +(defface markdown-list-face + '((t (:inherit markdown-markup-face))) + "Face for list item markers." + :group 'markdown-faces) + +(defface markdown-blockquote-face + '((t (:inherit font-lock-doc-face))) + "Face for blockquote sections." + :group 'markdown-faces) + +(defface markdown-code-face + '((t (:inherit fixed-pitch))) + "Face for inline code, pre blocks, and fenced code blocks. +This may be used, for example, to add a contrasting background to +inline code fragments and code blocks." + :group 'markdown-faces) + +(defface markdown-inline-code-face + '((t (:inherit (markdown-code-face font-lock-constant-face)))) + "Face for inline code." + :group 'markdown-faces) + +(defface markdown-pre-face + '((t (:inherit (markdown-code-face font-lock-constant-face)))) + "Face for preformatted text." + :group 'markdown-faces) + +(defface markdown-table-face + '((t (:inherit (markdown-code-face)))) + "Face for tables." + :group 'markdown-faces) + +(defface markdown-language-keyword-face + '((t (:inherit font-lock-type-face))) + "Face for programming language identifiers." + :group 'markdown-faces) + +(defface markdown-language-info-face + '((t (:inherit font-lock-string-face))) + "Face for programming language info strings." + :group 'markdown-faces) + +(defface markdown-link-face + '((t (:inherit link))) + "Face for links." + :group 'markdown-faces) + +(defface markdown-missing-link-face + '((t (:inherit font-lock-warning-face))) + "Face for missing links." + :group 'markdown-faces) + +(defface markdown-reference-face + '((t (:inherit markdown-markup-face))) + "Face for link references." + :group 'markdown-faces) + +(defface markdown-footnote-marker-face + '((t (:inherit markdown-markup-face))) + "Face for footnote markers." + :group 'markdown-faces) + +(defface markdown-footnote-text-face + '((t (:inherit font-lock-comment-face))) + "Face for footnote text." + :group 'markdown-faces) + +(defface markdown-url-face + '((t (:inherit font-lock-string-face))) + "Face for URLs that are part of markup. +For example, this applies to URLs in inline links: +[link text](http://example.com/)." + :group 'markdown-faces) + +(defface markdown-plain-url-face + '((t (:inherit markdown-link-face))) + "Face for URLs that are also links. +For example, this applies to plain angle bracket URLs: +<http://example.com/>." + :group 'markdown-faces) + +(defface markdown-link-title-face + '((t (:inherit font-lock-comment-face))) + "Face for reference link titles." + :group 'markdown-faces) + +(defface markdown-line-break-face + '((t (:inherit font-lock-constant-face :underline t))) + "Face for hard line breaks." + :group 'markdown-faces) + +(defface markdown-comment-face + '((t (:inherit font-lock-comment-face))) + "Face for HTML comments." + :group 'markdown-faces) + +(defface markdown-math-face + '((t (:inherit font-lock-string-face))) + "Face for LaTeX expressions." + :group 'markdown-faces) + +(defface markdown-metadata-key-face + '((t (:inherit font-lock-variable-name-face))) + "Face for metadata keys." + :group 'markdown-faces) + +(defface markdown-metadata-value-face + '((t (:inherit font-lock-string-face))) + "Face for metadata values." + :group 'markdown-faces) + +(defface markdown-gfm-checkbox-face + '((t (:inherit font-lock-builtin-face))) + "Face for GFM checkboxes." + :group 'markdown-faces) + +(defface markdown-highlight-face + '((t (:inherit highlight))) + "Face for mouse highlighting." + :group 'markdown-faces) + +(defface markdown-hr-face + '((t (:inherit markdown-markup-face))) + "Face for horizontal rules." + :group 'markdown-faces) + +(defface markdown-html-tag-name-face + '((t (:inherit font-lock-type-face))) + "Face for HTML tag names." + :group 'markdown-faces) + +(defface markdown-html-tag-delimiter-face + '((t (:inherit markdown-markup-face))) + "Face for HTML tag delimiters." + :group 'markdown-faces) + +(defface markdown-html-attr-name-face + '((t (:inherit font-lock-variable-name-face))) + "Face for HTML attribute names." + :group 'markdown-faces) + +(defface markdown-html-attr-value-face + '((t (:inherit font-lock-string-face))) + "Face for HTML attribute values." + :group 'markdown-faces) + +(defface markdown-html-entity-face + '((t (:inherit font-lock-variable-name-face))) + "Face for HTML entities." + :group 'markdown-faces) + +(defface markdown-highlighting-face + '((t (:background "yellow" :foreground "black"))) + "Face for highlighting." + :group 'markdown-faces) + +(defcustom markdown-header-scaling nil + "Whether to use variable-height faces for headers. +When non-nil, `markdown-header-face' will inherit from +`variable-pitch' and the scaling values in +`markdown-header-scaling-values' will be applied to +headers of levels one through six respectively." + :type 'boolean + :initialize #'custom-initialize-default + :set (lambda (symbol value) + (set-default symbol value) + (markdown-update-header-faces value)) + :group 'markdown-faces + :package-version '(markdown-mode . "2.2")) + +(defcustom markdown-header-scaling-values + '(2.0 1.7 1.4 1.1 1.0 1.0) + "List of scaling values for headers of level one through six. +Used when `markdown-header-scaling' is non-nil." + :type '(repeat float) + :initialize #'custom-initialize-default + :set (lambda (symbol value) + (set-default symbol value) + (markdown-update-header-faces markdown-header-scaling value))) + +(defmacro markdown--dotimes-when-compile (i-n body) + (declare (indent 1) (debug ((symbolp form) form))) + (let ((var (car i-n)) + (n (cadr i-n)) + (code ())) + (dotimes (i (eval n t)) + (push (eval body `((,var . ,i))) code)) + `(progn ,@(nreverse code)))) + +(defface markdown-header-face + `((t (:inherit (,@(when markdown-header-scaling '(variable-pitch)) + font-lock-function-name-face) + :weight bold))) + "Base face for headers.") + +(markdown--dotimes-when-compile (num 6) + (let* ((num1 (1+ num)) + (face-name (intern (format "markdown-header-face-%s" num1)))) + `(defface ,face-name + (,'\` ((t (:inherit markdown-header-face + :height + (,'\, (if markdown-header-scaling + (float (nth ,num markdown-header-scaling-values)) + 1.0)))))) + (format "Face for level %s headers. +You probably don't want to customize this face directly. Instead +you can customize the base face `markdown-header-face' or the +variable-height variable `markdown-header-scaling'." ,num1)))) + +(defun markdown-update-header-faces (&optional scaling scaling-values) + "Update header faces, depending on if header SCALING is desired. +If so, use given list of SCALING-VALUES relative to the baseline +size of `markdown-header-face'." + (dotimes (num 6) + (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num)))) + (scale (cond ((not scaling) 1.0) + (scaling-values (float (nth num scaling-values))) + (t (float (nth num markdown-header-scaling-values)))))) + (unless (get face-name 'saved-face) ; Don't update customized faces + (set-face-attribute face-name nil :height scale))))) + +(defun markdown-syntactic-face (state) + "Return font-lock face for characters with given STATE. +See `font-lock-syntactic-face-function' for details." + (let ((in-comment (nth 4 state))) + (cond + (in-comment 'markdown-comment-face) + (t nil)))) + +(defcustom markdown-list-item-bullets + '("●" "◎" "○" "◆" "◇" "►" "•") + "List of bullets to use for unordered lists. +It can contain any number of symbols, which will be repeated. +Depending on your font, some reasonable choices are: +♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ❀ ◆ ◖ ▶ ► • ★ ▸." + :group 'markdown + :type '(repeat (string :tag "Bullet character")) + :package-version '(markdown-mode . "2.3")) + +(defun markdown--footnote-marker-properties () + "Return a font-lock facespec expression for footnote marker text." + `(face markdown-footnote-marker-face + ,@(when markdown-hide-markup + `(display ,markdown-footnote-display)))) + +(defun markdown--pandoc-inline-footnote-properties () + "Return a font-lock facespec expression for Pandoc inline footnote text." + `(face markdown-footnote-text-face + ,@(when markdown-hide-markup + `(display ,markdown-footnote-display)))) + +(defvar markdown-mode-font-lock-keywords + `((markdown-match-yaml-metadata-begin . ((1 'markdown-markup-face))) + (markdown-match-yaml-metadata-end . ((1 'markdown-markup-face))) + (markdown-match-yaml-metadata-key . ((1 'markdown-metadata-key-face) + (2 'markdown-markup-face) + (3 'markdown-metadata-value-face))) + (markdown-match-gfm-open-code-blocks . ((1 markdown-markup-properties) + (2 markdown-markup-properties nil t) + (3 markdown-language-keyword-properties nil t) + (4 markdown-language-info-properties nil t) + (5 markdown-markup-properties nil t))) + (markdown-match-gfm-close-code-blocks . ((0 markdown-markup-properties))) + (markdown-fontify-gfm-code-blocks) + (markdown-fontify-tables) + (markdown-match-fenced-start-code-block . ((1 markdown-markup-properties) + (2 markdown-markup-properties nil t) + (3 markdown-language-keyword-properties nil t) + (4 markdown-language-info-properties nil t) + (5 markdown-markup-properties nil t))) + (markdown-match-fenced-end-code-block . ((0 markdown-markup-properties))) + (markdown-fontify-fenced-code-blocks) + (markdown-match-pre-blocks . ((0 'markdown-pre-face))) + (markdown-fontify-headings) + (markdown-match-declarative-metadata . ((1 'markdown-metadata-key-face) + (2 'markdown-markup-face) + (3 'markdown-metadata-value-face))) + (markdown-match-pandoc-metadata . ((1 'markdown-markup-face) + (2 'markdown-markup-face) + (3 'markdown-metadata-value-face))) + (markdown-fontify-hrs) + (markdown-match-code . ((1 markdown-markup-properties prepend) + (2 'markdown-inline-code-face prepend) + (3 markdown-markup-properties prepend))) + (,markdown-regex-kbd . ((1 markdown-markup-properties) + (2 'markdown-inline-code-face) + (3 markdown-markup-properties))) + (markdown-fontify-angle-uris) + (,markdown-regex-email . 'markdown-plain-url-face) + (markdown-match-html-tag . ((1 'markdown-html-tag-delimiter-face t) + (2 'markdown-html-tag-name-face t) + (3 'markdown-html-tag-delimiter-face t) + ;; Anchored matcher for HTML tag attributes + (,markdown-regex-html-attr + ;; Before searching, move past tag + ;; name; set limit at tag close. + (progn + (goto-char (match-end 2)) (match-end 3)) + nil + . ((1 'markdown-html-attr-name-face) + (3 'markdown-html-tag-delimiter-face nil t) + (4 'markdown-html-attr-value-face nil t))))) + (,markdown-regex-html-entity . 'markdown-html-entity-face) + (markdown-fontify-list-items) + (,markdown-regex-footnote . ((1 markdown-markup-properties) ; [^ + (2 (markdown--footnote-marker-properties)) ; label + (3 markdown-markup-properties))) ; ] + (,markdown-regex-pandoc-inline-footnote . ((1 markdown-markup-properties) ; ^ + (2 markdown-markup-properties) ; [ + (3 (markdown--pandoc-inline-footnote-properties)) ; text + (4 markdown-markup-properties))) ; ] + (markdown-match-includes . ((1 markdown-markup-properties) + (2 markdown-markup-properties nil t) + (3 markdown-include-title-properties nil t) + (4 markdown-markup-properties nil t) + (5 markdown-markup-properties) + (6 'markdown-url-face) + (7 markdown-markup-properties))) + (markdown-fontify-inline-links) + (markdown-fontify-reference-links) + (,markdown-regex-reference-definition . ((1 'markdown-markup-face) ; [ + (2 'markdown-reference-face) ; label + (3 'markdown-markup-face) ; ] + (4 'markdown-markup-face) ; : + (5 'markdown-url-face) ; url + (6 'markdown-link-title-face))) ; "title" (optional) + (markdown-fontify-plain-uris) + ;; Math mode $..$ + (markdown-match-math-single . ((1 'markdown-markup-face prepend) + (2 'markdown-math-face append) + (3 'markdown-markup-face prepend))) + ;; Math mode $$..$$ + (markdown-match-math-double . ((1 'markdown-markup-face prepend) + (2 'markdown-math-face append) + (3 'markdown-markup-face prepend))) + ;; Math mode \[..\] and \\[..\\] + (markdown-match-math-display . ((1 'markdown-markup-face prepend) + (3 'markdown-math-face append) + (4 'markdown-markup-face prepend))) + (markdown-match-bold . ((1 markdown-markup-properties prepend) + (2 'markdown-bold-face append) + (3 markdown-markup-properties prepend))) + (markdown-match-italic . ((1 markdown-markup-properties prepend) + (2 'markdown-italic-face append) + (3 markdown-markup-properties prepend))) + (,markdown-regex-strike-through . ((3 markdown-markup-properties) + (4 'markdown-strike-through-face) + (5 markdown-markup-properties))) + (markdown--match-highlighting . ((3 markdown-markup-properties) + (4 'markdown-highlighting-face) + (5 markdown-markup-properties))) + (,markdown-regex-line-break . (1 markdown-line-break-properties prepend)) + (markdown-match-escape . ((1 markdown-markup-properties prepend))) + (markdown-fontify-sub-superscripts) + (markdown-match-inline-attributes . ((0 markdown-markup-properties prepend))) + (markdown-match-leanpub-sections . ((0 markdown-markup-properties))) + (markdown-fontify-blockquotes) + (markdown-match-wiki-link . ((0 'markdown-link-face prepend)))) + "Syntax highlighting for Markdown files.") + +;; Footnotes +(defvar-local markdown-footnote-counter 0 + "Counter for footnote numbers.") + +(defconst markdown-footnote-chars + "[[:alnum:]-]" + "Regular expression matching any character for a footnote identifier.") + +(defconst markdown-regex-footnote-definition + (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)") + "Regular expression matching a footnote definition, capturing the label.") + + +;;; Compatibility ============================================================= + +(defun markdown--pandoc-reference-p () + (let ((bounds (bounds-of-thing-at-point 'word))) + (when (and bounds (char-before (car bounds))) + (= (char-before (car bounds)) ?@)))) + +(defun markdown-flyspell-check-word-p () + "Return t if `flyspell' should check word just before point. +Used for `flyspell-generic-check-word-predicate'." + (save-excursion + (goto-char (1- (point))) + ;; https://github.com/jrblevin/markdown-mode/issues/560 + ;; enable spell check YAML meta data + (if (or (and (markdown-code-block-at-point-p) + (not (markdown-text-property-at-point 'markdown-yaml-metadata-section))) + (markdown-inline-code-at-point-p) + (markdown-in-comment-p) + (markdown--face-p (point) '(markdown-reference-face + markdown-markup-face + markdown-plain-url-face + markdown-inline-code-face + markdown-url-face)) + (markdown--pandoc-reference-p)) + (prog1 nil + ;; If flyspell overlay is put, then remove it + (let ((bounds (bounds-of-thing-at-point 'word))) + (when bounds + (cl-loop for ov in (overlays-in (car bounds) (cdr bounds)) + when (overlay-get ov 'flyspell-overlay) + do + (delete-overlay ov))))) + t))) + + +;;; Markdown Parsing Functions ================================================ + +(defun markdown-cur-line-blank-p () + "Return t if the current line is blank and nil otherwise." + (save-excursion + (beginning-of-line) + (looking-at-p markdown-regex-blank-line))) + +(defun markdown-prev-line-blank () + "Return t if the previous line is blank and nil otherwise. +If we are at the first line, then consider the previous line to be blank." + (or (= (line-beginning-position) (point-min)) + (save-excursion + (forward-line -1) + (looking-at markdown-regex-blank-line)))) + +(defun markdown-prev-line-blank-p () + "Like `markdown-prev-line-blank', but preserve `match-data'." + (save-match-data (markdown-prev-line-blank))) + +(defun markdown-next-line-blank-p () + "Return t if the next line is blank and nil otherwise. +If we are at the last line, then consider the next line to be blank." + (or (= (line-end-position) (point-max)) + (save-excursion + (forward-line 1) + (markdown-cur-line-blank-p)))) + +(defun markdown-prev-line-indent () + "Return the number of leading whitespace characters in the previous line. +Return 0 if the current line is the first line in the buffer." + (save-excursion + (if (= (line-beginning-position) (point-min)) + 0 + (forward-line -1) + (current-indentation)))) + +(defun markdown-next-line-indent () + "Return the number of leading whitespace characters in the next line. +Return 0 if line is the last line in the buffer." + (save-excursion + (if (= (line-end-position) (point-max)) + 0 + (forward-line 1) + (current-indentation)))) + +(defun markdown-new-baseline () + "Determine if the current line begins a new baseline level. +Assume point is positioned at beginning of line." + (or (looking-at markdown-regex-header) + (looking-at markdown-regex-hr) + (and (= (current-indentation) 0) + (not (looking-at markdown-regex-list)) + (markdown-prev-line-blank)))) + +(defun markdown-search-backward-baseline () + "Search backward baseline point with no indentation and not a list item." + (end-of-line) + (let (stop) + (while (not (or stop (bobp))) + (re-search-backward markdown-regex-block-separator-noindent nil t) + (when (match-end 2) + (goto-char (match-end 2)) + (cond + ((markdown-new-baseline) + (setq stop t)) + ((looking-at-p markdown-regex-list) + (setq stop nil)) + (t (setq stop t))))))) + +(defun markdown-update-list-levels (marker indent levels) + "Update list levels given list MARKER, block INDENT, and current LEVELS. +Here, MARKER is a string representing the type of list, INDENT is an integer +giving the indentation, in spaces, of the current block, and LEVELS is a +list of the indentation levels of parent list items. When LEVELS is nil, +it means we are at baseline (not inside of a nested list)." + (cond + ;; New list item at baseline. + ((and marker (null levels)) + (setq levels (list indent))) + ;; List item with greater indentation (four or more spaces). + ;; Increase list level. + ((and marker (>= indent (+ (car levels) markdown-list-indent-width))) + (setq levels (cons indent levels))) + ;; List item with greater or equal indentation (less than four spaces). + ;; Do not increase list level. + ((and marker (>= indent (car levels))) + levels) + ;; Lesser indentation level. + ;; Pop appropriate number of elements off LEVELS list (e.g., lesser + ;; indentation could move back more than one list level). Note + ;; that this block need not be the beginning of list item. + ((< indent (car levels)) + (while (and (> (length levels) 1) + (< indent (+ (cadr levels) markdown-list-indent-width))) + (setq levels (cdr levels))) + levels) + ;; Otherwise, do nothing. + (t levels))) + +(defun markdown-calculate-list-levels () + "Calculate list levels at point. +Return a list of the form (n1 n2 n3 ...) where n1 is the +indentation of the deepest nested list item in the branch of +the list at the point, n2 is the indentation of the parent +list item, and so on. The depth of the list item is therefore +the length of the returned list. If the point is not at or +immediately after a list item, return nil." + (save-excursion + (let ((first (point)) levels indent pre-regexp) + ;; Find a baseline point with zero list indentation + (markdown-search-backward-baseline) + ;; Search for all list items between baseline and LOC + (while (and (< (point) first) + (re-search-forward markdown-regex-list first t)) + (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels)))) + (beginning-of-line) + (cond + ;; Make sure this is not a header or hr + ((markdown-new-baseline) (setq levels nil)) + ;; Make sure this is not a line from a pre block + ((looking-at-p pre-regexp)) + ;; If not, then update levels + (t + (setq indent (current-indentation)) + (setq levels (markdown-update-list-levels (match-string 2) + indent levels)))) + (end-of-line)) + levels))) + +(defun markdown-prev-list-item (level) + "Search backward from point for a list item with indentation LEVEL. +Set point to the beginning of the item, and return point, or nil +upon failure." + (let (bounds indent prev) + (setq prev (point)) + (forward-line -1) + (setq indent (current-indentation)) + (while + (cond + ;; List item + ((and (looking-at-p markdown-regex-list) + (setq bounds (markdown-cur-list-item-bounds))) + (cond + ;; Stop and return point at item of equal indentation + ((= (nth 3 bounds) level) + (setq prev (point)) + nil) + ;; Stop and return nil at item with lesser indentation + ((< (nth 3 bounds) level) + (setq prev nil) + nil) + ;; Stop at beginning of buffer + ((bobp) (setq prev nil)) + ;; Continue at item with greater indentation + ((> (nth 3 bounds) level) t))) + ;; Stop at beginning of buffer + ((bobp) (setq prev nil)) + ;; Continue if current line is blank + ((markdown-cur-line-blank-p) t) + ;; Continue while indentation is the same or greater + ((>= indent level) t) + ;; Stop if current indentation is less than list item + ;; and the next is blank + ((and (< indent level) + (markdown-next-line-blank-p)) + (setq prev nil)) + ;; Stop at a header + ((looking-at-p markdown-regex-header) (setq prev nil)) + ;; Stop at a horizontal rule + ((looking-at-p markdown-regex-hr) (setq prev nil)) + ;; Otherwise, continue. + (t t)) + (forward-line -1) + (setq indent (current-indentation))) + prev)) + +(defun markdown-next-list-item (level) + "Search forward from point for the next list item with indentation LEVEL. +Set point to the beginning of the item, and return point, or nil +upon failure." + (let (bounds indent next) + (setq next (point)) + (if (looking-at markdown-regex-header-setext) + (goto-char (match-end 0))) + (forward-line) + (setq indent (current-indentation)) + (while + (cond + ;; Stop at end of the buffer. + ((eobp) nil) + ;; Continue if the current line is blank + ((markdown-cur-line-blank-p) t) + ;; List item + ((and (looking-at-p markdown-regex-list) + (setq bounds (markdown-cur-list-item-bounds))) + (cond + ;; Continue at item with greater indentation + ((> (nth 3 bounds) level) t) + ;; Stop and return point at item of equal indentation + ((= (nth 3 bounds) level) + (setq next (point)) + nil) + ;; Stop and return nil at item with lesser indentation + ((< (nth 3 bounds) level) + (setq next nil) + nil))) + ;; Continue while indentation is the same or greater + ((>= indent level) t) + ;; Stop if current indentation is less than list item + ;; and the previous line was blank. + ((and (< indent level) + (markdown-prev-line-blank-p)) + (setq next nil)) + ;; Stop at a header + ((looking-at-p markdown-regex-header) (setq next nil)) + ;; Stop at a horizontal rule + ((looking-at-p markdown-regex-hr) (setq next nil)) + ;; Otherwise, continue. + (t t)) + (forward-line) + (setq indent (current-indentation))) + next)) + +(defun markdown-cur-list-item-end (level) + "Move to end of list item with pre-marker indentation LEVEL. +Return the point at the end when a list item was found at the +original point. If the point is not in a list item, do nothing." + (let (indent) + (forward-line) + (setq indent (current-indentation)) + (while + (cond + ;; Stop at end of the buffer. + ((eobp) nil) + ;; Continue while indentation is the same or greater + ((>= indent level) t) + ;; Continue if the current line is blank + ((looking-at markdown-regex-blank-line) t) + ;; Stop if current indentation is less than list item + ;; and the previous line was blank. + ((and (< indent level) + (markdown-prev-line-blank)) + nil) + ;; Stop at a new list items of the same or lesser + ;; indentation, headings, and horizontal rules. + ((looking-at (concat "\\(?:" markdown-regex-list + "\\|" markdown-regex-header + "\\|" markdown-regex-hr "\\)")) + nil) + ;; Otherwise, continue. + (t t)) + (forward-line) + (setq indent (current-indentation))) + ;; Don't skip over whitespace for empty list items (marker and + ;; whitespace only), just move to end of whitespace. + (if (save-excursion + (beginning-of-line) + (looking-at (concat markdown-regex-list "[ \t]*$"))) + (goto-char (match-end 3)) + (skip-chars-backward " \t\n")) + (end-of-line) + (point))) + +(defun markdown-cur-list-item-bounds () + "Return bounds for list item at point. +Return a list of the following form: + + (begin end indent nonlist-indent marker checkbox match) + +The named components are: + + - begin: Position of beginning of list item, including leading indentation. + - end: Position of the end of the list item, including list item text. + - indent: Number of characters of indentation before list marker (an integer). + - nonlist-indent: Number characters of indentation, list + marker, and whitespace following list marker (an integer). + - marker: String containing the list marker and following whitespace + (e.g., \"- \" or \"* \"). + - checkbox: String containing the GFM checkbox portion, if any, + including any trailing whitespace before the text + begins (e.g., \"[x] \"). + - match: match data for markdown-regex-list + +As an example, for the following unordered list item + + - item + +the returned list would be + + (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6)) + +If the point is not inside a list item, return nil." + (car (get-text-property (line-beginning-position) 'markdown-list-item))) + +(defun markdown-list-item-at-point-p () + "Return t if there is a list item at the point and nil otherwise." + (save-match-data (markdown-cur-list-item-bounds))) + +(defun markdown-prev-list-item-bounds () + "Return bounds of previous item in the same list of any level. +The return value has the same form as that of +`markdown-cur-list-item-bounds'." + (save-excursion + (let ((cur-bounds (markdown-cur-list-item-bounds)) + (beginning-of-list (save-excursion (markdown-beginning-of-list))) + stop) + (when cur-bounds + (goto-char (nth 0 cur-bounds)) + (while (and (not stop) (not (bobp)) + (re-search-backward markdown-regex-list + beginning-of-list t)) + (unless (or (looking-at markdown-regex-hr) + (markdown-code-block-at-point-p)) + (setq stop (point)))) + (markdown-cur-list-item-bounds))))) + +(defun markdown-next-list-item-bounds () + "Return bounds of next item in the same list of any level. +The return value has the same form as that of +`markdown-cur-list-item-bounds'." + (save-excursion + (let ((cur-bounds (markdown-cur-list-item-bounds)) + (end-of-list (save-excursion (markdown-end-of-list))) + stop) + (when cur-bounds + (goto-char (nth 0 cur-bounds)) + (end-of-line) + (while (and (not stop) (not (eobp)) + (re-search-forward markdown-regex-list + end-of-list t)) + (unless (or (looking-at markdown-regex-hr) + (markdown-code-block-at-point-p)) + (setq stop (point)))) + (when stop + (markdown-cur-list-item-bounds)))))) + +(defun markdown-beginning-of-list () + "Move point to beginning of list at point, if any." + (interactive) + (let ((orig-point (point)) + (list-begin (save-excursion + (markdown-search-backward-baseline) + ;; Stop at next list item, regardless of the indentation. + (markdown-next-list-item (point-max)) + (when (looking-at markdown-regex-list) + (point))))) + (when (and list-begin (<= list-begin orig-point)) + (goto-char list-begin)))) + +(defun markdown-end-of-list () + "Move point to end of list at point, if any." + (interactive) + (let ((start (point)) + (end (save-excursion + (when (markdown-beginning-of-list) + ;; Items can't have nonlist-indent <= 1, so this + ;; moves past all list items. + (markdown-next-list-item 1) + (skip-syntax-backward "-") + (unless (eobp) (forward-char 1)) + (point))))) + (when (and end (>= end start)) + (goto-char end)))) + +(defun markdown-up-list () + "Move point to beginning of parent list item." + (interactive) + (let ((cur-bounds (markdown-cur-list-item-bounds))) + (when cur-bounds + (markdown-prev-list-item (1- (nth 3 cur-bounds))) + (let ((up-bounds (markdown-cur-list-item-bounds))) + (when (and up-bounds (< (nth 3 up-bounds) (nth 3 cur-bounds))) + (point)))))) + +(defun markdown-bounds-of-thing-at-point (thing) + "Call `bounds-of-thing-at-point' for THING with slight modifications. +Does not include trailing newlines when THING is \\='line. Handles the +end of buffer case by setting both endpoints equal to the value of +`point-max', since an empty region will trigger empty markup insertion. +Return bounds of form (beg . end) if THING is found, or nil otherwise." + (let* ((bounds (bounds-of-thing-at-point thing)) + (a (car bounds)) + (b (cdr bounds))) + (when bounds + (when (eq thing 'line) + (cond ((and (eobp) (markdown-cur-line-blank-p)) + (setq a b)) + ((char-equal (char-before b) ?\^J) + (setq b (1- b))))) + (cons a b)))) + +(defun markdown-reference-definition (reference) + "Find out whether Markdown REFERENCE is defined. +REFERENCE should not include the square brackets. +When REFERENCE is defined, return a list of the form (text start end) +containing the definition text itself followed by the start and end +locations of the text. Otherwise, return nil. +Leave match data for `markdown-regex-reference-definition' +intact additional processing." + (let ((reference (downcase reference))) + (save-excursion + (goto-char (point-min)) + (catch 'found + (while (re-search-forward markdown-regex-reference-definition nil t) + (when (string= reference (downcase (match-string-no-properties 2))) + (throw 'found + (list (match-string-no-properties 5) + (match-beginning 5) (match-end 5))))))))) + +(defun markdown-get-defined-references () + "Return all defined reference labels and their line numbers. +They does not include square brackets)." + (save-excursion + (goto-char (point-min)) + (let (refs) + (while (re-search-forward markdown-regex-reference-definition nil t) + (let ((target (match-string-no-properties 2))) + (cl-pushnew + (cons (downcase target) + (markdown-line-number-at-pos (match-beginning 2))) + refs :test #'equal :key #'car))) + (reverse refs)))) + +(defun markdown-get-used-uris () + "Return a list of all used URIs in the buffer." + (save-excursion + (goto-char (point-min)) + (let (uris) + (while (re-search-forward + (concat "\\(?:" markdown-regex-link-inline + "\\|" markdown-regex-angle-uri + "\\|" markdown-regex-uri + "\\|" markdown-regex-email + "\\)") + nil t) + (unless (or (markdown-inline-code-at-point-p) + (markdown-code-block-at-point-p)) + (cl-pushnew (or (match-string-no-properties 6) + (match-string-no-properties 10) + (match-string-no-properties 12) + (match-string-no-properties 13)) + uris :test #'equal))) + (reverse uris)))) + +(defun markdown-inline-code-at-pos (pos &optional from) + "Return non-nil if there is an inline code fragment at POS starting at FROM. +Uses the beginning of the block if FROM is nil. +Return nil otherwise. Set match data according to +`markdown-match-code' upon success. +This function searches the block for a code fragment that +contains the point using `markdown-match-code'. We do this +because `thing-at-point-looking-at' does not work reliably with +`markdown-regex-code'. + +The match data is set as follows: +Group 1 matches the opening backquotes. +Group 2 matches the code fragment itself, without backquotes. +Group 3 matches the closing backquotes." + (save-excursion + (goto-char pos) + (let ((old-point (point)) + (end-of-block (progn (markdown-end-of-text-block) (point))) + found) + (if from + (goto-char from) + (markdown-beginning-of-text-block)) + (while (and (markdown-match-code end-of-block) + (setq found t) + (< (match-end 0) old-point))) + (let ((match-group (if (eq (char-after (match-beginning 0)) ?`) 0 1))) + (and found ; matched something + (<= (match-beginning match-group) old-point) ; match contains old-point + (> (match-end 0) old-point)))))) + +(defun markdown-inline-code-at-pos-p (pos) + "Return non-nil if there is an inline code fragment at POS. +Like `markdown-inline-code-at-pos`, but preserves match data." + (save-match-data (markdown-inline-code-at-pos pos))) + +(defun markdown-inline-code-at-point () + "Return non-nil if the point is at an inline code fragment. +See `markdown-inline-code-at-pos' for details." + (markdown-inline-code-at-pos (point))) + +(defun markdown-inline-code-at-point-p (&optional pos) + "Return non-nil if there is inline code at the POS. +This is a predicate function counterpart to +`markdown-inline-code-at-point' which does not modify the match +data. See `markdown-code-block-at-point-p' for code blocks." + (save-match-data (markdown-inline-code-at-pos (or pos (point))))) + +(defun markdown-code-block-at-pos (pos) + "Return match data list if there is a code block at POS. +Uses text properties at the beginning of the line position. +This includes pre blocks, tilde-fenced code blocks, and GFM +quoted code blocks. Return nil otherwise." + (let ((bol (save-excursion (goto-char pos) (line-beginning-position)))) + (or (get-text-property bol 'markdown-pre) + (let* ((bounds (markdown-get-enclosing-fenced-block-construct pos)) + (second (cl-second bounds))) + (if second + ;; chunks are right open + (when (< pos second) + bounds) + bounds))))) + +;; Function was renamed to emphasize that it does not modify match-data. +(defalias 'markdown-code-block-at-point 'markdown-code-block-at-point-p) + +(defun markdown-code-block-at-point-p (&optional pos) + "Return non-nil if there is a code block at the POS. +This includes pre blocks, tilde-fenced code blocks, and GFM +quoted code blocks. This function does not modify the match +data. See `markdown-inline-code-at-point-p' for inline code." + (save-match-data (markdown-code-block-at-pos (or pos (point))))) + +(defun markdown-heading-at-point (&optional pos) + "Return non-nil if there is a heading at the POS. +Set match data for `markdown-regex-header'." + (let ((match-data (get-text-property (or pos (point)) 'markdown-heading))) + (when match-data + (set-match-data match-data) + t))) + +(defun markdown-pipe-at-bol-p () + "Return non-nil if the line begins with a pipe symbol. +This may be useful for tables and Pandoc's line_blocks extension." + (char-equal (char-after (line-beginning-position)) ?|)) + + +;;; Markdown Font Lock Matching Functions ===================================== + +(defun markdown-range-property-any (begin end prop prop-values) + "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES. +Also returns t if PROP is a list containing one of the PROP-VALUES. +Return nil otherwise." + (let (props) + (catch 'found + (dolist (loc (number-sequence begin end)) + (when (setq props (get-text-property loc prop)) + (cond ((listp props) + ;; props is a list, check for membership + (dolist (val prop-values) + (when (memq val props) (throw 'found loc)))) + (t + ;; props is a scalar, check for equality + (dolist (val prop-values) + (when (eq val props) (throw 'found loc)))))))))) + +(defun markdown-range-properties-exist (begin end props) + (cl-loop + for loc in (number-sequence begin end) + with result = nil + while (not + (setq result + (cl-some (lambda (prop) (get-text-property loc prop)) props))) + finally return result)) + +(defun markdown-match-inline-generic (regex last &optional faceless) + "Match inline REGEX from the point to LAST. +When FACELESS is non-nil, do not return matches where faces have been applied." + (when (re-search-forward regex last t) + (let ((bounds (markdown-code-block-at-pos (match-beginning 1))) + (face (and faceless (text-property-not-all + (match-beginning 0) (match-end 0) 'face nil)))) + (cond + ;; In code block: move past it and recursively search again + (bounds + (when (< (goto-char (cl-second bounds)) last) + (markdown-match-inline-generic regex last faceless))) + ;; When faces are found in the match range, skip over the match and + ;; recursively search again. + (face + (when (< (goto-char (match-end 0)) last) + (markdown-match-inline-generic regex last faceless))) + ;; Keep match data and return t when in bounds. + (t + (<= (match-end 0) last)))))) + +(defun markdown-match-code (last) + "Match inline code fragments from point to LAST." + (unless (bobp) + (backward-char 1)) + (when (markdown-search-until-condition + (lambda () + (and + ;; Advance point in case of failure, but without exceeding last. + (goto-char (min (1+ (match-beginning 1)) last)) + (not (markdown-in-comment-p (match-beginning 1))) + (not (markdown-in-comment-p (match-end 1))) + (not (markdown-code-block-at-pos (match-beginning 1))))) + markdown-regex-code last t) + (set-match-data (list (match-beginning 1) (match-end 1) + (match-beginning 2) (match-end 2) + (match-beginning 3) (match-end 3) + (match-beginning 4) (match-end 4))) + (goto-char (min (1+ (match-end 0)) last (point-max))) + t)) + +(defun markdown--gfm-markup-underscore-p (begin end) + (let ((is-underscore (eql (char-after begin) ?_))) + (if (not is-underscore) + t + (save-excursion + (save-match-data + (goto-char begin) + (and (looking-back "\\(?:^\\|[[:blank:][:punct:]]\\)" (1- begin)) + (progn + (goto-char end) + (looking-at-p "\\(?:[[:blank:][:punct:]]\\|$\\)")))))))) + +(defun markdown-match-bold (last) + "Match inline bold from the point to LAST." + (let (done + retval + last-inline-code) + (while (not done) + (if (markdown-match-inline-generic markdown-regex-bold last) + (let ((is-gfm (derived-mode-p 'gfm-mode)) + (begin (match-beginning 2)) + (end (match-end 2))) + (if (or + (and last-inline-code + (>= begin (car last-inline-code)) + (< begin (cdr last-inline-code))) + (save-match-data + (when (markdown-inline-code-at-pos begin (cdr last-inline-code)) + (setq last-inline-code `(,(match-beginning 0) . ,(match-end 0))))) + (markdown-inline-code-at-pos-p end) + (markdown-in-comment-p) + (markdown-range-property-any + begin begin 'face '(markdown-url-face + markdown-plain-url-face)) + (markdown-range-property-any + begin end 'face '(markdown-hr-face + markdown-math-face)) + (and is-gfm (not (markdown--gfm-markup-underscore-p begin end)))) + (progn (goto-char (min (1+ begin) last)) + (unless (< (point) last) + (setq + done t))) + (set-match-data (list (match-beginning 2) (match-end 2) + (match-beginning 3) (match-end 3) + (match-beginning 4) (match-end 4) + (match-beginning 5) (match-end 5))) + (setq done t + retval t))) + (setq done t))) + retval)) + +(defun markdown-match-italic (last) + "Match inline italics from the point to LAST." + (let* ((is-gfm (derived-mode-p 'gfm-mode)) + (regex (if is-gfm + markdown-regex-gfm-italic + markdown-regex-italic))) + (let (done + retval + last-inline-code) + (while (not done) + (if (and (markdown-match-inline-generic regex last) + (not (markdown--face-p + (match-beginning 1) + '(markdown-html-attr-name-face markdown-html-attr-value-face)))) + (let ((begin (match-beginning 1)) + (end (match-end 1)) + (close-end (match-end 4))) + (if (or (eql (char-before begin) (char-after begin)) + (and last-inline-code + (>= begin (car last-inline-code)) + (< begin (cdr last-inline-code))) + (save-match-data + (when (markdown-inline-code-at-pos begin (cdr last-inline-code)) + (setq last-inline-code `(,(match-beginning 0) . ,(match-end 0))))) + + (markdown-inline-code-at-pos-p (1- end)) + (markdown-in-comment-p) + (markdown-range-property-any + begin begin 'face '(markdown-url-face + markdown-plain-url-face + markdown-markup-face)) + (markdown-range-property-any + begin end 'face '(markdown-bold-face + markdown-list-face + markdown-hr-face + markdown-math-face)) + (and is-gfm + (or (char-equal (char-after begin) (char-after (1+ begin))) ;; check bold case + (not (markdown--gfm-markup-underscore-p begin close-end))))) + (progn (goto-char (min (1+ begin) last)) + (unless (< (point) last) + (setq + done t))) + (set-match-data (list (match-beginning 1) (match-end 1) + (match-beginning 2) (match-end 2) + (match-beginning 3) (match-end 3) + (match-beginning 4) (match-end 4))) + (setq done t + retval t))) + (setq done t))) + retval))) + +(defun markdown--match-highlighting (last) + (when markdown-enable-highlighting-syntax + (re-search-forward markdown-regex-highlighting last t))) + +(defun markdown-match-escape (last) + "Match escape characters (backslashes) from point to LAST. +Backlashes only count as escape characters outside of literal +regions (e.g. code blocks). See `markdown-literal-faces'." + (catch 'found + (while (search-forward-regexp markdown-regex-escape last t) + (let* ((face (get-text-property (match-beginning 1) 'face)) + (face-list (if (listp face) face (list face)))) + ;; Ignore any backslashes with a literal face. + (unless (cl-intersection face-list markdown-literal-faces) + (throw 'found t)))))) + +(defun markdown-match-math-generic (regex last) + "Match REGEX from point to LAST. +REGEX is either `markdown-regex-math-inline-single' for matching +$..$ or `markdown-regex-math-inline-double' for matching $$..$$." + (when (markdown-match-inline-generic regex last) + (let ((begin (match-beginning 1)) (end (match-end 1))) + (prog1 + (if (or (markdown-range-property-any + begin end 'face + '(markdown-inline-code-face markdown-bold-face)) + (markdown-range-properties-exist + begin end + (markdown-get-fenced-block-middle-properties))) + (markdown-match-math-generic regex last) + t) + (goto-char (1+ (match-end 0))))))) + +(defun markdown-match-list-items (last) + "Match list items from point to LAST." + (let* ((first (point)) + (pos first) + (prop 'markdown-list-item) + (bounds (car (get-text-property pos prop)))) + (while + (and (or (null (setq bounds (car (get-text-property pos prop)))) + (< (cl-first bounds) pos)) + (< (point) last) + (setq pos (next-single-property-change pos prop nil last)) + (goto-char pos))) + (when bounds + (set-match-data (cl-seventh bounds)) + ;; Step at least one character beyond point. Otherwise + ;; `font-lock-fontify-keywords-region' infloops. + (goto-char (min (1+ (max (line-end-position) first)) + (point-max))) + t))) + +(defun markdown-match-math-single (last) + "Match single quoted $..$ math from point to LAST." + (when markdown-enable-math + (when (and (char-equal (char-after) ?$) + (not (bolp)) + (not (char-equal (char-before) ?\\)) + (not (char-equal (char-before) ?$))) + (forward-char -1)) + (markdown-match-math-generic markdown-regex-math-inline-single last))) + +(defun markdown-match-math-double (last) + "Match double quoted $$..$$ math from point to LAST." + (when markdown-enable-math + (when (and (< (1+ (point)) (point-max)) + (char-equal (char-after) ?$) + (char-equal (char-after (1+ (point))) ?$) + (not (bolp)) + (not (char-equal (char-before) ?\\)) + (not (char-equal (char-before) ?$))) + (forward-char -1)) + (markdown-match-math-generic markdown-regex-math-inline-double last))) + +(defun markdown-match-math-display (last) + "Match bracketed display math \[..\] and \\[..\\] from point to LAST." + (when markdown-enable-math + (markdown-match-math-generic markdown-regex-math-display last))) + +(defun markdown-match-propertized-text (property last) + "Match text with PROPERTY from point to LAST. +Restore match data previously stored in PROPERTY." + (let ((saved (get-text-property (point) property)) + pos) + (unless saved + (setq pos (next-single-property-change (point) property nil last)) + (unless (= pos last) + (setq saved (get-text-property pos property)))) + (when saved + (set-match-data saved) + ;; Step at least one character beyond point. Otherwise + ;; `font-lock-fontify-keywords-region' infloops. + (goto-char (min (1+ (max (match-end 0) (point))) + (point-max))) + saved))) + +(defun markdown-match-pre-blocks (last) + "Match preformatted blocks from point to LAST. +Use data stored in \\='markdown-pre text property during syntax +analysis." + (markdown-match-propertized-text 'markdown-pre last)) + +(defun markdown-match-gfm-code-blocks (last) + "Match GFM quoted code blocks from point to LAST. +Use data stored in \\='markdown-gfm-code text property during syntax +analysis." + (markdown-match-propertized-text 'markdown-gfm-code last)) + +(defun markdown-match-gfm-open-code-blocks (last) + (markdown-match-propertized-text 'markdown-gfm-block-begin last)) + +(defun markdown-match-gfm-close-code-blocks (last) + (markdown-match-propertized-text 'markdown-gfm-block-end last)) + +(defun markdown-match-fenced-code-blocks (last) + "Match fenced code blocks from the point to LAST." + (markdown-match-propertized-text 'markdown-fenced-code last)) + +(defun markdown-match-fenced-start-code-block (last) + (markdown-match-propertized-text 'markdown-tilde-fence-begin last)) + +(defun markdown-match-fenced-end-code-block (last) + (markdown-match-propertized-text 'markdown-tilde-fence-end last)) + +(defun markdown-match-blockquotes (last) + "Match blockquotes from point to LAST. +Use data stored in \\='markdown-blockquote text property during syntax +analysis." + (markdown-match-propertized-text 'markdown-blockquote last)) + +(defun markdown-match-hr (last) + "Match horizontal rules comments from the point to LAST." + (markdown-match-propertized-text 'markdown-hr last)) + +(defun markdown-match-comments (last) + "Match HTML comments from the point to LAST." + (when (and (skip-syntax-forward "^<" last)) + (let ((beg (point))) + (when (and (skip-syntax-forward "^>" last) (< (point) last)) + (forward-char) + (set-match-data (list beg (point))) + t)))) + +(defun markdown-match-generic-links (last ref) + "Match inline links from point to LAST. +When REF is non-nil, match reference links instead of standard +links with URLs. +This function should only be used during font-lock, as it +determines syntax based on the presence of faces for previously +processed elements." + ;; Search for the next potential link (not in a code block). + (let ((prohibited-faces '(markdown-pre-face + markdown-code-face + markdown-inline-code-face + markdown-comment-face)) + found) + (while + (and (not found) (< (point) last) + (progn + ;; Clear match data to test for a match after functions returns. + (set-match-data nil) + ;; Preliminary regular expression search so we can return + ;; quickly upon failure. This doesn't handle malformed links + ;; or nested square brackets well, so if it passes we back up + ;; continue with a more precise search. + (re-search-forward + (if ref + markdown-regex-link-reference + markdown-regex-link-inline) + last 'limit))) + ;; Keep searching if this is in a code block, inline code, or a + ;; comment, or if it is include syntax. The link text portion + ;; (group 3) may contain inline code or comments, but the + ;; markup, URL, and title should not be part of such elements. + (if (or (markdown-range-property-any + (match-beginning 0) (match-end 2) 'face prohibited-faces) + (markdown-range-property-any + (match-beginning 4) (match-end 0) 'face prohibited-faces) + (and (char-equal (char-after (line-beginning-position)) ?<) + (char-equal (char-after (1+ (line-beginning-position))) ?<))) + (set-match-data nil) + (setq found t)))) + ;; Match opening exclamation point (optional) and left bracket. + (when (match-beginning 2) + (let* ((bang (match-beginning 1)) + (first-begin (match-beginning 2)) + ;; Find end of block to prevent matching across blocks. + (end-of-block (save-excursion + (progn + (goto-char (match-beginning 2)) + (markdown-end-of-text-block) + (point)))) + ;; Move over balanced expressions to closing right bracket. + ;; Catch unbalanced expression errors and return nil. + (first-end (condition-case nil + (and (goto-char first-begin) + (scan-sexps (point) 1)) + (error nil))) + ;; Continue with point at CONT-POINT upon failure. + (cont-point (min (1+ first-begin) last)) + second-begin second-end url-begin url-end + title-begin title-end) + ;; When bracket found, in range, and followed by a left paren/bracket... + (when (and first-end (< first-end end-of-block) (goto-char first-end) + (char-equal (char-after (point)) (if ref ?\[ ?\())) + ;; Scan across balanced expressions for closing parenthesis/bracket. + (setq second-begin (point) + second-end (condition-case nil + (scan-sexps (point) 1) + (error nil))) + ;; Check that closing parenthesis/bracket is in range. + (if (and second-end (<= second-end end-of-block) (<= second-end last)) + (progn + ;; Search for (optional) title inside closing parenthesis + (when (and (not ref) (search-forward "\"" second-end t)) + (setq title-begin (1- (point)) + title-end (and (goto-char second-end) + (search-backward "\"" (1+ title-begin) t)) + title-end (and title-end (1+ title-end)))) + ;; Store URL/reference range + (setq url-begin (1+ second-begin) + url-end (1- (or title-begin second-end))) + ;; Set match data, move point beyond link, and return + (set-match-data + (list (or bang first-begin) second-end ; 0 - all + bang (and bang (1+ bang)) ; 1 - bang + first-begin (1+ first-begin) ; 2 - markup + (1+ first-begin) (1- first-end) ; 3 - link text + (1- first-end) first-end ; 4 - markup + second-begin (1+ second-begin) ; 5 - markup + url-begin url-end ; 6 - url/reference + title-begin title-end ; 7 - title + (1- second-end) second-end)) ; 8 - markup + ;; Nullify cont-point and leave point at end and + (setq cont-point nil) + (goto-char second-end)) + ;; If no closing parenthesis in range, update continuation point + (setq cont-point (min end-of-block second-begin)))) + (cond + ;; On failure, continue searching at cont-point + ((and cont-point (< cont-point last)) + (goto-char cont-point) + (markdown-match-generic-links last ref)) + ;; No more text, return nil + ((and cont-point (= cont-point last)) + nil) + ;; Return t if a match occurred + (t t))))) + +(defun markdown-match-angle-uris (last) + "Match angle bracket URIs from point to LAST." + (when (markdown-match-inline-generic markdown-regex-angle-uri last) + (goto-char (1+ (match-end 0))))) + +(defun markdown-match-plain-uris (last) + "Match plain URIs from point to LAST." + (when (markdown-match-inline-generic markdown-regex-uri last t) + (goto-char (1+ (match-end 0))))) + +(defvar markdown-conditional-search-function #'re-search-forward + "Conditional search function used in `markdown-search-until-condition'. +Made into a variable to allow for dynamic let-binding.") + +(defun markdown-search-until-condition (condition &rest args) + (let (ret) + (while (and (not ret) (apply markdown-conditional-search-function args)) + (setq ret (funcall condition))) + ret)) + +(defun markdown-metadata-line-p (pos regexp) + (save-excursion + (or (= (line-number-at-pos pos) 1) + (progn + (forward-line -1) + ;; skip multi-line metadata + (while (and (looking-at-p "^\\s-+[[:alpha:]]") + (> (line-number-at-pos (point)) 1)) + (forward-line -1)) + (looking-at-p regexp))))) + +(defun markdown-match-generic-metadata (regexp last) + "Match metadata declarations specified by REGEXP from point to LAST. +These declarations must appear inside a metadata block that begins at +the beginning of the buffer and ends with a blank line (or the end of +the buffer)." + (let* ((first (point)) + (end-re "\n[ \t]*\n\\|\n\\'\\|\\'") + (block-begin (goto-char 1)) + (block-end (re-search-forward end-re nil t))) + (if (and block-end (> first block-end)) + ;; Don't match declarations if there is no metadata block or if + ;; the point is beyond the block. Move point to point-max to + ;; prevent additional searches and return return nil since nothing + ;; was found. + (progn (goto-char (point-max)) nil) + ;; If a block was found that begins before LAST and ends after + ;; point, search for declarations inside it. If the starting is + ;; before the beginning of the block, start there. Otherwise, + ;; move back to FIRST. + (goto-char (if (< first block-begin) block-begin first)) + (if (and (re-search-forward regexp (min last block-end) t) + (markdown-metadata-line-p (point) regexp)) + ;; If a metadata declaration is found, set match-data and return t. + (let ((key-beginning (match-beginning 1)) + (key-end (match-end 1)) + (markup-begin (match-beginning 2)) + (markup-end (match-end 2)) + (value-beginning (match-beginning 3))) + (set-match-data (list key-beginning (point) ; complete metadata + key-beginning key-end ; key + markup-begin markup-end ; markup + value-beginning (point))) ; value + t) + ;; Otherwise, move the point to last and return nil + (goto-char last) + nil)))) + +(defun markdown-match-declarative-metadata (last) + "Match declarative metadata from the point to LAST." + (markdown-match-generic-metadata markdown-regex-declarative-metadata last)) + +(defun markdown-match-pandoc-metadata (last) + "Match Pandoc metadata from the point to LAST." + (markdown-match-generic-metadata markdown-regex-pandoc-metadata last)) + +(defun markdown-match-yaml-metadata-begin (last) + (markdown-match-propertized-text 'markdown-yaml-metadata-begin last)) + +(defun markdown-match-yaml-metadata-end (last) + (markdown-match-propertized-text 'markdown-yaml-metadata-end last)) + +(defun markdown-match-yaml-metadata-key (last) + (markdown-match-propertized-text 'markdown-metadata-key last)) + +(defun markdown-match-wiki-link (last) + "Match wiki links from point to LAST." + (when (and markdown-enable-wiki-links + (not markdown-wiki-link-fontify-missing) + (markdown-match-inline-generic markdown-regex-wiki-link last)) + (let ((begin (match-beginning 1)) (end (match-end 1))) + (if (or (markdown-in-comment-p begin) + (markdown-in-comment-p end) + (markdown-inline-code-at-pos-p begin) + (markdown-inline-code-at-pos-p end) + (markdown-code-block-at-pos begin)) + (progn (goto-char (min (1+ begin) last)) + (when (< (point) last) + (markdown-match-wiki-link last))) + (set-match-data (list begin end)) + t)))) + +(defun markdown-match-inline-attributes (last) + "Match inline attributes from point to LAST." + ;; #428 re-search-forward markdown-regex-inline-attributes is very slow. + ;; So use simple regex for re-search-forward and use markdown-regex-inline-attributes + ;; against matched string. + (when (markdown-match-inline-generic "[ \t]*\\({\\)\\([^\n]*\\)}[ \t]*$" last) + (if (not (string-match-p markdown-regex-inline-attributes (match-string 0))) + (markdown-match-inline-attributes last) + (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) + (markdown-inline-code-at-pos-p (match-end 0)) + (markdown-in-comment-p)) + t)))) + +(defun markdown-match-leanpub-sections (last) + "Match Leanpub section markers from point to LAST." + (when (markdown-match-inline-generic markdown-regex-leanpub-sections last) + (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) + (markdown-inline-code-at-pos-p (match-end 0)) + (markdown-in-comment-p)) + t))) + +(defun markdown-match-includes (last) + "Match include statements from point to LAST. +Sets match data for the following seven groups: +Group 1: opening two angle brackets +Group 2: opening title delimiter (optional) +Group 3: title text (optional) +Group 4: closing title delimiter (optional) +Group 5: opening filename delimiter +Group 6: filename +Group 7: closing filename delimiter" + (when (markdown-match-inline-generic markdown-regex-include last) + (let ((valid (not (or (markdown-in-comment-p (match-beginning 0)) + (markdown-in-comment-p (match-end 0)) + (markdown-code-block-at-pos (match-beginning 0)))))) + (cond + ;; Parentheses and maybe square brackets, but no curly braces: + ;; match optional title in square brackets and file in parentheses. + ((and valid (match-beginning 5) + (not (match-beginning 8))) + (set-match-data (list (match-beginning 1) (match-end 7) + (match-beginning 1) (match-end 1) + (match-beginning 2) (match-end 2) + (match-beginning 3) (match-end 3) + (match-beginning 4) (match-end 4) + (match-beginning 5) (match-end 5) + (match-beginning 6) (match-end 6) + (match-beginning 7) (match-end 7)))) + ;; Only square brackets present: match file in square brackets. + ((and valid (match-beginning 2) + (not (match-beginning 5)) + (not (match-beginning 7))) + (set-match-data (list (match-beginning 1) (match-end 4) + (match-beginning 1) (match-end 1) + nil nil + nil nil + nil nil + (match-beginning 2) (match-end 2) + (match-beginning 3) (match-end 3) + (match-beginning 4) (match-end 4)))) + ;; Only curly braces present: match file in curly braces. + ((and valid (match-beginning 8) + (not (match-beginning 2)) + (not (match-beginning 5))) + (set-match-data (list (match-beginning 1) (match-end 10) + (match-beginning 1) (match-end 1) + nil nil + nil nil + nil nil + (match-beginning 8) (match-end 8) + (match-beginning 9) (match-end 9) + (match-beginning 10) (match-end 10)))) + (t + ;; Not a valid match, move to next line and search again. + (forward-line) + (when (< (point) last) + (setq valid (markdown-match-includes last))))) + valid))) + +(defun markdown-match-html-tag (last) + "Match HTML tags from point to LAST." + (when (and markdown-enable-html + (markdown-match-inline-generic markdown-regex-html-tag last t)) + (set-match-data (list (match-beginning 0) (match-end 0) + (match-beginning 1) (match-end 1) + (match-beginning 2) (match-end 2) + (match-beginning 9) (match-end 9))) + t)) + + +;;; Markdown Font Fontification Functions ===================================== + +(defvar markdown--first-displayable-cache (make-hash-table :test #'equal)) + +(defun markdown--first-displayable (seq) + "Return the first displayable character or string in SEQ. +SEQ may be an atom or a sequence." + (let ((c (gethash seq markdown--first-displayable-cache t))) + (if (not (eq c t)) + c + (puthash seq + (let ((seq (if (listp seq) seq (list seq)))) + (cond ((stringp (car seq)) + (cl-find-if + (lambda (str) + (and (mapcar #'char-displayable-p (string-to-list str)))) + seq)) + ((characterp (car seq)) + (cl-find-if #'char-displayable-p seq)))) + markdown--first-displayable-cache)))) + +(defun markdown--marginalize-string (level) + "Generate atx markup string of given LEVEL for left margin." + (let ((margin-left-space-count + (- markdown-marginalize-headers-margin-width level))) + (concat (make-string margin-left-space-count ? ) + (make-string level ?#)))) + +(defun markdown-marginalize-update-current () + "Update the window configuration to create a left margin." + (if window-system + (let* ((header-delimiter-font-width + (window-font-width nil 'markdown-header-delimiter-face)) + (margin-pixel-width (* markdown-marginalize-headers-margin-width + header-delimiter-font-width)) + (margin-char-width (/ margin-pixel-width (default-font-width)))) + (set-window-margins nil margin-char-width)) + ;; As a fallback, simply set margin based on character count. + (set-window-margins nil (1+ markdown-marginalize-headers-margin-width)))) + +(defun markdown-fontify-headings (last) + "Add text properties to headings from point to LAST." + (when (markdown-match-propertized-text 'markdown-heading last) + (let* ((level (markdown-outline-level)) + (heading-face + (intern (format "markdown-header-face-%d" level))) + (heading-props `(face ,heading-face)) + (left-markup-props + `(face markdown-header-delimiter-face + ,@(cond + (markdown-hide-markup + `(display "")) + (markdown-marginalize-headers + `(display ((margin left-margin) + ,(markdown--marginalize-string level))))))) + (right-markup-props + `(face markdown-header-delimiter-face + ,@(when markdown-hide-markup `(display "")))) + (rule-props `(face markdown-header-rule-face + ,@(when markdown-hide-markup `(display ""))))) + (if (match-end 1) + ;; Setext heading + (progn (add-text-properties + (match-beginning 1) (match-end 1) heading-props) + (if (= level 1) + (add-text-properties + (match-beginning 2) (match-end 2) rule-props) + (add-text-properties + (match-beginning 3) (match-end 3) rule-props))) + ;; atx heading + (let ((fontified-start + (if (or markdown-hide-markup (not markdown-fontify-whole-heading-line)) + (match-beginning 5) + (match-beginning 0))) + (fontified-end + (if markdown-fontify-whole-heading-line + (min (point-max) (1+ (match-end 0))) + (match-end 5)))) + (add-text-properties + (match-beginning 4) (match-end 4) left-markup-props) + + ;; If closing tag is present + (if (match-end 6) + (progn + (add-text-properties fontified-start fontified-end heading-props) + (when (or markdown-hide-markup (not markdown-fontify-whole-heading-line)) + (add-text-properties (match-beginning 6) (match-end 6) right-markup-props))) + ;; If closing tag is not present + (add-text-properties fontified-start fontified-end heading-props))))) + t)) + +(defun markdown-fontify-tables (last) + (when (re-search-forward "|" last t) + (when (markdown-table-at-point-p) + (font-lock-append-text-property + (line-beginning-position) (min (1+ (line-end-position)) (point-max)) + 'face 'markdown-table-face)) + (forward-line 1) + t)) + +(defun markdown-fontify-blockquotes (last) + "Apply font-lock properties to blockquotes from point to LAST." + (when (markdown-match-blockquotes last) + (let ((display-string + (markdown--first-displayable markdown-blockquote-display-char))) + (add-text-properties + (match-beginning 1) (match-end 1) + (if markdown-hide-markup + `(face markdown-blockquote-face display ,display-string) + `(face markdown-markup-face))) + (font-lock-append-text-property + (match-beginning 0) (match-end 0) 'face 'markdown-blockquote-face) + t))) + +(defun markdown-fontify-list-items (last) + "Apply font-lock properties to list markers from point to LAST." + (when (markdown-match-list-items last) + (when (not (markdown-code-block-at-point-p (match-beginning 2))) + (let* ((indent (length (match-string-no-properties 1))) + (level (/ indent markdown-list-indent-width)) ;; level = 0, 1, 2, ... + (bullet (nth (mod level (length markdown-list-item-bullets)) + markdown-list-item-bullets))) + (add-text-properties + (match-beginning 2) (match-end 2) '(face markdown-list-face)) + (when markdown-hide-markup + (cond + ;; Unordered lists + ((string-match-p "[\\*\\+-]" (match-string 2)) + (add-text-properties + (match-beginning 2) (match-end 2) `(display ,bullet))) + ;; Definition lists + ((string-equal ":" (match-string 2)) + (let ((display-string + (char-to-string (markdown--first-displayable + markdown-definition-display-char)))) + (add-text-properties (match-beginning 2) (match-end 2) + `(display ,display-string)))))))) + t)) + +(defun markdown--fontify-hrs-view-mode (hr-char) + (if (and hr-char (display-supports-face-attributes-p '(:extend t))) + (add-text-properties + (match-beginning 0) (match-end 0) + `(face + (:inherit markdown-hr-face :underline t :extend t) + font-lock-multiline t + display "\n")) + (let ((hr-len (and hr-char (/ (1- (window-body-width)) (char-width hr-char))))) + (add-text-properties + (match-beginning 0) (match-end 0) + `(face + markdown-hr-face font-lock-multiline t + display ,(make-string hr-len hr-char)))))) + +(defun markdown-fontify-hrs (last) + "Add text properties to horizontal rules from point to LAST." + (when (markdown-match-hr last) + (let ((hr-char (markdown--first-displayable markdown-hr-display-char))) + (if (and markdown-hide-markup hr-char) + (markdown--fontify-hrs-view-mode hr-char) + (add-text-properties + (match-beginning 0) (match-end 0) + `(face markdown-hr-face font-lock-multiline t))) + t))) + +(defun markdown-fontify-sub-superscripts (last) + "Apply text properties to sub- and superscripts from point to LAST." + (when (markdown-search-until-condition + (lambda () (and (not (markdown-code-block-at-point-p)) + (not (markdown-inline-code-at-point-p)) + (not (markdown-in-comment-p)) + (not (markdown--math-block-p)))) + markdown-regex-sub-superscript last t) + (let* ((subscript-p (string= (match-string 2) "~")) + (props + (if subscript-p + (car markdown-sub-superscript-display) + (cdr markdown-sub-superscript-display))) + (mp (list 'face 'markdown-markup-face + 'invisible 'markdown-markup))) + (when markdown-hide-markup + (put-text-property (match-beginning 3) (match-end 3) + 'display props)) + (add-text-properties (match-beginning 2) (match-end 2) mp) + (add-text-properties (match-beginning 4) (match-end 4) mp) + t))) + + +;;; Syntax Table ============================================================== + +(defvar markdown-mode-syntax-table + (let ((tab (make-syntax-table text-mode-syntax-table))) + (modify-syntax-entry ?\" "." tab) + tab) + "Syntax table for `markdown-mode'.") + + +;;; Element Insertion ========================================================= + +(defun markdown-ensure-blank-line-before () + "If previous line is not already blank, insert a blank line before point." + (unless (bolp) (insert "\n")) + (unless (or (bobp) (looking-back "\n\\s-*\n" nil)) (insert "\n"))) + +(defun markdown-ensure-blank-line-after () + "If following line is not already blank, insert a blank line after point. +Return the point where it was originally." + (save-excursion + (unless (eolp) (insert "\n")) + (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n")))) + +(defun markdown-wrap-or-insert (s1 s2 &optional thing beg end) + "Insert the strings S1 and S2, wrapping around region or THING. +If a region is specified by the optional BEG and END arguments, +wrap the strings S1 and S2 around that region. +If there is an active region, wrap the strings S1 and S2 around +the region. If there is not an active region but the point is at +THING, wrap that thing (which defaults to word). Otherwise, just +insert S1 and S2 and place the point in between. Return the +bounds of the entire wrapped string, or nil if nothing was wrapped +and S1 and S2 were only inserted." + (let (a b bounds new-point) + (cond + ;; Given region + ((and beg end) + (setq a beg + b end + new-point (+ (point) (length s1)))) + ;; Active region + ((use-region-p) + (setq a (region-beginning) + b (region-end) + new-point (+ (point) (length s1)))) + ;; Thing (word) at point + ((setq bounds (markdown-bounds-of-thing-at-point (or thing 'word))) + (setq a (car bounds) + b (cdr bounds) + new-point (+ (point) (length s1)))) + ;; No active region and no word + (t + (setq a (point) + b (point)))) + (goto-char b) + (insert s2) + (goto-char a) + (insert s1) + (when new-point (goto-char new-point)) + (if (= a b) + nil + (setq b (+ b (length s1) (length s2))) + (cons a b)))) + +(defun markdown-point-after-unwrap (cur prefix suffix) + "Return desired position of point after an unwrapping operation. +CUR gives the position of the point before the operation. +Additionally, two cons cells must be provided. PREFIX gives the +bounds of the prefix string and SUFFIX gives the bounds of the +suffix string." + (cond ((< cur (cdr prefix)) (car prefix)) + ((< cur (car suffix)) (- cur (- (cdr prefix) (car prefix)))) + ((<= cur (cdr suffix)) + (- cur (+ (- (cdr prefix) (car prefix)) + (- cur (car suffix))))) + (t cur))) + +(defun markdown-unwrap-thing-at-point (regexp all text) + "Remove prefix and suffix of thing at point and reposition the point. +When the thing at point matches REGEXP, replace the subexpression +ALL with the string in subexpression TEXT. Reposition the point +in an appropriate location accounting for the removal of prefix +and suffix strings. Return new bounds of string from group TEXT. +When REGEXP is nil, assumes match data is already set." + (when (or (null regexp) + (thing-at-point-looking-at regexp)) + (let ((cur (point)) + (prefix (cons (match-beginning all) (match-beginning text))) + (suffix (cons (match-end text) (match-end all))) + (bounds (cons (match-beginning text) (match-end text)))) + ;; Replace the thing at point + (replace-match (match-string text) t t nil all) + ;; Reposition the point + (goto-char (markdown-point-after-unwrap cur prefix suffix)) + ;; Adjust bounds + (setq bounds (cons (car prefix) + (- (cdr bounds) (- (cdr prefix) (car prefix)))))))) + +(defun markdown-unwrap-things-in-region (beg end regexp all text) + "Remove prefix and suffix of all things in region from BEG to END. +When a thing in the region matches REGEXP, replace the +subexpression ALL with the string in subexpression TEXT. +Return a cons cell containing updated bounds for the region." + (save-excursion + (goto-char beg) + (let ((removed 0) len-all len-text) + (while (re-search-forward regexp (- end removed) t) + (setq len-all (length (match-string-no-properties all))) + (setq len-text (length (match-string-no-properties text))) + (setq removed (+ removed (- len-all len-text))) + (replace-match (match-string text) t t nil all)) + (cons beg (- end removed))))) + +(defun markdown-insert-hr (arg) + "Insert or replace a horizontal rule. +By default, use the first element of `markdown-hr-strings'. When +ARG is non-nil, as when given a prefix, select a different +element as follows. When prefixed with \\[universal-argument], +use the last element of `markdown-hr-strings' instead. When +prefixed with an integer from 1 to the length of +`markdown-hr-strings', use the element in that position instead." + (interactive "*P") + (when (thing-at-point-looking-at markdown-regex-hr) + (delete-region (match-beginning 0) (match-end 0))) + (markdown-ensure-blank-line-before) + (cond ((equal arg '(4)) + (insert (car (reverse markdown-hr-strings)))) + ((and (integerp arg) (> arg 0) + (<= arg (length markdown-hr-strings))) + (insert (nth (1- arg) markdown-hr-strings))) + (t + (insert (car markdown-hr-strings)))) + (markdown-ensure-blank-line-after)) + +(defun markdown--insert-common (start-delim end-delim regex start-group end-group face + &optional skip-space) + (if (use-region-p) + ;; Active region + (let* ((bounds (markdown-unwrap-things-in-region + (region-beginning) (region-end) + regex start-group end-group)) + (beg (car bounds)) + (end (cdr bounds))) + (when (and beg skip-space) + (save-excursion + (goto-char beg) + (skip-chars-forward " \t") + (setq beg (point)))) + (when (and end skip-space) + (save-excursion + (goto-char end) + (skip-chars-backward " \t") + (setq end (point)))) + (markdown-wrap-or-insert start-delim end-delim nil beg end)) + (if (markdown--face-p (point) (list face)) + (save-excursion + (while (and (markdown--face-p (point) (list face)) (not (bobp))) + (forward-char -1)) + (forward-char (- (1- (length start-delim)))) ;; for delimiter + (unless (bolp) + (forward-char -1)) + (when (looking-at regex) + (markdown-unwrap-thing-at-point nil start-group end-group))) + (if (thing-at-point-looking-at regex) + (markdown-unwrap-thing-at-point nil start-group end-group) + (markdown-wrap-or-insert start-delim end-delim 'word nil nil))))) + +(defun markdown-insert-bold () + "Insert markup to make a region or word bold. +If there is an active region, make the region bold. If the point +is at a non-bold word, make the word bold. If the point is at a +bold word or phrase, remove the bold markup. Otherwise, simply +insert bold delimiters and place the point in between them." + (interactive) + (let ((delim (if markdown-bold-underscore "__" "**"))) + (markdown--insert-common delim delim markdown-regex-bold 2 4 'markdown-bold-face t))) + +(defun markdown-insert-italic () + "Insert markup to make a region or word italic. +If there is an active region, make the region italic. If the point +is at a non-italic word, make the word italic. If the point is at an +italic word or phrase, remove the italic markup. Otherwise, simply +insert italic delimiters and place the point in between them." + (interactive) + (let ((delim (if markdown-italic-underscore "_" "*"))) + (markdown--insert-common delim delim markdown-regex-italic 1 3 'markdown-italic-face t))) + +(defun markdown-insert-strike-through () + "Insert markup to make a region or word strikethrough. +If there is an active region, make the region strikethrough. If the point +is at a non-bold word, make the word strikethrough. If the point is at a +strikethrough word or phrase, remove the strikethrough markup. Otherwise, +simply insert bold delimiters and place the point in between them." + (interactive) + (markdown--insert-common + "~~" "~~" markdown-regex-strike-through 2 4 'markdown-strike-through-face t)) + +(defun markdown-insert-code () + "Insert markup to make a region or word an inline code fragment. +If there is an active region, make the region an inline code +fragment. If the point is at a word, make the word an inline +code fragment. Otherwise, simply insert code delimiters and +place the point in between them." + (interactive) + (if (use-region-p) + ;; Active region + (let ((bounds (markdown-unwrap-things-in-region + (region-beginning) (region-end) + markdown-regex-code 1 3))) + (markdown-wrap-or-insert "`" "`" nil (car bounds) (cdr bounds))) + ;; Code markup removal, code markup for word, or empty markup insertion + (if (markdown-inline-code-at-point) + (markdown-unwrap-thing-at-point nil 0 2) + (markdown-wrap-or-insert "`" "`" 'word nil nil)))) + +(defun markdown-insert-kbd () + "Insert markup to wrap region or word in <kbd> tags. +If there is an active region, use the region. If the point is at +a word, use the word. Otherwise, simply insert <kbd> tags and +place the point in between them." + (interactive) + (if (use-region-p) + ;; Active region + (let ((bounds (markdown-unwrap-things-in-region + (region-beginning) (region-end) + markdown-regex-kbd 0 2))) + (markdown-wrap-or-insert "<kbd>" "</kbd>" nil (car bounds) (cdr bounds))) + ;; Markup removal, markup for word, or empty markup insertion + (if (thing-at-point-looking-at markdown-regex-kbd) + (markdown-unwrap-thing-at-point nil 0 2) + (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil)))) + +(defun markdown-insert-inline-link (text url &optional title) + "Insert an inline link with TEXT pointing to URL. +Optionally, the user can provide a TITLE." + (let ((cur (point))) + (setq title (and title (concat " \"" title "\""))) + (insert (concat "[" text "](" url title ")")) + (cond ((not text) (goto-char (+ 1 cur))) + ((not url) (goto-char (+ 3 (length text) cur)))))) + +(defun markdown-insert-inline-image (text url &optional title) + "Insert an inline link with alt TEXT pointing to URL. +Optionally, also provide a TITLE." + (let ((cur (point))) + (setq title (and title (concat " \"" title "\""))) + (insert (concat "![" text "](" url title ")")) + (cond ((not text) (goto-char (+ 2 cur))) + ((not url) (goto-char (+ 4 (length text) cur)))))) + +(defun markdown-insert-reference-link (text label &optional url title) + "Insert a reference link and, optionally, a reference definition. +The link TEXT will be inserted followed by the optional LABEL. +If a URL is given, also insert a definition for the reference +LABEL according to `markdown-reference-location'. If a TITLE is +given, it will be added to the end of the reference definition +and will be used to populate the title attribute when converted +to XHTML. If URL is nil, insert only the link portion (for +example, when a reference label is already defined)." + (insert (concat "[" text "][" label "]")) + (when url + (markdown-insert-reference-definition + (if (string-equal label "") text label) + url title))) + +(defun markdown-insert-reference-image (text label &optional url title) + "Insert a reference image and, optionally, a reference definition. +The alt TEXT will be inserted followed by the optional LABEL. +If a URL is given, also insert a definition for the reference +LABEL according to `markdown-reference-location'. If a TITLE is +given, it will be added to the end of the reference definition +and will be used to populate the title attribute when converted +to XHTML. If URL is nil, insert only the link portion (for +example, when a reference label is already defined)." + (insert (concat "![" text "][" label "]")) + (when url + (markdown-insert-reference-definition + (if (string-equal label "") text label) + url title))) + +(defun markdown-insert-reference-definition (label &optional url title) + "Add definition for reference LABEL with URL and TITLE. +LABEL is a Markdown reference label without square brackets. +URL and TITLE are optional. When given, the TITLE will +be used to populate the title attribute when converted to XHTML." + ;; END specifies where to leave the point upon return + (let ((end (point))) + (cl-case markdown-reference-location + (end (goto-char (point-max))) + (immediately (markdown-end-of-text-block)) + (subtree (markdown-end-of-subtree)) + (header (markdown-end-of-defun))) + ;; Skip backwards over local variables. This logic is similar to the one + ;; used in ‘hack-local-variables’. + (when (and enable-local-variables (eobp)) + (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move) + (when (let ((case-fold-search t)) + (search-forward "Local Variables:" nil :move)) + (beginning-of-line 0) + (when (eq (char-before) ?\n) (backward-char)))) + (unless (or (markdown-cur-line-blank-p) + (thing-at-point-looking-at markdown-regex-reference-definition)) + (insert "\n")) + (insert "\n[" label "]: ") + (if url + (insert url) + ;; When no URL is given, leave point at END following the colon + (setq end (point))) + (when (> (length title) 0) + (insert " \"" title "\"")) + (unless (looking-at-p "\n") + (insert "\n")) + (goto-char end) + (when url + (message + (markdown--substitute-command-keys + "Reference [%s] was defined, press \\[markdown-do] to jump there") + label)))) + +(defcustom markdown-link-make-text-function nil + "Function that automatically generates a link text for a URL. + +If non-nil, this function will be called by +`markdown--insert-link-or-image' and the result will be the +default link text. The function should receive exactly one +argument that corresponds to the link URL." + :group 'markdown + :type 'function + :package-version '(markdown-mode . "2.5")) + +(defcustom markdown-disable-tooltip-prompt nil + "Disable prompt for tooltip when inserting a link or image. + +If non-nil, `markdown-insert-link' and `markdown-insert-link' +will not prompt the user to insert a tooltip text for the given +link or image." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.5")) + +(defun markdown--insert-link-or-image (image) + "Interactively insert new or update an existing link or image. +When IMAGE is non-nil, insert an image. Otherwise, insert a link. +This is an internal function called by +`markdown-insert-link' and `markdown-insert-image'." + (cl-multiple-value-bind (begin end text uri ref title) + (if (use-region-p) + ;; Use region as either link text or URL as appropriate. + (let ((region (buffer-substring-no-properties + (region-beginning) (region-end)))) + (if (string-match markdown-regex-uri region) + ;; Region contains a URL; use it as such. + (list (region-beginning) (region-end) + nil (match-string 0 region) nil nil) + ;; Region doesn't contain a URL, so use it as text. + (list (region-beginning) (region-end) + region nil nil nil))) + ;; Extract and use properties of existing link, if any. + (markdown-link-at-pos (point))) + (let* ((ref (when ref (concat "[" ref "]"))) + (defined-refs (mapcar #'car (markdown-get-defined-references))) + (defined-ref-cands (mapcar (lambda (ref) (concat "[" ref "]")) defined-refs)) + (used-uris (markdown-get-used-uris)) + (uri-or-ref (completing-read + "URL or [reference]: " + (append defined-ref-cands used-uris) + nil nil (or uri ref))) + (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref) + (match-string 1 uri-or-ref)) + ((string-equal "" uri-or-ref) + ""))) + (uri (unless ref uri-or-ref)) + (text-prompt (if image + "Alt text: " + (if ref + "Link text: " + "Link text (blank for plain URL): "))) + (text (or text (and markdown-link-make-text-function uri + (funcall markdown-link-make-text-function uri)))) + (text (completing-read text-prompt defined-refs nil nil text)) + (text (if (= (length text) 0) nil text)) + (plainp (and uri (not text))) + (implicitp (string-equal ref "")) + (ref (if implicitp text ref)) + (definedp (and ref (markdown-reference-definition ref))) + (ref-url (unless (or uri definedp) + (completing-read "Reference URL: " used-uris))) + (title (unless (or plainp definedp markdown-disable-tooltip-prompt) + (read-string "Title (tooltip text, optional): " title))) + (title (if (= (length title) 0) nil title))) + (when (and image implicitp) + (user-error "Reference required: implicit image references are invalid")) + (when (and begin end) + (delete-region begin end)) + (cond + ((and (not image) uri text) + (markdown-insert-inline-link text uri title)) + ((and image uri text) + (markdown-insert-inline-image text uri title)) + ((and ref text) + (if image + (markdown-insert-reference-image text (unless implicitp ref) nil title) + (markdown-insert-reference-link text (unless implicitp ref) nil title)) + (unless definedp + (markdown-insert-reference-definition ref ref-url title))) + ((and (not image) uri) + (markdown-insert-uri uri)))))) + +(defun markdown-insert-link () + "Insert new or update an existing link, with interactive prompt. +If the point is at an existing link or URL, update the link text, +URL, reference label, and/or title. Otherwise, insert a new link. +The type of link inserted (inline, reference, or plain URL) +depends on which values are provided: + +* If a URL and TEXT are given, insert an inline link: [TEXT](URL). +* If [REF] and TEXT are given, insert a reference link: [TEXT][REF]. +* If only TEXT is given, insert an implicit reference link: [TEXT][]. +* If only a URL is given, insert a plain link: <URL>. + +In other words, to create an implicit reference link, leave the +URL prompt empty and to create a plain URL link, leave the link +text empty. + +If there is an active region, use the text as the default URL, if +it seems to be a URL, or link text value otherwise. + +If a given reference is not defined, this function will +additionally prompt for the URL and optional title. In this case, +the reference definition is placed at the location determined by +`markdown-reference-location'. In addition, it is possible to +have the `markdown-link-make-text-function' function, if non-nil, +define the default link text before prompting the user for it. + +If `markdown-disable-tooltip-prompt' is non-nil, the user will +not be prompted to add or modify a tooltip text. + +Through updating the link, this function can be used to convert a +link of one type (inline, reference, or plain) to another type by +selectively adding or removing information via the prompts." + (interactive) + (markdown--insert-link-or-image nil)) + +(defun markdown-insert-image () + "Insert new or update an existing image, with interactive prompt. +If the point is at an existing image, update the alt text, URL, +reference label, and/or title. Otherwise, insert a new image. +The type of image inserted (inline or reference) depends on which +values are provided: + +* If a URL and ALT-TEXT are given, insert an inline image: + ![ALT-TEXT](URL). +* If [REF] and ALT-TEXT are given, insert a reference image: + ![ALT-TEXT][REF]. + +If there is an active region, use the text as the default URL, if +it seems to be a URL, or alt text value otherwise. + +If a given reference is not defined, this function will +additionally prompt for the URL and optional title. In this case, +the reference definition is placed at the location determined by +`markdown-reference-location'. + +Through updating the image, this function can be used to convert an +image of one type (inline or reference) to another type by +selectively adding or removing information via the prompts." + (interactive) + (markdown--insert-link-or-image t)) + +(defun markdown-insert-uri (&optional uri) + "Insert markup for an inline URI. +If there is an active region, use it as the URI. If the point is +at a URI, wrap it with angle brackets. If the point is at an +inline URI, remove the angle brackets. Otherwise, simply insert +angle brackets place the point between them." + (interactive) + (if (use-region-p) + ;; Active region + (let ((bounds (markdown-unwrap-things-in-region + (region-beginning) (region-end) + markdown-regex-angle-uri 0 2))) + (markdown-wrap-or-insert "<" ">" nil (car bounds) (cdr bounds))) + ;; Markup removal, URI at point, new URI, or empty markup insertion + (if (thing-at-point-looking-at markdown-regex-angle-uri) + (markdown-unwrap-thing-at-point nil 0 2) + (if uri + (insert "<" uri ">") + (markdown-wrap-or-insert "<" ">" 'url nil nil))))) + +(defun markdown-insert-wiki-link () + "Insert a wiki link of the form [[WikiLink]]. +If there is an active region, use the region as the link text. +If the point is at a word, use the word as the link text. If +there is no active region and the point is not at word, simply +insert link markup." + (interactive) + (if (use-region-p) + ;; Active region + (markdown-wrap-or-insert "[[" "]]" nil (region-beginning) (region-end)) + ;; Markup removal, wiki link at at point, or empty markup insertion + (if (thing-at-point-looking-at markdown-regex-wiki-link) + (if (or markdown-wiki-link-alias-first + (null (match-string 5))) + (markdown-unwrap-thing-at-point nil 1 3) + (markdown-unwrap-thing-at-point nil 1 5)) + (markdown-wrap-or-insert "[[" "]]")))) + +(defun markdown-remove-header () + "Remove header markup if point is at a header. +Return bounds of remaining header text if a header was removed +and nil otherwise." + (interactive "*") + (or (markdown-unwrap-thing-at-point markdown-regex-header-atx 0 2) + (markdown-unwrap-thing-at-point markdown-regex-header-setext 0 1))) + +(defun markdown-insert-header (&optional level text setext) + "Insert or replace header markup. +The level of the header is specified by LEVEL and header text is +given by TEXT. LEVEL must be an integer from 1 and 6, and the +default value is 1. +When TEXT is nil, the header text is obtained as follows. +If there is an active region, it is used as the header text. +Otherwise, the current line will be used as the header text. +If there is not an active region and the point is at a header, +remove the header markup and replace with level N header. +Otherwise, insert empty header markup and place the point in +between. +The style of the header will be atx (hash marks) unless +SETEXT is non-nil, in which case a setext-style (underlined) +header will be inserted." + (interactive "p\nsHeader text: ") + (setq level (min (max (or level 1) 1) (if setext 2 6))) + ;; Determine header text if not given + (when (null text) + (if (use-region-p) + ;; Active region + (setq text (delete-and-extract-region (region-beginning) (region-end))) + ;; No active region + (markdown-remove-header) + (setq text (delete-and-extract-region + (line-beginning-position) (line-end-position))) + (when (and setext (string-match-p "^[ \t]*$" text)) + (setq text (read-string "Header text: ")))) + (setq text (markdown-compress-whitespace-string text))) + ;; Insertion with given text + (markdown-ensure-blank-line-before) + (let (hdr) + (cond (setext + (setq hdr (make-string (string-width text) (if (= level 2) ?- ?=))) + (insert text "\n" hdr)) + (t + (setq hdr (make-string level ?#)) + (insert hdr " " text) + (when (null markdown-asymmetric-header) (insert " " hdr))))) + (markdown-ensure-blank-line-after) + ;; Leave point at end of text + (cond (setext + (backward-char (1+ (string-width text)))) + ((null markdown-asymmetric-header) + (backward-char (1+ level))))) + +(defun markdown-insert-header-dwim (&optional arg setext) + "Insert or replace header markup. +The level and type of the header are determined automatically by +the type and level of the previous header, unless a prefix +argument is given via ARG. +With a numeric prefix valued 1 to 6, insert a header of the given +level, with the type being determined automatically (note that +only level 1 or 2 setext headers are possible). + +With a \\[universal-argument] prefix (i.e., when ARG is (4)), +promote the heading by one level. +With two \\[universal-argument] prefixes (i.e., when ARG is (16)), +demote the heading by one level. +When SETEXT is non-nil, prefer setext-style headers when +possible (levels one and two). + +When there is an active region, use it for the header text. When +the point is at an existing header, change the type and level +according to the rules above. +Otherwise, if the line is not empty, create a header using the +text on the current line as the header text. +Finally, if the point is on a blank line, insert empty header +markup (atx) or prompt for text (setext). +See `markdown-insert-header' for more details about how the +header text is determined." + (interactive "*P") + (let (level) + (save-excursion + (when (or (thing-at-point-looking-at markdown-regex-header) + (re-search-backward markdown-regex-header nil t)) + ;; level of current or previous header + (setq level (markdown-outline-level)) + ;; match group 1 indicates a setext header + (setq setext (match-end 1)))) + ;; check prefix argument + (cond + ((and (equal arg '(4)) level (> level 1)) ;; C-u + (cl-decf level)) + ((and (equal arg '(16)) level (< level 6)) ;; C-u C-u + (cl-incf level)) + (arg ;; numeric prefix + (setq level (prefix-numeric-value arg)))) + ;; setext headers must be level one or two + (and level (setq setext (and setext (<= level 2)))) + ;; insert the heading + (markdown-insert-header level nil setext))) + +(defun markdown-insert-header-setext-dwim (&optional arg) + "Insert or replace header markup, with preference for setext. +See `markdown-insert-header-dwim' for details, including how ARG is handled." + (interactive "*P") + (markdown-insert-header-dwim arg t)) + +(defun markdown-insert-header-atx-1 () + "Insert a first level atx-style (hash mark) header. +See `markdown-insert-header'." + (interactive "*") + (markdown-insert-header 1 nil nil)) + +(defun markdown-insert-header-atx-2 () + "Insert a level two atx-style (hash mark) header. +See `markdown-insert-header'." + (interactive "*") + (markdown-insert-header 2 nil nil)) + +(defun markdown-insert-header-atx-3 () + "Insert a level three atx-style (hash mark) header. +See `markdown-insert-header'." + (interactive "*") + (markdown-insert-header 3 nil nil)) + +(defun markdown-insert-header-atx-4 () + "Insert a level four atx-style (hash mark) header. +See `markdown-insert-header'." + (interactive "*") + (markdown-insert-header 4 nil nil)) + +(defun markdown-insert-header-atx-5 () + "Insert a level five atx-style (hash mark) header. +See `markdown-insert-header'." + (interactive "*") + (markdown-insert-header 5 nil nil)) + +(defun markdown-insert-header-atx-6 () + "Insert a sixth level atx-style (hash mark) header. +See `markdown-insert-header'." + (interactive "*") + (markdown-insert-header 6 nil nil)) + +(defun markdown-insert-header-setext-1 () + "Insert a setext-style (underlined) first-level header. +See `markdown-insert-header'." + (interactive "*") + (markdown-insert-header 1 nil t)) + +(defun markdown-insert-header-setext-2 () + "Insert a setext-style (underlined) second-level header. +See `markdown-insert-header'." + (interactive "*") + (markdown-insert-header 2 nil t)) + +(defun markdown-blockquote-indentation (loc) + "Return string containing necessary indentation for a blockquote at LOC. +Also see `markdown-pre-indentation'." + (save-excursion + (goto-char loc) + (let* ((list-level (length (markdown-calculate-list-levels))) + (indent "")) + (dotimes (_ list-level indent) + (setq indent (concat indent " ")))))) + +(defun markdown-insert-blockquote () + "Start a blockquote section (or blockquote the region). +If Transient Mark mode is on and a region is active, it is used as +the blockquote text." + (interactive) + (if (use-region-p) + (markdown-blockquote-region (region-beginning) (region-end)) + (markdown-ensure-blank-line-before) + (insert (markdown-blockquote-indentation (point)) "> ") + (markdown-ensure-blank-line-after))) + +(defun markdown-block-region (beg end prefix) + "Format the region using a block prefix. +Arguments BEG and END specify the beginning and end of the +region. The characters PREFIX will appear at the beginning +of each line." + (save-excursion + (let* ((end-marker (make-marker)) + (beg-marker (make-marker)) + (prefix-without-trailing-whitespace + (replace-regexp-in-string (rx (+ blank) eos) "" prefix))) + ;; Ensure blank line after and remove extra whitespace + (goto-char end) + (skip-syntax-backward "-") + (set-marker end-marker (point)) + (delete-horizontal-space) + (markdown-ensure-blank-line-after) + ;; Ensure blank line before and remove extra whitespace + (goto-char beg) + (skip-syntax-forward "-") + (delete-horizontal-space) + (markdown-ensure-blank-line-before) + (set-marker beg-marker (point)) + ;; Insert PREFIX before each line + (goto-char beg-marker) + (while (and (< (line-beginning-position) end-marker) + (not (eobp))) + ;; Don’t insert trailing whitespace. + (insert (if (eolp) prefix-without-trailing-whitespace prefix)) + (forward-line))))) + +(defun markdown-blockquote-region (beg end) + "Blockquote the region. +Arguments BEG and END specify the beginning and end of the region." + (interactive "*r") + (markdown-block-region + beg end (concat (markdown-blockquote-indentation + (max (point-min) (1- beg))) "> "))) + +(defun markdown-pre-indentation (loc) + "Return string containing necessary whitespace for a pre block at LOC. +Also see `markdown-blockquote-indentation'." + (save-excursion + (goto-char loc) + (let* ((list-level (length (markdown-calculate-list-levels))) + indent) + (dotimes (_ (1+ list-level) indent) + (setq indent (concat indent " ")))))) + +(defun markdown-insert-pre () + "Start a preformatted section (or apply to the region). +If Transient Mark mode is on and a region is active, it is marked +as preformatted text." + (interactive) + (if (use-region-p) + (markdown-pre-region (region-beginning) (region-end)) + (markdown-ensure-blank-line-before) + (insert (markdown-pre-indentation (point))) + (markdown-ensure-blank-line-after))) + +(defun markdown-pre-region (beg end) + "Format the region as preformatted text. +Arguments BEG and END specify the beginning and end of the region." + (interactive "*r") + (let ((indent (markdown-pre-indentation (max (point-min) (1- beg))))) + (markdown-block-region beg end indent))) + +(defun markdown-electric-backquote (arg) + "Insert a backquote. +The numeric prefix argument ARG says how many times to repeat the insertion. +Call `markdown-insert-gfm-code-block' interactively +if three backquotes inserted at the beginning of line." + (interactive "*P") + (self-insert-command (prefix-numeric-value arg)) + (when (and markdown-gfm-use-electric-backquote (looking-back "^```" nil)) + (replace-match "") + (call-interactively #'markdown-insert-gfm-code-block))) + +(defconst markdown-gfm-recognized-languages + ;; To reproduce/update, evaluate the let-form in + ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp, + ;; but with appropriate use of a keyboard macro, indenting and filling it + ;; properly is pretty fast. + '("1C-Enterprise" "2-Dimensional-Array" "4D" "ABAP" "ABAP-CDS" "ABNF" + "AGS-Script" "AIDL" "AL" "AMPL" "ANTLR" "API-Blueprint" "APL" "ASL" + "ASN.1" "ASP.NET" "ATS" "ActionScript" "Ada" "Adblock-Filter-List" + "Adobe-Font-Metrics" "Agda" "Alloy" "Alpine-Abuild" "Altium-Designer" + "AngelScript" "Ant-Build-System" "Antlers" "ApacheConf" "Apex" + "Apollo-Guidance-Computer" "AppleScript" "Arc" "AsciiDoc" "AspectJ" + "Assembly" "Astro" "Asymptote" "Augeas" "AutoHotkey" "AutoIt" + "Avro-IDL" "Awk" "BASIC" "Ballerina" "Batchfile" "Beef" "Befunge" + "Berry" "BibTeX" "Bicep" "Bikeshed" "Bison" "BitBake" "Blade" + "BlitzBasic" "BlitzMax" "Bluespec" "Bluespec-BH" "Boo" "Boogie" + "Brainfuck" "BrighterScript" "Brightscript" "Browserslist" "C" "C#" + "C++" "C-ObjDump" "C2hs-Haskell" "CAP-CDS" "CIL" "CLIPS" "CMake" + "COBOL" "CODEOWNERS" "COLLADA" "CSON" "CSS" "CSV" "CUE" "CWeb" + "Cabal-Config" "Cadence" "Cairo" "CameLIGO" "Cap'n-Proto" "CartoCSS" + "Ceylon" "Chapel" "Charity" "Checksums" "ChucK" "Circom" "Cirru" + "Clarion" "Clarity" "Classic-ASP" "Clean" "Click" "Clojure" + "Closure-Templates" "Cloud-Firestore-Security-Rules" "CoNLL-U" + "CodeQL" "CoffeeScript" "ColdFusion" "ColdFusion-CFC" "Common-Lisp" + "Common-Workflow-Language" "Component-Pascal" "Cool" "Coq" + "Cpp-ObjDump" "Creole" "Crystal" "Csound" "Csound-Document" + "Csound-Score" "Cuda" "Cue-Sheet" "Curry" "Cycript" "Cypher" "Cython" + "D" "D-ObjDump" "D2" "DIGITAL-Command-Language" "DM" "DNS-Zone" + "DTrace" "Dafny" "Darcs-Patch" "Dart" "DataWeave" + "Debian-Package-Control-File" "DenizenScript" "Dhall" "Diff" + "DirectX-3D-File" "Dockerfile" "Dogescript" "Dotenv" "Dylan" "E" + "E-mail" "EBNF" "ECL" "ECLiPSe" "EJS" "EQ" "Eagle" "Earthly" + "Easybuild" "Ecere-Projects" "Ecmarkup" "Edge" "EdgeQL" + "EditorConfig" "Edje-Data-Collection" "Eiffel" "Elixir" "Elm" + "Elvish" "Elvish-Transcript" "Emacs-Lisp" "EmberScript" "Erlang" + "Euphoria" "F#" "F*" "FIGlet-Font" "FLUX" "Factor" "Fancy" "Fantom" + "Faust" "Fennel" "Filebench-WML" "Filterscript" "Fluent" "Formatted" + "Forth" "Fortran" "Fortran-Free-Form" "FreeBasic" "FreeMarker" + "Frege" "Futhark" "G-code" "GAML" "GAMS" "GAP" + "GCC-Machine-Description" "GDB" "GDScript" "GEDCOM" "GLSL" "GN" "GSC" + "Game-Maker-Language" "Gemfile.lock" "Gemini" "Genero-4gl" + "Genero-per" "Genie" "Genshi" "Gentoo-Ebuild" "Gentoo-Eclass" + "Gerber-Image" "Gettext-Catalog" "Gherkin" "Git-Attributes" + "Git-Config" "Git-Revision-List" "Gleam" "Glimmer-JS" "Glimmer-TS" + "Glyph" "Glyph-Bitmap-Distribution-Format" "Gnuplot" "Go" + "Go-Checksums" "Go-Module" "Go-Workspace" "Godot-Resource" "Golo" + "Gosu" "Grace" "Gradle" "Gradle-Kotlin-DSL" "Grammatical-Framework" + "Graph-Modeling-Language" "GraphQL" "Graphviz-(DOT)" "Groovy" + "Groovy-Server-Pages" "HAProxy" "HCL" "HLSL" "HOCON" "HTML" + "HTML+ECR" "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTML+Razor" "HTTP" + "HXML" "Hack" "Haml" "Handlebars" "Harbour" "Haskell" "Haxe" "HiveQL" + "HolyC" "Hosts-File" "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI" "IRC-log" + "Idris" "Ignore-List" "ImageJ-Macro" "Imba" "Inform-7" "Ink" + "Inno-Setup" "Io" "Ioke" "Isabelle" "Isabelle-ROOT" "J" + "JAR-Manifest" "JCL" "JFlex" "JSON" "JSON-with-Comments" "JSON5" + "JSONLD" "JSONiq" "Janet" "Jasmin" "Java" "Java-Properties" + "Java-Server-Pages" "JavaScript" "JavaScript+ERB" "Jest-Snapshot" + "JetBrains-MPS" "Jinja" "Jison" "Jison-Lex" "Jolie" "Jsonnet" "Julia" + "Jupyter-Notebook" "Just" "KRL" "Kaitai-Struct" "KakouneScript" + "KerboScript" "KiCad-Layout" "KiCad-Legacy-Layout" "KiCad-Schematic" + "Kickstart" "Kit" "Kotlin" "Kusto" "LFE" "LLVM" "LOLCODE" "LSL" + "LTspice-Symbol" "LabVIEW" "Lark" "Lasso" "Latte" "Lean" "Lean-4" + "Less" "Lex" "LigoLANG" "LilyPond" "Limbo" "Linker-Script" + "Linux-Kernel-Module" "Liquid" "Literate-Agda" + "Literate-CoffeeScript" "Literate-Haskell" "LiveScript" "Logos" + "Logtalk" "LookML" "LoomScript" "Lua" "M" "M4" "M4Sugar" "MATLAB" + "MAXScript" "MDX" "MLIR" "MQL4" "MQL5" "MTML" "MUF" "Macaulay2" + "Makefile" "Mako" "Markdown" "Marko" "Mask" "Mathematica" "Maven-POM" + "Max" "Mercury" "Mermaid" "Meson" "Metal" + "Microsoft-Developer-Studio-Project" + "Microsoft-Visual-Studio-Solution" "MiniD" "MiniYAML" "Mint" "Mirah" + "Modelica" "Modula-2" "Modula-3" "Module-Management-System" "Mojo" + "Monkey" "Monkey-C" "Moocode" "MoonScript" "Motoko" + "Motorola-68K-Assembly" "Move" "Muse" "Mustache" "Myghty" "NASL" + "NCL" "NEON" "NL" "NPM-Config" "NSIS" "NWScript" "Nasal" "Nearley" + "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo" "NewLisp" "Nextflow" + "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "Nunjucks" "Nushell" + "OASv2-json" "OASv2-yaml" "OASv3-json" "OASv3-yaml" "OCaml" "Oberon" + "ObjDump" "Object-Data-Instance-Notation" "ObjectScript" + "Objective-C" "Objective-C++" "Objective-J" "Odin" "Omgrofl" "Opa" + "Opal" "Open-Policy-Agent" "OpenAPI-Specification-v2" + "OpenAPI-Specification-v3" "OpenCL" "OpenEdge-ABL" "OpenQASM" + "OpenRC-runscript" "OpenSCAD" "OpenStep-Property-List" + "OpenType-Feature-File" "Option-List" "Org" "Ox" "Oxygene" "Oz" "P4" + "PDDL" "PEG.js" "PHP" "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pact" "Pan" + "Papyrus" "Parrot" "Parrot-Assembly" "Parrot-Internal-Representation" + "Pascal" "Pawn" "Pep8" "Perl" "Pic" "Pickle" "PicoLisp" "PigLatin" + "Pike" "Pip-Requirements" "PlantUML" "Pod" "Pod-6" "PogoScript" + "Polar" "Pony" "Portugol" "PostCSS" "PostScript" "PowerBuilder" + "PowerShell" "Praat" "Prisma" "Processing" "Procfile" "Proguard" + "Prolog" "Promela" "Propeller-Spin" "Protocol-Buffer" + "Protocol-Buffer-Text-Format" "Public-Key" "Pug" "Puppet" "Pure-Data" + "PureBasic" "PureScript" "Pyret" "Python" "Python-console" + "Python-traceback" "Q#" "QML" "QMake" "Qt-Script" "Quake" "R" "RAML" + "RBS" "RDoc" "REALbasic" "REXX" "RMarkdown" "RPC" "RPGLE" "RPM-Spec" + "RUNOFF" "Racket" "Ragel" "Raku" "Rascal" "Raw-token-data" "ReScript" + "Readline-Config" "Reason" "ReasonLIGO" "Rebol" "Record-Jar" "Red" + "Redcode" "Redirect-Rules" "Regular-Expression" "Ren'Py" + "RenderScript" "Rez" "Rich-Text-Format" "Ring" "Riot" + "RobotFramework" "Roc" "Roff" "Roff-Manpage" "Rouge" + "RouterOS-Script" "Ruby" "Rust" "SAS" "SCSS" "SELinux-Policy" "SMT" + "SPARQL" "SQF" "SQL" "SQLPL" "SRecode-Template" "SSH-Config" "STAR" + "STL" "STON" "SVG" "SWIG" "Sage" "SaltStack" "Sass" "Scala" "Scaml" + "Scenic" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" + "ShellCheck-Config" "ShellSession" "Shen" "Sieve" + "Simple-File-Verification" "Singularity" "Slash" "Slice" "Slim" + "Slint" "SmPL" "Smali" "Smalltalk" "Smarty" "Smithy" "Snakemake" + "Solidity" "Soong" "SourcePawn" "Spline-Font-Database" "Squirrel" + "Stan" "Standard-ML" "Starlark" "Stata" "StringTemplate" "Stylus" + "SubRip-Text" "SugarSS" "SuperCollider" "Svelte" "Sway" "Sweave" + "Swift" "SystemVerilog" "TI-Program" "TL-Verilog" "TLA" "TOML" "TSQL" + "TSV" "TSX" "TXL" "Talon" "Tcl" "Tcsh" "TeX" "Tea" "Terra" + "Terraform-Template" "Texinfo" "Text" "TextGrid" + "TextMate-Properties" "Textile" "Thrift" "Toit" "Turing" "Turtle" + "Twig" "Type-Language" "TypeScript" "Typst" "Unified-Parallel-C" + "Unity3D-Asset" "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "V" + "VBA" "VBScript" "VCL" "VHDL" "Vala" "Valve-Data-Format" + "Velocity-Template-Language" "Verilog" "Vim-Help-File" "Vim-Script" + "Vim-Snippet" "Visual-Basic-.NET" "Visual-Basic-6.0" "Volt" "Vue" + "Vyper" "WDL" "WGSL" "Wavefront-Material" "Wavefront-Object" + "Web-Ontology-Language" "WebAssembly" "WebAssembly-Interface-Type" + "WebIDL" "WebVTT" "Wget-Config" "Whiley" "Wikitext" + "Win32-Message-File" "Windows-Registry-Entries" "Witcher-Script" + "Wollok" "World-of-Warcraft-Addon-Data" "Wren" "X-BitMap" + "X-Font-Directory-Index" "X-PixMap" "X10" "XC" "XCompose" "XML" + "XML-Property-List" "XPages" "XProc" "XQuery" "XS" "XSLT" "Xojo" + "Xonsh" "Xtend" "YAML" "YANG" "YARA" "YASnippet" "Yacc" "Yul" "ZAP" + "ZIL" "Zeek" "ZenScript" "Zephir" "Zig" "Zimpl" "cURL-Config" + "desktop" "dircolors" "eC" "edn" "fish" "hoon" "jq" "kvlang" + "mIRC-Script" "mcfunction" "mupad" "nanorc" "nesC" "ooc" "q" + "reStructuredText" "robots.txt" "sed" "wisp" "xBase") + "Language specifiers recognized by GitHub's syntax highlighting features.") + +(defvar-local markdown-gfm-used-languages nil + "Language names used in GFM code blocks.") + +(defun markdown-trim-whitespace (str) + (replace-regexp-in-string + "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str)) + +(defun markdown-clean-language-string (str) + (replace-regexp-in-string + "{\\.?\\|}" "" (markdown-trim-whitespace str))) + +(defun markdown-validate-language-string (widget) + (let ((str (widget-value widget))) + (unless (string= str (markdown-clean-language-string str)) + (widget-put widget :error (format "Invalid language spec: '%s'" str)) + widget))) + +(defun markdown-gfm-get-corpus () + "Create corpus of recognized GFM code block languages for the given buffer." + (let ((given-corpus (append markdown-gfm-additional-languages + markdown-gfm-recognized-languages))) + (append + markdown-gfm-used-languages + (if markdown-gfm-downcase-languages (cl-mapcar #'downcase given-corpus) + given-corpus)))) + +(defun markdown-gfm-add-used-language (lang) + "Clean LANG and add to list of used languages." + (setq markdown-gfm-used-languages + (cons lang (remove lang markdown-gfm-used-languages)))) + +(defcustom markdown-spaces-after-code-fence 1 + "Number of space characters to insert after a code fence. +\\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an +opening code fence and an info string." + :group 'markdown + :type 'integer + :safe #'natnump + :package-version '(markdown-mode . "2.3")) + +(defcustom markdown-code-block-braces nil + "When non-nil, automatically insert braces for GFM code blocks." + :group 'markdown + :type 'boolean) + +(defun markdown-insert-gfm-code-block (&optional lang edit) + "Insert GFM code block for language LANG. +If LANG is nil, the language will be queried from user. If a +region is active, wrap this region with the markup instead. If +the region boundaries are not on empty lines, these are added +automatically in order to have the correct markup. When EDIT is +non-nil (e.g., when \\[universal-argument] is given), edit the +code block in an indirect buffer after insertion." + (interactive + (list (let ((completion-ignore-case nil)) + (condition-case nil + (markdown-clean-language-string + (completing-read + "Programming language: " + (markdown-gfm-get-corpus) + nil 'confirm (car markdown-gfm-used-languages) + 'markdown-gfm-language-history)) + (quit ""))) + current-prefix-arg)) + (unless (string= lang "") (markdown-gfm-add-used-language lang)) + (when (and (> (length lang) 0) + (not markdown-code-block-braces)) + (setq lang (concat (make-string markdown-spaces-after-code-fence ?\s) + lang))) + (let ((gfm-open-brace (if markdown-code-block-braces "{" "")) + (gfm-close-brace (if markdown-code-block-braces "}" ""))) + (if (use-region-p) + (let* ((b (region-beginning)) (e (region-end)) end + (indent (progn (goto-char b) (current-indentation)))) + (goto-char e) + ;; if we're on a blank line, don't newline, otherwise the ``` + ;; should go on its own line + (unless (looking-back "\n" nil) + (newline)) + (indent-to indent) + (insert "```") + (markdown-ensure-blank-line-after) + (setq end (point)) + (goto-char b) + ;; if we're on a blank line, insert the quotes here, otherwise + ;; add a new line first + (unless (looking-at-p "\n") + (newline) + (forward-line -1)) + (markdown-ensure-blank-line-before) + (indent-to indent) + (insert "```" gfm-open-brace lang gfm-close-brace) + (markdown-syntax-propertize-fenced-block-constructs (line-beginning-position) end)) + (let ((indent (current-indentation)) + start-bol) + (delete-horizontal-space :backward-only) + (markdown-ensure-blank-line-before) + (indent-to indent) + (setq start-bol (line-beginning-position)) + (insert "```" gfm-open-brace lang gfm-close-brace "\n") + (indent-to indent) + (unless edit (insert ?\n)) + (indent-to indent) + (insert "```") + (markdown-ensure-blank-line-after) + (markdown-syntax-propertize-fenced-block-constructs start-bol (point))) + (end-of-line 0) + (when edit (markdown-edit-code-block))))) + +(defun markdown-code-block-lang (&optional pos-prop) + "Return the language name for a GFM or tilde fenced code block. +The beginning of the block may be described by POS-PROP, +a cons of (pos . prop) giving the position and property +at the beginning of the block." + (or pos-prop + (setq pos-prop + (markdown-max-of-seq + #'car + (cl-remove-if + #'null + (cl-mapcar + #'markdown-find-previous-prop + (markdown-get-fenced-block-begin-properties)))))) + (when pos-prop + (goto-char (car pos-prop)) + (set-match-data (get-text-property (point) (cdr pos-prop))) + ;; Note: Hard-coded group number assumes tilde + ;; and GFM fenced code regexp groups agree. + (let ((begin (match-beginning 3)) + (end (match-end 3))) + (when (and begin end) + ;; Fix language strings beginning with periods, like ".ruby". + (when (eq (char-after begin) ?.) + (setq begin (1+ begin))) + (buffer-substring-no-properties begin end))))) + +(defun markdown-gfm-parse-buffer-for-languages (&optional buffer) + (with-current-buffer (or buffer (current-buffer)) + (save-excursion + (goto-char (point-min)) + (cl-loop + with prop = 'markdown-gfm-block-begin + for pos-prop = (markdown-find-next-prop prop) + while pos-prop + for lang = (markdown-code-block-lang pos-prop) + do (progn (when lang (markdown-gfm-add-used-language lang)) + (goto-char (next-single-property-change (point) prop))))))) + +(defun markdown-insert-foldable-block () + "Insert details disclosure element to make content foldable. +If a region is active, wrap this region with the disclosure +element. More details here https://developer.mozilla.org/en-US/docs/Web/HTML/Element/details." + (interactive) + (let ((details-open-tag "<details>") + (details-close-tag "</details>") + (summary-open-tag "<summary>") + (summary-close-tag " </summary>")) + (if (use-region-p) + (let* ((b (region-beginning)) + (e (region-end)) + (indent (progn (goto-char b) (current-indentation)))) + (goto-char e) + ;; if we're on a blank line, don't newline, otherwise the tags + ;; should go on its own line + (unless (looking-back "\n" nil) + (newline)) + (indent-to indent) + (insert details-close-tag) + (markdown-ensure-blank-line-after) + (goto-char b) + ;; if we're on a blank line, insert the quotes here, otherwise + ;; add a new line first + (unless (looking-at-p "\n") + (newline) + (forward-line -1)) + (markdown-ensure-blank-line-before) + (indent-to indent) + (insert details-open-tag "\n") + (insert summary-open-tag summary-close-tag) + (search-backward summary-close-tag)) + (let ((indent (current-indentation))) + (delete-horizontal-space :backward-only) + (markdown-ensure-blank-line-before) + (indent-to indent) + (insert details-open-tag "\n") + (insert summary-open-tag summary-close-tag "\n") + (insert details-close-tag) + (indent-to indent) + (markdown-ensure-blank-line-after) + (search-backward summary-close-tag))))) + + +;;; Footnotes ================================================================= + +(defun markdown-footnote-counter-inc () + "Increment `markdown-footnote-counter' and return the new value." + (when (= markdown-footnote-counter 0) ; hasn't been updated in this buffer yet. + (save-excursion + (goto-char (point-min)) + (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars "*?\\)\\]:") + (point-max) t) + (let ((fn (string-to-number (match-string 1)))) + (when (> fn markdown-footnote-counter) + (setq markdown-footnote-counter fn)))))) + (cl-incf markdown-footnote-counter)) + +(defun markdown-insert-footnote () + "Insert footnote with a new number and move point to footnote definition." + (interactive) + (let ((fn (markdown-footnote-counter-inc))) + (insert (format "[^%d]" fn)) + (push-mark (point) t) + (markdown-footnote-text-find-new-location) + (markdown-ensure-blank-line-before) + (unless (markdown-cur-line-blank-p) + (insert "\n")) + (insert (format "[^%d]: " fn)) + (markdown-ensure-blank-line-after))) + +(defun markdown-footnote-text-find-new-location () + "Position the point at the proper location for a new footnote text." + (cond + ((eq markdown-footnote-location 'end) (goto-char (point-max))) + ((eq markdown-footnote-location 'immediately) (markdown-end-of-text-block)) + ((eq markdown-footnote-location 'subtree) (markdown-end-of-subtree)) + ((eq markdown-footnote-location 'header) (markdown-end-of-defun)))) + +(defun markdown-footnote-kill () + "Kill the footnote at point. +The footnote text is killed (and added to the kill ring), the +footnote marker is deleted. Point has to be either at the +footnote marker or in the footnote text." + (interactive) + (let ((marker-pos nil) + (skip-deleting-marker nil) + (starting-footnote-text-positions + (markdown-footnote-text-positions))) + (when starting-footnote-text-positions + ;; We're starting in footnote text, so mark our return position and jump + ;; to the marker if possible. + (let ((marker-pos (markdown-footnote-find-marker + (cl-first starting-footnote-text-positions)))) + (if marker-pos + (goto-char (1- marker-pos)) + ;; If there isn't a marker, we still want to kill the text. + (setq skip-deleting-marker t)))) + ;; Either we didn't start in the text, or we started in the text and jumped + ;; to the marker. We want to assume we're at the marker now and error if + ;; we're not. + (unless skip-deleting-marker + (let ((marker (markdown-footnote-delete-marker))) + (unless marker + (error "Not at a footnote")) + ;; Even if we knew the text position before, it changed when we deleted + ;; the label. + (setq marker-pos (cl-second marker)) + (let ((new-text-pos (markdown-footnote-find-text (cl-first marker)))) + (unless new-text-pos + (error "No text for footnote `%s'" (cl-first marker))) + (goto-char new-text-pos)))) + (let ((pos (markdown-footnote-kill-text))) + (goto-char (if starting-footnote-text-positions + pos + marker-pos))))) + +(defun markdown-footnote-delete-marker () + "Delete a footnote marker at point. +Returns a list (ID START) containing the footnote ID and the +start position of the marker before deletion. If no footnote +marker was deleted, this function returns NIL." + (let ((marker (markdown-footnote-marker-positions))) + (when marker + (delete-region (cl-second marker) (cl-third marker)) + (butlast marker)))) + +(defun markdown-footnote-kill-text () + "Kill footnote text at point. +Returns the start position of the footnote text before deletion, +or NIL if point was not inside a footnote text. + +The killed text is placed in the kill ring (without the footnote +number)." + (let ((fn (markdown-footnote-text-positions))) + (when fn + (let ((text (delete-and-extract-region (cl-second fn) (cl-third fn)))) + (string-match (concat "\\[\\" (cl-first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text) + (kill-new (match-string 1 text)) + (when (and (markdown-cur-line-blank-p) + (markdown-prev-line-blank-p) + (not (bobp))) + (delete-region (1- (point)) (point))) + (cl-second fn))))) + +(defun markdown-footnote-goto-text () + "Jump to the text of the footnote at point." + (interactive) + (let ((fn (car (markdown-footnote-marker-positions)))) + (unless fn + (user-error "Not at a footnote marker")) + (let ((new-pos (markdown-footnote-find-text fn))) + (unless new-pos + (error "No definition found for footnote `%s'" fn)) + (goto-char new-pos)))) + +(defun markdown-footnote-return () + "Return from a footnote to its footnote number in the main text." + (interactive) + (let ((fn (save-excursion + (car (markdown-footnote-text-positions))))) + (unless fn + (user-error "Not in a footnote")) + (let ((new-pos (markdown-footnote-find-marker fn))) + (unless new-pos + (error "Footnote marker `%s' not found" fn)) + (goto-char new-pos)))) + +(defun markdown-footnote-find-marker (id) + "Find the location of the footnote marker with ID. +The actual buffer position returned is the position directly +following the marker's closing bracket. If no marker is found, +NIL is returned." + (save-excursion + (goto-char (point-min)) + (when (re-search-forward (concat "\\[" id "\\]\\([^:]\\|\\'\\)") nil t) + (skip-chars-backward "^]") + (point)))) + +(defun markdown-footnote-find-text (id) + "Find the location of the text of footnote ID. +The actual buffer position returned is the position of the first +character of the text, after the footnote's identifier. If no +footnote text is found, NIL is returned." + (save-excursion + (goto-char (point-min)) + (when (re-search-forward (concat "^ \\{0,3\\}\\[" id "\\]:") nil t) + (skip-chars-forward " \t") + (point)))) + +(defun markdown-footnote-marker-positions () + "Return the position and ID of the footnote marker point is on. +The return value is a list (ID START END). If point is not on a +footnote, NIL is returned." + ;; first make sure we're at a footnote marker + (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars "*\\]?") (line-beginning-position)) + (looking-at-p (concat "\\[?\\^" markdown-footnote-chars "*?\\]"))) + (save-excursion + ;; move point between [ and ^: + (if (looking-at-p "\\[") + (forward-char 1) + (skip-chars-backward "^[")) + (looking-at (concat "\\(\\^" markdown-footnote-chars "*?\\)\\]")) + (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1)))))) + +(defun markdown-footnote-text-positions () + "Return the start and end positions of the footnote text point is in. +The exact return value is a list of three elements: (ID START END). +The start position is the position of the opening bracket +of the footnote id. The end position is directly after the +newline that ends the footnote. If point is not in a footnote, +NIL is returned instead." + (save-excursion + (let (result) + (move-beginning-of-line 1) + ;; Try to find the label. If we haven't found the label and we're at a blank + ;; or indented line, back up if possible. + (while (and + (not (and (looking-at markdown-regex-footnote-definition) + (setq result (list (match-string 1) (point))))) + (and (not (bobp)) + (or (markdown-cur-line-blank-p) + (>= (current-indentation) 4)))) + (forward-line -1)) + (when result + ;; Advance if there is a next line that is either blank or indented. + ;; (Need to check if we're on the last line, because + ;; markdown-next-line-blank-p returns true for last line in buffer.) + (while (and (/= (line-end-position) (point-max)) + (or (markdown-next-line-blank-p) + (>= (markdown-next-line-indent) 4))) + (forward-line)) + ;; Move back while the current line is blank. + (while (markdown-cur-line-blank-p) + (forward-line -1)) + ;; Advance to capture this line and a single trailing newline (if there + ;; is one). + (forward-line) + (append result (list (point))))))) + +(defun markdown-get-defined-footnotes () + "Return a list of all defined footnotes. +Result is an alist of pairs (MARKER . LINE), where MARKER is the +footnote marker, a string, and LINE is the line number containing +the footnote definition. + +For example, suppose the following footnotes are defined at positions +448 and 475: + +\[^1]: First footnote here. +\[^marker]: Second footnote. + +Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))" + (save-excursion + (goto-char (point-min)) + (let (footnotes) + (while (markdown-search-until-condition + (lambda () (and (not (markdown-code-block-at-point-p)) + (not (markdown-inline-code-at-point-p)) + (not (markdown-in-comment-p)))) + markdown-regex-footnote-definition nil t) + (let ((marker (match-string-no-properties 1)) + (pos (match-beginning 0))) + (unless (zerop (length marker)) + (cl-pushnew (cons marker pos) footnotes :test #'equal)))) + (reverse footnotes)))) + + +;;; Element Removal =========================================================== + +(defun markdown-kill-thing-at-point () + "Kill thing at point and add important text, without markup, to kill ring. +Possible things to kill include (roughly in order of precedence): +inline code, headers, horizontal rules, links (add link text to +kill ring), images (add alt text to kill ring), angle uri, email +addresses, bold, italics, reference definition (add URI to kill +ring), footnote markers and text (kill both marker and text, add +text to kill ring), and list items." + (interactive "*") + (let (val) + (cond + ;; Inline code + ((markdown-inline-code-at-point) + (kill-new (match-string 2)) + (delete-region (match-beginning 0) (match-end 0))) + ;; ATX header + ((thing-at-point-looking-at markdown-regex-header-atx) + (kill-new (match-string 2)) + (delete-region (match-beginning 0) (match-end 0))) + ;; Setext header + ((thing-at-point-looking-at markdown-regex-header-setext) + (kill-new (match-string 1)) + (delete-region (match-beginning 0) (match-end 0))) + ;; Horizontal rule + ((thing-at-point-looking-at markdown-regex-hr) + (kill-new (match-string 0)) + (delete-region (match-beginning 0) (match-end 0))) + ;; Inline link or image (add link or alt text to kill ring) + ((thing-at-point-looking-at markdown-regex-link-inline) + (kill-new (match-string 3)) + (delete-region (match-beginning 0) (match-end 0))) + ;; Reference link or image (add link or alt text to kill ring) + ((thing-at-point-looking-at markdown-regex-link-reference) + (kill-new (match-string 3)) + (delete-region (match-beginning 0) (match-end 0))) + ;; Angle URI (add URL to kill ring) + ((thing-at-point-looking-at markdown-regex-angle-uri) + (kill-new (match-string 2)) + (delete-region (match-beginning 0) (match-end 0))) + ;; Email address in angle brackets (add email address to kill ring) + ((thing-at-point-looking-at markdown-regex-email) + (kill-new (match-string 1)) + (delete-region (match-beginning 0) (match-end 0))) + ;; Wiki link (add alias text to kill ring) + ((and markdown-enable-wiki-links + (thing-at-point-looking-at markdown-regex-wiki-link)) + (kill-new (markdown-wiki-link-alias)) + (delete-region (match-beginning 1) (match-end 1))) + ;; Bold + ((thing-at-point-looking-at markdown-regex-bold) + (kill-new (match-string 4)) + (delete-region (match-beginning 2) (match-end 2))) + ;; Italics + ((thing-at-point-looking-at markdown-regex-italic) + (kill-new (match-string 3)) + (delete-region (match-beginning 1) (match-end 1))) + ;; Strikethrough + ((thing-at-point-looking-at markdown-regex-strike-through) + (kill-new (match-string 4)) + (delete-region (match-beginning 2) (match-end 2))) + ;; Footnote marker (add footnote text to kill ring) + ((thing-at-point-looking-at markdown-regex-footnote) + (markdown-footnote-kill)) + ;; Footnote text (add footnote text to kill ring) + ((setq val (markdown-footnote-text-positions)) + (markdown-footnote-kill)) + ;; Reference definition (add URL to kill ring) + ((thing-at-point-looking-at markdown-regex-reference-definition) + (kill-new (match-string 5)) + (delete-region (match-beginning 0) (match-end 0))) + ;; List item + ((setq val (markdown-cur-list-item-bounds)) + (kill-new (delete-and-extract-region (cl-first val) (cl-second val)))) + (t + (user-error "Nothing found at point to kill"))))) + +(defun markdown-kill-outline () + "Kill visible heading and add it to `kill-ring'." + (interactive) + (save-excursion + (markdown-outline-previous) + (kill-region (point) (progn (markdown-outline-next) (point))))) + +(defun markdown-kill-block () + "Kill visible code block, list item, or blockquote and add it to `kill-ring'." + (interactive) + (save-excursion + (markdown-backward-block) + (kill-region (point) (progn (markdown-forward-block) (point))))) + + +;;; Indentation =============================================================== + +(defun markdown-indent-find-next-position (cur-pos positions) + "Return the position after the index of CUR-POS in POSITIONS. +Positions are calculated by `markdown-calc-indents'." + (while (and positions + (not (equal cur-pos (car positions)))) + (setq positions (cdr positions))) + (or (cadr positions) 0)) + +(defun markdown-outdent-find-next-position (cur-pos positions) + "Return the maximal element that precedes CUR-POS from POSITIONS. +Positions are calculated by `markdown-calc-indents'." + (let ((result 0)) + (dolist (i positions) + (when (< i cur-pos) + (setq result (max result i)))) + result)) + +(defun markdown-indent-line () + "Indent the current line using some heuristics. +If the _previous_ command was either `markdown-enter-key' or +`markdown-cycle', then we should cycle to the next +reasonable indentation position. Otherwise, we could have been +called directly by `markdown-enter-key', by an initial call of +`markdown-cycle', or indirectly by `auto-fill-mode'. In +these cases, indent to the default position. +Positions are calculated by `markdown-calc-indents'." + (interactive) + (let ((positions (markdown-calc-indents)) + (point-pos (current-column)) + (_ (back-to-indentation)) + (cur-pos (current-column))) + (if (not (equal this-command 'markdown-cycle)) + (indent-line-to (car positions)) + (setq positions (sort (delete-dups positions) '<)) + (let* ((next-pos (markdown-indent-find-next-position cur-pos positions)) + (new-point-pos (max (+ point-pos (- next-pos cur-pos)) 0))) + (indent-line-to next-pos) + (move-to-column new-point-pos))))) + +(defun markdown-calc-indents () + "Return a list of indentation columns to cycle through. +The first element in the returned list should be considered the +default indentation level. This function does not worry about +duplicate positions, which are handled up by calling functions." + (let (pos prev-line-pos positions) + + ;; Indentation of previous line + (setq prev-line-pos (markdown-prev-line-indent)) + (setq positions (cons prev-line-pos positions)) + + ;; Indentation of previous non-list-marker text + (when (setq pos (save-excursion + (forward-line -1) + (when (looking-at markdown-regex-list) + (- (match-end 3) (match-beginning 0))))) + (setq positions (cons pos positions))) + + ;; Indentation required for a pre block in current context + (setq pos (length (markdown-pre-indentation (point)))) + (setq positions (cons pos positions)) + + ;; Indentation of the previous line + tab-width + (if prev-line-pos + (setq positions (cons (+ prev-line-pos tab-width) positions)) + (setq positions (cons tab-width positions))) + + ;; Indentation of the previous line - tab-width + (if (and prev-line-pos (> prev-line-pos tab-width)) + (setq positions (cons (- prev-line-pos tab-width) positions))) + + ;; Indentation of all preceding list markers (when in a list) + (when (setq pos (markdown-calculate-list-levels)) + (setq positions (append pos positions))) + + ;; First column + (setq positions (cons 0 positions)) + + ;; Return reversed list + (reverse positions))) + +(defun markdown-enter-key () ;FIXME: Partly obsoleted by electric-indent + "Handle RET depending on the context. +If the point is at a table, move to the next row. Otherwise, +indent according to value of `markdown-indent-on-enter'. +When it is nil, simply call `newline'. Otherwise, indent the next line +following RET using `markdown-indent-line'. Furthermore, when it +is set to \\='indent-and-new-item and the point is in a list item, +start a new item with the same indentation. If the point is in an +empty list item, remove it (so that pressing RET twice when in a +list simply adds a blank line)." + (interactive) + (cond + ;; Table + ((markdown-table-at-point-p) + (call-interactively #'markdown-table-next-row)) + ;; Indent non-table text + (markdown-indent-on-enter + (let (bounds) + (if (and (memq markdown-indent-on-enter '(indent-and-new-item)) + (setq bounds (markdown-cur-list-item-bounds))) + (let ((beg (cl-first bounds)) + (end (cl-second bounds)) + (nonlist-indent (cl-fourth bounds)) + (checkbox (cl-sixth bounds))) + ;; Point is in a list item + (if (= (- end beg) (+ nonlist-indent (length checkbox))) + ;; Delete blank list + (progn + (delete-region beg end) + (newline) + (markdown-indent-line)) + (call-interactively #'markdown-insert-list-item))) + ;; Point is not in a list + (newline) + (markdown-indent-line)))) + ;; Insert a raw newline + (t (newline)))) + +(defun markdown-outdent-or-delete (arg) + "Handle BACKSPACE by cycling through indentation points. +When BACKSPACE is pressed, if there is only whitespace +before the current point, then outdent the line one level. +Otherwise, do normal delete by repeating +`backward-delete-char-untabify' ARG times." + (interactive "*p") + (if (use-region-p) + (backward-delete-char-untabify arg) + (let ((cur-pos (current-column)) + (start-of-indention (save-excursion + (back-to-indentation) + (current-column))) + (positions (markdown-calc-indents))) + (if (and (> cur-pos 0) (= cur-pos start-of-indention)) + (indent-line-to (markdown-outdent-find-next-position cur-pos positions)) + (backward-delete-char-untabify arg))))) + +(defun markdown-find-leftmost-column (beg end) + "Find the leftmost column in the region from BEG to END." + (let ((mincol 1000)) + (save-excursion + (goto-char beg) + (while (< (point) end) + (back-to-indentation) + (unless (looking-at-p "[ \t]*$") + (setq mincol (min mincol (current-column)))) + (forward-line 1) + )) + mincol)) + +(defun markdown-indent-region (beg end arg) + "Indent the region from BEG to END using some heuristics. +When ARG is non-nil, outdent the region instead. +See `markdown-indent-line' and `markdown-indent-line'." + (interactive "*r\nP") + (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<)) + (leftmostcol (markdown-find-leftmost-column beg end)) + (next-pos (if arg + (markdown-outdent-find-next-position leftmostcol positions) + (markdown-indent-find-next-position leftmostcol positions)))) + (indent-rigidly beg end (- next-pos leftmostcol)) + (setq deactivate-mark nil))) + +(defun markdown-outdent-region (beg end) + "Call `markdown-indent-region' on region from BEG to END with prefix." + (interactive "*r") + (markdown-indent-region beg end t)) + +(defun markdown--indent-region (start end) + (let ((deactivate-mark nil)) + (save-excursion + (goto-char end) + (setq end (point-marker)) + (goto-char start) + (when (bolp) + (forward-line 1)) + (while (< (point) end) + (unless (or (markdown-code-block-at-point-p) (and (bolp) (eolp))) + (indent-according-to-mode)) + (forward-line 1)) + (move-marker end nil)))) + + +;;; Markup Completion ========================================================= + +(defconst markdown-complete-alist + '((markdown-regex-header-atx . markdown-complete-atx) + (markdown-regex-header-setext . markdown-complete-setext) + (markdown-regex-hr . markdown-complete-hr)) + "Association list of form (regexp . function) for markup completion.") + +(defun markdown-incomplete-atx-p () + "Return t if ATX header markup is incomplete and nil otherwise. +Assumes match data is available for `markdown-regex-header-atx'. +Checks that the number of trailing hash marks equals the number of leading +hash marks, that there is only a single space before and after the text, +and that there is no extraneous whitespace in the text." + (or + ;; Number of starting and ending hash marks differs + (not (= (length (match-string 1)) (length (match-string 3)))) + ;; When the header text is not empty... + (and (> (length (match-string 2)) 0) + ;; ...if there are extra leading, trailing, or interior spaces + (or (not (= (match-beginning 2) (1+ (match-end 1)))) + (not (= (match-beginning 3) (1+ (match-end 2)))) + (string-match-p "[ \t\n]\\{2\\}" (match-string 2)))) + ;; When the header text is empty... + (and (= (length (match-string 2)) 0) + ;; ...if there are too many or too few spaces + (not (= (match-beginning 3) (+ (match-end 1) 2)))))) + +(defun markdown-complete-atx () + "Complete and normalize ATX headers. +Add or remove hash marks to the end of the header to match the +beginning. Ensure that there is only a single space between hash +marks and header text. Removes extraneous whitespace from header text. +Assumes match data is available for `markdown-regex-header-atx'. +Return nil if markup was complete and non-nil if markup was completed." + (when (markdown-incomplete-atx-p) + (let* ((new-marker (make-marker)) + (new-marker (set-marker new-marker (match-end 2)))) + ;; Hash marks and spacing at end + (goto-char (match-end 2)) + (delete-region (match-end 2) (match-end 3)) + (insert " " (match-string 1)) + ;; Remove extraneous whitespace from title + (replace-match (markdown-compress-whitespace-string (match-string 2)) + t t nil 2) + ;; Spacing at beginning + (goto-char (match-end 1)) + (delete-region (match-end 1) (match-beginning 2)) + (insert " ") + ;; Leave point at end of text + (goto-char new-marker)))) + +(defun markdown-incomplete-setext-p () + "Return t if setext header markup is incomplete and nil otherwise. +Assumes match data is available for `markdown-regex-header-setext'. +Checks that length of underline matches text and that there is no +extraneous whitespace in the text." + (or (not (= (length (match-string 1)) (length (match-string 2)))) + (string-match-p "[ \t\n]\\{2\\}" (match-string 1)))) + +(defun markdown-complete-setext () + "Complete and normalize setext headers. +Add or remove underline characters to match length of header +text. Removes extraneous whitespace from header text. Assumes +match data is available for `markdown-regex-header-setext'. +Return nil if markup was complete and non-nil if markup was completed." + (when (markdown-incomplete-setext-p) + (let* ((text (markdown-compress-whitespace-string (match-string 1))) + (char (char-after (match-beginning 2))) + (level (if (char-equal char ?-) 2 1))) + (goto-char (match-beginning 0)) + (delete-region (match-beginning 0) (match-end 0)) + (markdown-insert-header level text t) + t))) + +(defun markdown-incomplete-hr-p () + "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise. +Assumes match data is available for `markdown-regex-hr'." + (not (member (match-string 0) markdown-hr-strings))) + +(defun markdown-complete-hr () + "Complete horizontal rules. +If horizontal rule string is a member of `markdown-hr-strings', +do nothing. Otherwise, replace with the car of +`markdown-hr-strings'. +Assumes match data is available for `markdown-regex-hr'. +Return nil if markup was complete and non-nil if markup was completed." + (when (markdown-incomplete-hr-p) + (replace-match (car markdown-hr-strings)) + t)) + +(defun markdown-complete () + "Complete markup of object near point or in region when active. +Handle all objects in `markdown-complete-alist', in order. +See `markdown-complete-at-point' and `markdown-complete-region'." + (interactive "*") + (if (use-region-p) + (markdown-complete-region (region-beginning) (region-end)) + (markdown-complete-at-point))) + +(defun markdown-complete-at-point () + "Complete markup of object near point. +Handle all elements of `markdown-complete-alist' in order." + (interactive "*") + (let ((list markdown-complete-alist) found changed) + (while list + (let ((regexp (eval (caar list) t)) ;FIXME: Why `eval'? + (function (cdar list))) + (setq list (cdr list)) + (when (thing-at-point-looking-at regexp) + (setq found t) + (setq changed (funcall function)) + (setq list nil)))) + (if found + (or changed (user-error "Markup at point is complete")) + (user-error "Nothing to complete at point")))) + +(defun markdown-complete-region (beg end) + "Complete markup of objects in region from BEG to END. +Handle all objects in `markdown-complete-alist', in order. Each +match is checked to ensure that a previous regexp does not also +match." + (interactive "*r") + (let ((end-marker (set-marker (make-marker) end)) + previous) + (dolist (element markdown-complete-alist) + (let ((regexp (eval (car element) t)) ;FIXME: Why `eval'? + (function (cdr element))) + (goto-char beg) + (while (re-search-forward regexp end-marker 'limit) + (when (match-string 0) + ;; Make sure this is not a match for any of the preceding regexps. + ;; This prevents mistaking an HR for a Setext subheading. + (let (match) + (save-match-data + (dolist (prev-regexp previous) + (or match (setq match (looking-back prev-regexp nil))))) + (unless match + (save-excursion (funcall function)))))) + (cl-pushnew regexp previous :test #'equal))) + previous)) + +(defun markdown-complete-buffer () + "Complete markup for all objects in the current buffer." + (interactive "*") + (markdown-complete-region (point-min) (point-max))) + + +;;; Markup Cycling ============================================================ + +(defun markdown-cycle-atx (arg &optional remove) + "Cycle ATX header markup. +Promote header (decrease level) when ARG is 1 and demote +header (increase level) if arg is -1. When REMOVE is non-nil, +remove the header when the level reaches zero and stop cycling +when it reaches six. Otherwise, perform a proper cycling through +levels one through six. Assumes match data is available for +`markdown-regex-header-atx'." + (let* ((old-level (length (match-string 1))) + (new-level (+ old-level arg)) + (text (match-string 2))) + (when (not remove) + (setq new-level (% new-level 6)) + (setq new-level (cond ((= new-level 0) 6) + ((< new-level 0) (+ new-level 6)) + (t new-level)))) + (cond + ((= new-level 0) + (markdown-unwrap-thing-at-point nil 0 2)) + ((<= new-level 6) + (goto-char (match-beginning 0)) + (delete-region (match-beginning 0) (match-end 0)) + (markdown-insert-header new-level text nil))))) + +(defun markdown-cycle-setext (arg &optional remove) + "Cycle setext header markup. +Promote header (increase level) when ARG is 1 and demote +header (decrease level or remove) if arg is -1. When demoting a +level-two setext header, replace with a level-three atx header. +When REMOVE is non-nil, remove the header when the level reaches +zero. Otherwise, cycle back to a level six atx header. Assumes +match data is available for `markdown-regex-header-setext'." + (let* ((char (char-after (match-beginning 2))) + (old-level (if (char-equal char ?=) 1 2)) + (new-level (+ old-level arg))) + (when (and (not remove) (= new-level 0)) + (setq new-level 6)) + (cond + ((= new-level 0) + (markdown-unwrap-thing-at-point nil 0 1)) + ((<= new-level 2) + (markdown-insert-header new-level nil t)) + ((<= new-level 6) + (markdown-insert-header new-level nil nil))))) + +(defun markdown-cycle-hr (arg &optional remove) + "Cycle string used for horizontal rule from `markdown-hr-strings'. +When ARG is 1, cycle forward (demote), and when ARG is -1, cycle +backwards (promote). When REMOVE is non-nil, remove the hr instead +of cycling when the end of the list is reached. +Assumes match data is available for `markdown-regex-hr'." + (let* ((strings (if (= arg -1) + (reverse markdown-hr-strings) + markdown-hr-strings)) + (tail (member (match-string 0) strings)) + (new (or (cadr tail) + (if remove + (if (= arg 1) + "" + (car tail)) + (car strings))))) + (replace-match new))) + +(defun markdown-cycle-bold () + "Cycle bold markup between underscores and asterisks. +Assumes match data is available for `markdown-regex-bold'." + (save-excursion + (let* ((old-delim (match-string 3)) + (new-delim (if (string-equal old-delim "**") "__" "**"))) + (replace-match new-delim t t nil 3) + (replace-match new-delim t t nil 5)))) + +(defun markdown-cycle-italic () + "Cycle italic markup between underscores and asterisks. +Assumes match data is available for `markdown-regex-italic'." + (save-excursion + (let* ((old-delim (match-string 2)) + (new-delim (if (string-equal old-delim "*") "_" "*"))) + (replace-match new-delim t t nil 2) + (replace-match new-delim t t nil 4)))) + + +;;; Keymap ==================================================================== + +(defun markdown--style-map-prompt () + "Return a formatted prompt for Markdown markup insertion." + (when markdown-enable-prefix-prompts + (concat + "Markdown: " + (propertize "bold" 'face 'markdown-bold-face) ", " + (propertize "italic" 'face 'markdown-italic-face) ", " + (propertize "code" 'face 'markdown-inline-code-face) ", " + (propertize "C = GFM code" 'face 'markdown-code-face) ", " + (propertize "pre" 'face 'markdown-pre-face) ", " + (propertize "footnote" 'face 'markdown-footnote-text-face) ", " + (propertize "F = foldable" 'face 'markdown-bold-face) ", " + (propertize "q = blockquote" 'face 'markdown-blockquote-face) ", " + (propertize "h & 1-6 = heading" 'face 'markdown-header-face) ", " + (propertize "- = hr" 'face 'markdown-hr-face) ", " + "C-h = more"))) + +(defun markdown--command-map-prompt () + "Return prompt for Markdown buffer-wide commands." + (when markdown-enable-prefix-prompts + (concat + "Command: " + (propertize "m" 'face 'markdown-bold-face) "arkdown, " + (propertize "p" 'face 'markdown-bold-face) "review, " + (propertize "o" 'face 'markdown-bold-face) "pen, " + (propertize "e" 'face 'markdown-bold-face) "xport, " + "export & pre" (propertize "v" 'face 'markdown-bold-face) "iew, " + (propertize "c" 'face 'markdown-bold-face) "heck refs, " + (propertize "u" 'face 'markdown-bold-face) "nused refs, " + "C-h = more"))) + +(defvar markdown-mode-style-map + (let ((map (make-keymap (markdown--style-map-prompt)))) + (define-key map (kbd "1") 'markdown-insert-header-atx-1) + (define-key map (kbd "2") 'markdown-insert-header-atx-2) + (define-key map (kbd "3") 'markdown-insert-header-atx-3) + (define-key map (kbd "4") 'markdown-insert-header-atx-4) + (define-key map (kbd "5") 'markdown-insert-header-atx-5) + (define-key map (kbd "6") 'markdown-insert-header-atx-6) + (define-key map (kbd "!") 'markdown-insert-header-setext-1) + (define-key map (kbd "@") 'markdown-insert-header-setext-2) + (define-key map (kbd "b") 'markdown-insert-bold) + (define-key map (kbd "c") 'markdown-insert-code) + (define-key map (kbd "C") 'markdown-insert-gfm-code-block) + (define-key map (kbd "f") 'markdown-insert-footnote) + (define-key map (kbd "F") 'markdown-insert-foldable-block) + (define-key map (kbd "h") 'markdown-insert-header-dwim) + (define-key map (kbd "H") 'markdown-insert-header-setext-dwim) + (define-key map (kbd "i") 'markdown-insert-italic) + (define-key map (kbd "k") 'markdown-insert-kbd) + (define-key map (kbd "l") 'markdown-insert-link) + (define-key map (kbd "p") 'markdown-insert-pre) + (define-key map (kbd "P") 'markdown-pre-region) + (define-key map (kbd "q") 'markdown-insert-blockquote) + (define-key map (kbd "s") 'markdown-insert-strike-through) + (define-key map (kbd "t") 'markdown-insert-table) + (define-key map (kbd "Q") 'markdown-blockquote-region) + (define-key map (kbd "w") 'markdown-insert-wiki-link) + (define-key map (kbd "-") 'markdown-insert-hr) + (define-key map (kbd "[") 'markdown-insert-gfm-checkbox) + ;; Deprecated keys that may be removed in a future version + (define-key map (kbd "e") 'markdown-insert-italic) + map) + "Keymap for Markdown text styling commands.") + +(defvar markdown-mode-command-map + (let ((map (make-keymap (markdown--command-map-prompt)))) + (define-key map (kbd "m") 'markdown-other-window) + (define-key map (kbd "p") 'markdown-preview) + (define-key map (kbd "e") 'markdown-export) + (define-key map (kbd "v") 'markdown-export-and-preview) + (define-key map (kbd "o") 'markdown-open) + (define-key map (kbd "l") 'markdown-live-preview-mode) + (define-key map (kbd "w") 'markdown-kill-ring-save) + (define-key map (kbd "c") 'markdown-check-refs) + (define-key map (kbd "u") 'markdown-unused-refs) + (define-key map (kbd "n") 'markdown-cleanup-list-numbers) + (define-key map (kbd "]") 'markdown-complete-buffer) + (define-key map (kbd "^") 'markdown-table-sort-lines) + (define-key map (kbd "|") 'markdown-table-convert-region) + (define-key map (kbd "t") 'markdown-table-transpose) + map) + "Keymap for Markdown buffer-wide commands.") + +(defvar markdown-mode-map + (let ((map (make-keymap))) + ;; Markup insertion & removal + (define-key map (kbd "C-c C-s") markdown-mode-style-map) + (define-key map (kbd "C-c C-l") 'markdown-insert-link) + (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point) + ;; Promotion, demotion, and cycling + (define-key map (kbd "C-c C--") 'markdown-promote) + (define-key map (kbd "C-c C-=") 'markdown-demote) + (define-key map (kbd "C-c C-]") 'markdown-complete) + ;; Following and doing things + (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point) + (define-key map (kbd "C-c C-d") 'markdown-do) + (define-key map (kbd "C-c '") 'markdown-edit-code-block) + ;; Indentation + (define-key map (kbd "RET") 'markdown-enter-key) + (define-key map (kbd "DEL") 'markdown-outdent-or-delete) + (define-key map (kbd "C-c >") 'markdown-indent-region) + (define-key map (kbd "C-c <") 'markdown-outdent-region) + ;; Visibility cycling + (define-key map (kbd "TAB") 'markdown-cycle) + ;; S-iso-lefttab and S-tab should both be mapped to `backtab' by + ;; (local-)function-key-map. + ;;(define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab) + ;;(define-key map (kbd "<S-tab>") 'markdown-shifttab) + (define-key map (kbd "<backtab>") 'markdown-shifttab) + ;; Heading and list navigation + (define-key map (kbd "C-c C-n") 'markdown-outline-next) + (define-key map (kbd "C-c C-p") 'markdown-outline-previous) + (define-key map (kbd "C-c C-f") 'markdown-outline-next-same-level) + (define-key map (kbd "C-c C-b") 'markdown-outline-previous-same-level) + (define-key map (kbd "C-c C-u") 'markdown-outline-up) + ;; Buffer-wide commands + (define-key map (kbd "C-c C-c") markdown-mode-command-map) + ;; Subtree, list, and table editing + (define-key map (kbd "C-c <up>") 'markdown-move-up) + (define-key map (kbd "C-c <down>") 'markdown-move-down) + (define-key map (kbd "C-c <left>") 'markdown-promote) + (define-key map (kbd "C-c <right>") 'markdown-demote) + (define-key map (kbd "C-c S-<up>") 'markdown-table-delete-row) + (define-key map (kbd "C-c S-<down>") 'markdown-table-insert-row) + (define-key map (kbd "C-c S-<left>") 'markdown-table-delete-column) + (define-key map (kbd "C-c S-<right>") 'markdown-table-insert-column) + (define-key map (kbd "C-c C-M-h") 'markdown-mark-subtree) + (define-key map (kbd "C-x n s") 'markdown-narrow-to-subtree) + (define-key map (kbd "M-RET") 'markdown-insert-list-item) + (define-key map (kbd "C-c C-j") 'markdown-insert-list-item) + ;; Lines + (define-key map [remap move-beginning-of-line] 'markdown-beginning-of-line) + (define-key map [remap move-end-of-line] 'markdown-end-of-line) + ;; Paragraphs (Markdown context aware) + (define-key map [remap backward-paragraph] 'markdown-backward-paragraph) + (define-key map [remap forward-paragraph] 'markdown-forward-paragraph) + (define-key map [remap mark-paragraph] 'markdown-mark-paragraph) + ;; Blocks (one or more paragraphs) + (define-key map (kbd "C-M-{") 'markdown-backward-block) + (define-key map (kbd "C-M-}") 'markdown-forward-block) + (define-key map (kbd "C-c M-h") 'markdown-mark-block) + (define-key map (kbd "C-x n b") 'markdown-narrow-to-block) + ;; Pages (top-level sections) + (define-key map [remap backward-page] 'markdown-backward-page) + (define-key map [remap forward-page] 'markdown-forward-page) + (define-key map [remap mark-page] 'markdown-mark-page) + (define-key map [remap narrow-to-page] 'markdown-narrow-to-page) + ;; Link Movement + (define-key map (kbd "M-n") 'markdown-next-link) + (define-key map (kbd "M-p") 'markdown-previous-link) + ;; Toggling functionality + (define-key map (kbd "C-c C-x C-e") 'markdown-toggle-math) + (define-key map (kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively) + (define-key map (kbd "C-c C-x C-i") 'markdown-toggle-inline-images) + (define-key map (kbd "C-c C-x C-l") 'markdown-toggle-url-hiding) + (define-key map (kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding) + ;; Alternative keys (in case of problems with the arrow keys) + (define-key map (kbd "C-c C-x u") 'markdown-move-up) + (define-key map (kbd "C-c C-x d") 'markdown-move-down) + (define-key map (kbd "C-c C-x l") 'markdown-promote) + (define-key map (kbd "C-c C-x r") 'markdown-demote) + ;; Deprecated keys that may be removed in a future version + (define-key map (kbd "C-c C-a L") 'markdown-insert-link) ;; C-c C-l + (define-key map (kbd "C-c C-a l") 'markdown-insert-link) ;; C-c C-l + (define-key map (kbd "C-c C-a r") 'markdown-insert-link) ;; C-c C-l + (define-key map (kbd "C-c C-a u") 'markdown-insert-uri) ;; C-c C-l + (define-key map (kbd "C-c C-a f") 'markdown-insert-footnote) + (define-key map (kbd "C-c C-a w") 'markdown-insert-wiki-link) + (define-key map (kbd "C-c C-t 1") 'markdown-insert-header-atx-1) + (define-key map (kbd "C-c C-t 2") 'markdown-insert-header-atx-2) + (define-key map (kbd "C-c C-t 3") 'markdown-insert-header-atx-3) + (define-key map (kbd "C-c C-t 4") 'markdown-insert-header-atx-4) + (define-key map (kbd "C-c C-t 5") 'markdown-insert-header-atx-5) + (define-key map (kbd "C-c C-t 6") 'markdown-insert-header-atx-6) + (define-key map (kbd "C-c C-t !") 'markdown-insert-header-setext-1) + (define-key map (kbd "C-c C-t @") 'markdown-insert-header-setext-2) + (define-key map (kbd "C-c C-t h") 'markdown-insert-header-dwim) + (define-key map (kbd "C-c C-t H") 'markdown-insert-header-setext-dwim) + (define-key map (kbd "C-c C-t s") 'markdown-insert-header-setext-2) + (define-key map (kbd "C-c C-t t") 'markdown-insert-header-setext-1) + (define-key map (kbd "C-c C-i") 'markdown-insert-image) + (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) ;; C-c C-j + (define-key map (kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox) ;; C-c C-d + (define-key map (kbd "C-c -") 'markdown-insert-hr) + map) + "Keymap for Markdown major mode.") + +(defvar markdown-mode-mouse-map + (when markdown-mouse-follow-link + (let ((map (make-sparse-keymap))) + (define-key map [follow-link] 'mouse-face) + (define-key map [mouse-2] #'markdown-follow-thing-at-point) + map)) + "Keymap for following links with mouse.") + +(defvar gfm-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map markdown-mode-map) + (define-key map (kbd "C-c C-s d") 'markdown-insert-strike-through) + (define-key map "`" 'markdown-electric-backquote) + map) + "Keymap for `gfm-mode'. +See also `markdown-mode-map'.") + + +;;; Menu ====================================================================== + +(easy-menu-define markdown-mode-menu markdown-mode-map + "Menu for Markdown mode." + '("Markdown" + "---" + ("Movement" + ["Jump" markdown-do] + ["Follow Link" markdown-follow-thing-at-point] + ["Next Link" markdown-next-link] + ["Previous Link" markdown-previous-link] + "---" + ["Next Heading or List Item" markdown-outline-next] + ["Previous Heading or List Item" markdown-outline-previous] + ["Next at Same Level" markdown-outline-next-same-level] + ["Previous at Same Level" markdown-outline-previous-same-level] + ["Up to Parent" markdown-outline-up] + "---" + ["Forward Paragraph" markdown-forward-paragraph] + ["Backward Paragraph" markdown-backward-paragraph] + ["Forward Block" markdown-forward-block] + ["Backward Block" markdown-backward-block]) + ("Show & Hide" + ["Cycle Heading Visibility" markdown-cycle + :enable (markdown-on-heading-p)] + ["Cycle Heading Visibility (Global)" markdown-shifttab] + "---" + ["Narrow to Region" narrow-to-region] + ["Narrow to Block" markdown-narrow-to-block] + ["Narrow to Section" narrow-to-defun] + ["Narrow to Subtree" markdown-narrow-to-subtree] + ["Widen" widen (buffer-narrowed-p)] + "---" + ["Toggle Markup Hiding" markdown-toggle-markup-hiding + :keys "C-c C-x C-m" + :style radio + :selected markdown-hide-markup]) + "---" + ("Headings & Structure" + ["Automatic Heading" markdown-insert-header-dwim + :keys "C-c C-s h"] + ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim + :keys "C-c C-s H"] + ("Specific Heading (atx)" + ["First Level atx" markdown-insert-header-atx-1 + :keys "C-c C-s 1"] + ["Second Level atx" markdown-insert-header-atx-2 + :keys "C-c C-s 2"] + ["Third Level atx" markdown-insert-header-atx-3 + :keys "C-c C-s 3"] + ["Fourth Level atx" markdown-insert-header-atx-4 + :keys "C-c C-s 4"] + ["Fifth Level atx" markdown-insert-header-atx-5 + :keys "C-c C-s 5"] + ["Sixth Level atx" markdown-insert-header-atx-6 + :keys "C-c C-s 6"]) + ("Specific Heading (Setext)" + ["First Level Setext" markdown-insert-header-setext-1 + :keys "C-c C-s !"] + ["Second Level Setext" markdown-insert-header-setext-2 + :keys "C-c C-s @"]) + ["Horizontal Rule" markdown-insert-hr + :keys "C-c C-s -"] + "---" + ["Move Subtree Up" markdown-move-up + :keys "C-c <up>"] + ["Move Subtree Down" markdown-move-down + :keys "C-c <down>"] + ["Promote Subtree" markdown-promote + :keys "C-c <left>"] + ["Demote Subtree" markdown-demote + :keys "C-c <right>"]) + ("Region & Mark" + ["Indent Region" markdown-indent-region] + ["Outdent Region" markdown-outdent-region] + "--" + ["Mark Paragraph" mark-paragraph] + ["Mark Block" markdown-mark-block] + ["Mark Section" mark-defun] + ["Mark Subtree" markdown-mark-subtree]) + ("Tables" + ["Move Row Up" markdown-move-up + :enable (markdown-table-at-point-p) + :keys "C-c <up>"] + ["Move Row Down" markdown-move-down + :enable (markdown-table-at-point-p) + :keys "C-c <down>"] + ["Move Column Left" markdown-promote + :enable (markdown-table-at-point-p) + :keys "C-c <left>"] + ["Move Column Right" markdown-demote + :enable (markdown-table-at-point-p) + :keys "C-c <right>"] + ["Delete Row" markdown-table-delete-row + :enable (markdown-table-at-point-p)] + ["Insert Row" markdown-table-insert-row + :enable (markdown-table-at-point-p)] + ["Delete Column" markdown-table-delete-column + :enable (markdown-table-at-point-p)] + ["Insert Column" markdown-table-insert-column + :enable (markdown-table-at-point-p)] + ["Insert Table" markdown-insert-table] + "--" + ["Convert Region to Table" markdown-table-convert-region] + ["Sort Table Lines" markdown-table-sort-lines + :enable (markdown-table-at-point-p)] + ["Transpose Table" markdown-table-transpose + :enable (markdown-table-at-point-p)]) + ("Lists" + ["Insert List Item" markdown-insert-list-item] + ["Move Subtree Up" markdown-move-up + :keys "C-c <up>"] + ["Move Subtree Down" markdown-move-down + :keys "C-c <down>"] + ["Indent Subtree" markdown-demote + :keys "C-c <right>"] + ["Outdent Subtree" markdown-promote + :keys "C-c <left>"] + ["Renumber List" markdown-cleanup-list-numbers] + ["Insert Task List Item" markdown-insert-gfm-checkbox + :keys "C-c C-x ["] + ["Toggle Task List Item" markdown-toggle-gfm-checkbox + :enable (markdown-gfm-task-list-item-at-point) + :keys "C-c C-d"]) + ("Links & Images" + ["Insert Link" markdown-insert-link] + ["Insert Image" markdown-insert-image] + ["Insert Footnote" markdown-insert-footnote + :keys "C-c C-s f"] + ["Insert Wiki Link" markdown-insert-wiki-link + :keys "C-c C-s w"] + "---" + ["Check References" markdown-check-refs] + ["Find Unused References" markdown-unused-refs] + ["Toggle URL Hiding" markdown-toggle-url-hiding + :style radio + :selected markdown-hide-urls] + ["Toggle Inline Images" markdown-toggle-inline-images + :keys "C-c C-x C-i" + :style radio + :selected markdown-inline-image-overlays] + ["Toggle Wiki Links" markdown-toggle-wiki-links + :style radio + :selected markdown-enable-wiki-links]) + ("Styles" + ["Bold" markdown-insert-bold] + ["Italic" markdown-insert-italic] + ["Code" markdown-insert-code] + ["Strikethrough" markdown-insert-strike-through] + ["Keyboard" markdown-insert-kbd] + "---" + ["Blockquote" markdown-insert-blockquote] + ["Preformatted" markdown-insert-pre] + ["GFM Code Block" markdown-insert-gfm-code-block] + ["Edit Code Block" markdown-edit-code-block + :enable (markdown-code-block-at-point-p)] + ["Foldable Block" markdown-insert-foldable-block] + "---" + ["Blockquote Region" markdown-blockquote-region] + ["Preformatted Region" markdown-pre-region] + "---" + ["Fontify Code Blocks Natively" + markdown-toggle-fontify-code-blocks-natively + :style radio + :selected markdown-fontify-code-blocks-natively] + ["LaTeX Math Support" markdown-toggle-math + :style radio + :selected markdown-enable-math]) + "---" + ("Preview & Export" + ["Compile" markdown-other-window] + ["Preview" markdown-preview] + ["Export" markdown-export] + ["Export & View" markdown-export-and-preview] + ["Open" markdown-open] + ["Live Export" markdown-live-preview-mode + :style radio + :selected markdown-live-preview-mode] + ["Kill ring save" markdown-kill-ring-save]) + ("Markup Completion and Cycling" + ["Complete Markup" markdown-complete] + ["Promote Element" markdown-promote + :keys "C-c C--"] + ["Demote Element" markdown-demote + :keys "C-c C-="]) + "---" + ["Kill Element" markdown-kill-thing-at-point] + "---" + ("Documentation" + ["Version" markdown-show-version] + ["Homepage" markdown-mode-info] + ["Describe Mode" (describe-function 'markdown-mode)] + ["Guide" (browse-url "https://leanpub.com/markdown-mode")]))) + + +;;; imenu ===================================================================== + +(defun markdown-imenu-create-nested-index () + "Create and return a nested imenu index alist for the current buffer. +See `imenu-create-index-function' and `imenu--index-alist' for details." + (let* ((root (list nil)) + (min-level 9999) + hashes headers) + (save-excursion + ;; Headings + (goto-char (point-min)) + (while (re-search-forward markdown-regex-header (point-max) t) + (unless (or (markdown-code-block-at-point-p) + (and (match-beginning 3) + (get-text-property (match-beginning 3) 'markdown-yaml-metadata-end))) + (cond + ((match-string-no-properties 2) ;; level 1 setext + (setq min-level 1) + (push (list :heading (match-string-no-properties 1) + :point (match-beginning 1) + :level 1) headers)) + ((match-string-no-properties 3) ;; level 2 setext + (setq min-level (min min-level 2)) + (push (list :heading (match-string-no-properties 1) + :point (match-beginning 1) + :level (- 2 (1- min-level))) headers)) + ((setq hashes (markdown-trim-whitespace + (match-string-no-properties 4))) + (setq min-level (min min-level (length hashes))) + (push (list :heading (match-string-no-properties 5) + :point (match-beginning 4) + :level (- (length hashes) (1- min-level))) headers))))) + (cl-loop with cur-level = 0 + with cur-alist = nil + with empty-heading = "-" + with self-heading = "." + for header in (reverse headers) + for level = (plist-get header :level) + do + (let ((alist (list (cons (plist-get header :heading) (plist-get header :point))))) + (cond + ((= cur-level level) ; new sibling + (setcdr cur-alist alist) + (setq cur-alist alist)) + ((< cur-level level) ; first child + (dotimes (_ (- level cur-level 1)) + (setq alist (list (cons empty-heading alist)))) + (if cur-alist + (let* ((parent (car cur-alist)) + (self-pos (cdr parent))) + (setcdr parent (cons (cons self-heading self-pos) alist))) + (setcdr root alist)) ; primogenitor + (setq cur-alist alist) + (setq cur-level level)) + (t ; new sibling of an ancestor + (let ((sibling-alist (last (cdr root)))) + (dotimes (_ (1- level)) + (setq sibling-alist (last (cdar sibling-alist)))) + (setcdr sibling-alist alist) + (setq cur-alist alist)) + (setq cur-level level))))) + (setq root (copy-tree root)) + ;; Footnotes + (let ((fn (markdown-get-defined-footnotes))) + (if (or (zerop (length fn)) + (null markdown-add-footnotes-to-imenu)) + (cdr root) + (nconc (cdr root) (list (cons "Footnotes" fn)))))))) + +(defun markdown-imenu-create-flat-index () + "Create and return a flat imenu index alist for the current buffer. +See `imenu-create-index-function' and `imenu--index-alist' for details." + (let* ((empty-heading "-") index heading pos) + (save-excursion + ;; Headings + (goto-char (point-min)) + (while (re-search-forward markdown-regex-header (point-max) t) + (when (and (not (markdown-code-block-at-point-p (line-beginning-position))) + (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin))) + (cond + ((setq heading (match-string-no-properties 1)) + (setq pos (match-beginning 1))) + ((setq heading (match-string-no-properties 5)) + (setq pos (match-beginning 4)))) + (or (> (length heading) 0) + (setq heading empty-heading)) + (setq index (append index (list (cons heading pos)))))) + ;; Footnotes + (when markdown-add-footnotes-to-imenu + (nconc index (markdown-get-defined-footnotes))) + index))) + + +;;; References ================================================================ + +(defun markdown-reference-goto-definition () + "Jump to the definition of the reference at point or create it." + (interactive) + (when (thing-at-point-looking-at markdown-regex-link-reference) + (let* ((text (match-string-no-properties 3)) + (reference (match-string-no-properties 6)) + (target (downcase (if (string= reference "") text reference))) + (loc (cadr (save-match-data (markdown-reference-definition target))))) + (if loc + (goto-char loc) + (goto-char (match-beginning 0)) + (markdown-insert-reference-definition target))))) + +(defun markdown-reference-find-links (reference) + "Return a list of all links for REFERENCE. +REFERENCE should not include the surrounding square brackets. +Elements of the list have the form (text start line), where +text is the link text, start is the location at the beginning of +the link, and line is the line number on which the link appears." + (let* ((ref-quote (regexp-quote reference)) + (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)" + ref-quote ref-quote)) + links) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (let* ((text (or (match-string-no-properties 1) + (match-string-no-properties 2))) + (start (match-beginning 0)) + (line (markdown-line-number-at-pos))) + (cl-pushnew (list text start line) links :test #'equal)))) + links)) + +(defmacro markdown-for-all-refs (f) + `(let ((result)) + (save-excursion + (goto-char (point-min)) + (while + (re-search-forward markdown-regex-link-reference nil t) + (let* ((text (match-string-no-properties 3)) + (reference (match-string-no-properties 6)) + (target (downcase (if (string= reference "") text reference)))) + (,f text target result)))) + (reverse result))) + +(defmacro markdown-collect-always (_ target result) + `(cl-pushnew ,target ,result :test #'equal)) + +(defmacro markdown-collect-undefined (text target result) + `(unless (markdown-reference-definition target) + (let ((entry (assoc ,target ,result))) + (if (not entry) + (cl-pushnew + (cons ,target (list (cons ,text (markdown-line-number-at-pos)))) + ,result :test #'equal) + (setcdr entry + (append (cdr entry) (list (cons ,text (markdown-line-number-at-pos))))))))) + +(defun markdown-get-all-refs () + "Return a list of all Markdown references." + (markdown-for-all-refs markdown-collect-always)) + +(defun markdown-get-undefined-refs () + "Return a list of undefined Markdown references. +Result is an alist of pairs (reference . occurrences), where +occurrences is itself another alist of pairs (label . line-number). +For example, an alist corresponding to [Nice editor][Emacs] at line 12, +\[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is +\((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))." + (markdown-for-all-refs markdown-collect-undefined)) + +(defun markdown-get-unused-refs () + (cl-sort + (cl-set-difference + (markdown-get-defined-references) (markdown-get-all-refs) + :test (lambda (e1 e2) (equal (car e1) e2))) + #'< :key #'cdr)) + +(defmacro defun-markdown-buffer (name docstring) + "Define a function to name and return a buffer. + +By convention, NAME must be a name of a string constant with +%buffer% placeholder used to name the buffer, and will also be +used as a name of the function defined. + +DOCSTRING will be used as the first part of the docstring." + `(defun ,name (&optional buffer-name) + ,(concat docstring "\n\nBUFFER-NAME is the name of the main buffer being visited.") + (or buffer-name (setq buffer-name (buffer-name))) + (let ((refbuf (get-buffer-create (replace-regexp-in-string + "%buffer%" buffer-name + ,name)))) + (with-current-buffer refbuf + (when view-mode + (View-exit-and-edit)) + (use-local-map button-buffer-map) + (erase-buffer)) + refbuf))) + +(defconst markdown-reference-check-buffer + "*Undefined references for %buffer%*" + "Pattern for name of buffer for listing undefined references. +The string %buffer% will be replaced by the corresponding +`markdown-mode' buffer name.") + +(defun-markdown-buffer + markdown-reference-check-buffer + "Name and return buffer for reference checking.") + +(defconst markdown-unused-references-buffer + "*Unused references for %buffer%*" + "Pattern for name of buffer for listing unused references. +The string %buffer% will be replaced by the corresponding +`markdown-mode' buffer name.") + +(defun-markdown-buffer + markdown-unused-references-buffer + "Name and return buffer for unused reference checking.") + +(defconst markdown-reference-links-buffer + "*Reference links for %buffer%*" + "Pattern for name of buffer for listing references. +The string %buffer% will be replaced by the corresponding buffer name.") + +(defun-markdown-buffer + markdown-reference-links-buffer + "Name, setup, and return a buffer for listing links.") + +;; Add an empty Markdown reference definition to buffer +;; specified in the 'target-buffer property. The reference name is +;; the button's label. +(define-button-type 'markdown-undefined-reference-button + 'help-echo "mouse-1, RET: create definition for undefined reference" + 'follow-link t + 'face 'bold + 'action (lambda (b) + (let ((buffer (button-get b 'target-buffer)) + (line (button-get b 'target-line)) + (label (button-label b))) + (switch-to-buffer-other-window buffer) + (goto-char (point-min)) + (forward-line line) + (markdown-insert-reference-definition label) + (markdown-check-refs t)))) + +;; Jump to line in buffer specified by 'target-buffer property. +;; Line number is button's 'target-line property. +(define-button-type 'markdown-goto-line-button + 'help-echo "mouse-1, RET: go to line" + 'follow-link t + 'face 'italic + 'action (lambda (b) + (switch-to-buffer-other-window (button-get b 'target-buffer)) + ;; use call-interactively to silence compiler + (let ((current-prefix-arg (button-get b 'target-line))) + (call-interactively 'goto-line)))) + +;; Kill a line in buffer specified by 'target-buffer property. +;; Line number is button's 'target-line property. +(define-button-type 'markdown-kill-line-button + 'help-echo "mouse-1, RET: kill line" + 'follow-link t + 'face 'italic + 'action (lambda (b) + (switch-to-buffer-other-window (button-get b 'target-buffer)) + ;; use call-interactively to silence compiler + (let ((current-prefix-arg (button-get b 'target-line))) + (call-interactively 'goto-line)) + (kill-line 1) + (markdown-unused-refs t))) + +;; Jumps to a particular link at location given by 'target-char +;; property in buffer given by 'target-buffer property. +(define-button-type 'markdown-location-button + 'help-echo "mouse-1, RET: jump to location of link" + 'follow-link t + 'face 'bold + 'action (lambda (b) + (let ((target (button-get b 'target-buffer)) + (loc (button-get b 'target-char))) + (kill-buffer-and-window) + (switch-to-buffer target) + (goto-char loc)))) + +(defun markdown-insert-undefined-reference-button (reference oldbuf) + "Insert a button for creating REFERENCE in buffer OLDBUF. +REFERENCE should be a list of the form (reference . occurrences), +as returned by `markdown-get-undefined-refs'." + (let ((label (car reference))) + ;; Create a reference button + (insert-button label + :type 'markdown-undefined-reference-button + 'target-buffer oldbuf + 'target-line (cdr (car (cdr reference)))) + (insert " (") + (dolist (occurrence (cdr reference)) + (let ((line (cdr occurrence))) + ;; Create a line number button + (insert-button (number-to-string line) + :type 'markdown-goto-line-button + 'target-buffer oldbuf + 'target-line line) + (insert " "))) + (delete-char -1) + (insert ")") + (newline))) + +(defun markdown-insert-unused-reference-button (reference oldbuf) + "Insert a button for creating REFERENCE in buffer OLDBUF. +REFERENCE must be a pair of (ref . line-number)." + (let ((label (car reference)) + (line (cdr reference))) + ;; Create a reference button + (insert-button label + :type 'markdown-goto-line-button + 'face 'bold + 'target-buffer oldbuf + 'target-line line) + (insert (format " (%d) [" line)) + (insert-button "X" + :type 'markdown-kill-line-button + 'face 'bold + 'target-buffer oldbuf + 'target-line line) + (insert "]") + (newline))) + +(defun markdown-insert-link-button (link oldbuf) + "Insert a button for jumping to LINK in buffer OLDBUF. +LINK should be a list of the form (text char line) containing +the link text, location, and line number." + (let ((label (cl-first link)) + (char (cl-second link)) + (line (cl-third link))) + ;; Create a reference button + (insert-button label + :type 'markdown-location-button + 'target-buffer oldbuf + 'target-char char) + (insert (format " (line %d)\n" line)))) + +(defun markdown-reference-goto-link (&optional reference) + "Jump to the location of the first use of REFERENCE." + (interactive) + (unless reference + (if (thing-at-point-looking-at markdown-regex-reference-definition) + (setq reference (match-string-no-properties 2)) + (user-error "No reference definition at point"))) + (let ((links (markdown-reference-find-links reference))) + (cond ((= (length links) 1) + (goto-char (cadr (car links)))) + ((> (length links) 1) + (let ((oldbuf (current-buffer)) + (linkbuf (markdown-reference-links-buffer))) + (with-current-buffer linkbuf + (insert "Links using reference " reference ":\n\n") + (dolist (link (reverse links)) + (markdown-insert-link-button link oldbuf))) + (view-buffer-other-window linkbuf) + (goto-char (point-min)) + (forward-line 2))) + (t + (error "No links for reference %s" reference))))) + +(defmacro defun-markdown-ref-checker + (name docstring checker-function buffer-function none-message buffer-header insert-reference) + "Define a function NAME acting on result of CHECKER-FUNCTION. + +DOCSTRING is used as a docstring for the defined function. + +BUFFER-FUNCTION should name and return an auxiliary buffer to put +results in. + +NONE-MESSAGE is used when CHECKER-FUNCTION returns no results. + +BUFFER-HEADER is put into the auxiliary buffer first, followed by +calling INSERT-REFERENCE for each element in the list returned by +CHECKER-FUNCTION." + `(defun ,name (&optional silent) + ,(concat + docstring + "\n\nIf SILENT is non-nil, do not message anything when no +such references found.") + (interactive "P") + (unless (derived-mode-p 'markdown-mode) + (user-error "Not available in current mode")) + (let ((oldbuf (current-buffer)) + (refs (,checker-function)) + (refbuf (,buffer-function))) + (if (null refs) + (progn + (when (not silent) + (message ,none-message)) + (kill-buffer refbuf)) + (with-current-buffer refbuf + (insert ,buffer-header) + (dolist (ref refs) + (,insert-reference ref oldbuf)) + (view-buffer-other-window refbuf) + (goto-char (point-min)) + (forward-line 2)))))) + +(defun-markdown-ref-checker + markdown-check-refs + "Show all undefined Markdown references in current `markdown-mode' buffer. + +Links which have empty reference definitions are considered to be +defined." + markdown-get-undefined-refs + markdown-reference-check-buffer + "No undefined references found" + "The following references are undefined:\n\n" + markdown-insert-undefined-reference-button) + + +(defun-markdown-ref-checker + markdown-unused-refs + "Show all unused Markdown references in current `markdown-mode' buffer." + markdown-get-unused-refs + markdown-unused-references-buffer + "No unused references found" + "The following references are unused:\n\n" + markdown-insert-unused-reference-button) + + + +;;; Lists ===================================================================== + +(defun markdown-insert-list-item (&optional arg) + "Insert a new list item. +If the point is inside unordered list, insert a bullet mark. If +the point is inside ordered list, insert the next number followed +by a period. Use the previous list item to determine the amount +of whitespace to place before and after list markers. + +With a \\[universal-argument] prefix (i.e., when ARG is (4)), +decrease the indentation by one level. + +With two \\[universal-argument] prefixes (i.e., when ARG is (16)), +increase the indentation by one level." + (interactive "p") + (let (bounds cur-indent marker indent new-indent new-loc) + (save-match-data + ;; Look for a list item on current or previous non-blank line + (save-excursion + (while (and (not (setq bounds (markdown-cur-list-item-bounds))) + (not (bobp)) + (markdown-cur-line-blank-p)) + (forward-line -1))) + (when bounds + (cond ((save-excursion + (skip-chars-backward " \t") + (looking-at-p markdown-regex-list)) + (beginning-of-line) + (insert "\n") + (forward-line -1)) + ((not (markdown-cur-line-blank-p)) + (newline))) + (setq new-loc (point))) + ;; Look ahead for a list item on next non-blank line + (unless bounds + (save-excursion + (while (and (null bounds) + (not (eobp)) + (markdown-cur-line-blank-p)) + (forward-line) + (setq bounds (markdown-cur-list-item-bounds)))) + (when bounds + (setq new-loc (point)) + (unless (markdown-cur-line-blank-p) + (newline)))) + (if (not bounds) + ;; When not in a list, start a new unordered one + (progn + (unless (markdown-cur-line-blank-p) + (insert "\n")) + (insert markdown-unordered-list-item-prefix)) + ;; Compute indentation and marker for new list item + (setq cur-indent (nth 2 bounds)) + (setq marker (nth 4 bounds)) + ;; If current item is a GFM checkbox, insert new unchecked checkbox. + (when (nth 5 bounds) + (setq marker + (concat marker + (replace-regexp-in-string "[Xx]" " " (nth 5 bounds))))) + (cond + ;; Dedent: decrement indentation, find previous marker. + ((= arg 4) + (setq indent (max (- cur-indent markdown-list-indent-width) 0)) + (let ((prev-bounds + (save-excursion + (goto-char (nth 0 bounds)) + (when (markdown-up-list) + (markdown-cur-list-item-bounds))))) + (when prev-bounds + (setq marker (nth 4 prev-bounds))))) + ;; Indent: increment indentation by 4, use same marker. + ((= arg 16) (setq indent (+ cur-indent markdown-list-indent-width))) + ;; Same level: keep current indentation and marker. + (t (setq indent cur-indent))) + (setq new-indent (make-string indent 32)) + (goto-char new-loc) + (cond + ;; Ordered list + ((string-match-p "[0-9]" marker) + (if (= arg 16) ;; starting a new column indented one more level + (insert (concat new-indent "1. ")) + ;; Don't use previous match-data + (set-match-data nil) + ;; travel up to the last item and pick the correct number. If + ;; the argument was nil, "new-indent = cur-indent" is the same, + ;; so we don't need special treatment. Neat. + (save-excursion + (while (and (not (looking-at (concat new-indent "\\([0-9]+\\)\\(\\.[ \t]*\\)"))) + (>= (forward-line -1) 0)))) + (let* ((old-prefix (match-string 1)) + (old-spacing (match-string 2)) + (new-prefix (if (and old-prefix markdown-ordered-list-enumeration) + (int-to-string (1+ (string-to-number old-prefix))) + "1")) + (space-adjust (- (length old-prefix) (length new-prefix))) + (new-spacing (if (and (match-string 2) + (not (string-match-p "\t" old-spacing)) + (< space-adjust 0) + (> space-adjust (- 1 (length (match-string 2))))) + (substring (match-string 2) 0 space-adjust) + (or old-spacing ". ")))) + (insert (concat new-indent new-prefix new-spacing))))) + ;; Unordered list, GFM task list, or ordered list with hash mark + ((string-match-p "[\\*\\+-]\\|#\\." marker) + (insert new-indent marker)))) + ;; Propertize the newly inserted list item now + (markdown-syntax-propertize-list-items (line-beginning-position) (line-end-position))))) + +(defun markdown-move-list-item-up () + "Move the current list item up in the list when possible. +In nested lists, move child items with the parent item." + (interactive) + (let (cur prev old) + (when (setq cur (markdown-cur-list-item-bounds)) + (setq old (point)) + (goto-char (nth 0 cur)) + (if (markdown-prev-list-item (nth 3 cur)) + (progn + (setq prev (markdown-cur-list-item-bounds)) + (condition-case nil + (progn + (transpose-regions (nth 0 prev) (nth 1 prev) + (nth 0 cur) (nth 1 cur) t) + (goto-char (+ (nth 0 prev) (- old (nth 0 cur))))) + ;; Catch error in case regions overlap. + (error (goto-char old)))) + (goto-char old))))) + +(defun markdown-move-list-item-down () + "Move the current list item down in the list when possible. +In nested lists, move child items with the parent item." + (interactive) + (let (cur next old) + (when (setq cur (markdown-cur-list-item-bounds)) + (setq old (point)) + (if (markdown-next-list-item (nth 3 cur)) + (progn + (setq next (markdown-cur-list-item-bounds)) + (condition-case nil + (progn + (transpose-regions (nth 0 cur) (nth 1 cur) + (nth 0 next) (nth 1 next) nil) + (goto-char (+ old (- (nth 1 next) (nth 1 cur))))) + ;; Catch error in case regions overlap. + (error (goto-char old)))) + (goto-char old))))) + +(defun markdown-demote-list-item (&optional bounds) + "Indent (or demote) the current list item. +Optionally, BOUNDS of the current list item may be provided if available. +In nested lists, demote child items as well." + (interactive) + (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) + (save-excursion + (let* ((item-start (set-marker (make-marker) (nth 0 bounds))) + (item-end (set-marker (make-marker) (nth 1 bounds))) + (list-start (progn (markdown-beginning-of-list) + (set-marker (make-marker) (point)))) + (list-end (progn (markdown-end-of-list) + (set-marker (make-marker) (point))))) + (goto-char item-start) + (while (< (point) item-end) + (unless (markdown-cur-line-blank-p) + (insert (make-string markdown-list-indent-width ? ))) + (forward-line)) + (markdown-syntax-propertize-list-items list-start list-end))))) + +(defun markdown-promote-list-item (&optional bounds) + "Unindent (or promote) the current list item. +Optionally, BOUNDS of the current list item may be provided if available. +In nested lists, demote child items as well." + (interactive) + (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) + (save-excursion + (save-match-data + (let ((item-start (set-marker (make-marker) (nth 0 bounds))) + (item-end (set-marker (make-marker) (nth 1 bounds))) + (list-start (progn (markdown-beginning-of-list) + (set-marker (make-marker) (point)))) + (list-end (progn (markdown-end-of-list) + (set-marker (make-marker) (point)))) + num regexp) + (goto-char item-start) + (when (looking-at (format "^[ ]\\{1,%d\\}" + markdown-list-indent-width)) + (setq num (- (match-end 0) (match-beginning 0))) + (setq regexp (format "^[ ]\\{1,%d\\}" num)) + (while (and (< (point) item-end) + (re-search-forward regexp item-end t)) + (replace-match "" nil nil) + (forward-line)) + (markdown-syntax-propertize-list-items list-start list-end))))))) + +(defun markdown-cleanup-list-numbers-level (&optional pfx prev-item) + "Update the numbering for level PFX (as a string of spaces) and PREV-ITEM. +PREV-ITEM is width of previous-indentation and list number + +Assume that the previously found match was for a numbered item in +a list." + (let ((cpfx pfx) + (cur-item nil) + (idx 0) + (continue t) + (step t) + (sep nil)) + (while (and continue (not (eobp))) + (setq step t) + (cond + ((looking-at "^\\(\\([\s-]*\\)[0-9]+\\)\\. ") + (setq cpfx (match-string-no-properties 2)) + (setq cur-item (match-string-no-properties 1)) ;; indentation and list marker + (cond + ((or (= (length cpfx) (length pfx)) + (= (length cur-item) (length prev-item))) + (save-excursion + (replace-match + (if (not markdown-ordered-list-enumeration) + (concat pfx "1. ") + (cl-incf idx) + (concat pfx (number-to-string idx) ". ")))) + (setq sep nil)) + ;; indented a level + ((< (length pfx) (length cpfx)) + (setq sep (markdown-cleanup-list-numbers-level cpfx cur-item)) + (setq step nil)) + ;; exit the loop + (t + (setq step nil) + (setq continue nil)))) + + ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$") + (setq cpfx (match-string-no-properties 1)) + (cond + ;; reset if separated before + ((string= cpfx pfx) (when sep (setq idx 0))) + ((string< cpfx pfx) + (setq step nil) + (setq continue nil)))) + (t (setq sep t))) + + (when step + (beginning-of-line) + (setq continue (= (forward-line) 0)))) + sep)) + +(defun markdown-cleanup-list-numbers () + "Update the numbering of ordered lists." + (interactive) + (save-excursion + (goto-char (point-min)) + (markdown-cleanup-list-numbers-level ""))) + + +;;; Movement ================================================================== + +;; This function was originally derived from `org-beginning-of-line' from org.el. +(defun markdown-beginning-of-line (&optional n) + "Go to the beginning of the current visible line. + +If this is a headline, and `markdown-special-ctrl-a/e' is not nil +or symbol `reversed', on the first attempt move to where the +headline text hashes, and only move to beginning of line when the +cursor is already before the hashes of the text of the headline. + +If `markdown-special-ctrl-a/e' is symbol `reversed' then go to +the hashes of the text on the second attempt. + +With argument N not nil or 1, move forward N - 1 lines first." + (interactive "^p") + (let ((origin (point)) + (special (pcase markdown-special-ctrl-a/e + (`(,C-a . ,_) C-a) (_ markdown-special-ctrl-a/e))) + deactivate-mark) + ;; First move to a visible line. + (if visual-line-mode + (beginning-of-visual-line n) + (move-beginning-of-line n) + ;; `move-beginning-of-line' may leave point after invisible + ;; characters if line starts with such of these (e.g., with + ;; a link at column 0). Really move to the beginning of the + ;; current visible line. + (forward-line 0)) + (cond + ;; No special behavior. Point is already at the beginning of + ;; a line, logical or visual. + ((not special)) + ;; `beginning-of-visual-line' left point before logical beginning + ;; of line: point is at the beginning of a visual line. Bail + ;; out. + ((and visual-line-mode (not (bolp)))) + ((looking-at markdown-regex-header-atx) + ;; At a header, special position is before the title. + (let ((refpos (match-beginning 2)) + (bol (point))) + (if (eq special 'reversed) + (when (and (= origin bol) (eq last-command this-command)) + (goto-char refpos)) + (when (or (> origin refpos) (<= origin bol)) + (goto-char refpos))) + ;; Prevent automatic cursor movement caused by the command loop. + ;; Enable disable-point-adjustment to avoid unintended cursor repositioning. + (when (and markdown-hide-markup + (equal (get-char-property (point) 'display) "")) + (setq disable-point-adjustment t)))) + ((looking-at markdown-regex-list) + ;; At a list item, special position is after the list marker or checkbox. + (let ((refpos (or (match-end 4) (match-end 3)))) + (if (eq special 'reversed) + (when (and (= (point) origin) (eq last-command this-command)) + (goto-char refpos)) + (when (or (> origin refpos) (<= origin (line-beginning-position))) + (goto-char refpos))))) + ;; No special case, already at beginning of line. + (t nil)))) + +;; This function was originally derived from `org-end-of-line' from org.el. +(defun markdown-end-of-line (&optional n) + "Go to the end of the line, but before ellipsis, if any. + +If this is a headline, and `markdown-special-ctrl-a/e' is not nil +or symbol `reversed', ignore closing tags on the first attempt, +and only move to after the closing tags when the cursor is +already beyond the end of the headline. + +If `markdown-special-ctrl-a/e' is symbol `reversed' then ignore +closing tags on the second attempt. + +With argument N not nil or 1, move forward N - 1 lines first." + (interactive "^p") + (let ((origin (point)) + (special (pcase markdown-special-ctrl-a/e + (`(,_ . ,C-e) C-e) (_ markdown-special-ctrl-a/e))) + deactivate-mark) + ;; First move to a visible line. + (if visual-line-mode + (beginning-of-visual-line n) + (move-beginning-of-line n)) + (cond + ;; At a headline, with closing tags. + ((save-excursion + (forward-line 0) + (and (looking-at markdown-regex-header-atx) (match-end 3))) + (let ((refpos (match-end 2)) + (visual-end (and visual-line-mode + (save-excursion + (end-of-visual-line) + (point))))) + ;; If `end-of-visual-line' brings us before end of line or even closing + ;; tags, i.e., the headline spans over multiple visual lines, move + ;; there. + (cond ((and visual-end + (< visual-end refpos) + (<= origin visual-end)) + (goto-char visual-end)) + ((not special) (end-of-line)) + ((eq special 'reversed) + (if (and (= origin (line-end-position)) + (eq this-command last-command)) + (goto-char refpos) + (end-of-line))) + (t + (if (or (< origin refpos) (>= origin (line-end-position))) + (goto-char refpos) + (end-of-line)))) + ;; Prevent automatic cursor movement caused by the command loop. + ;; Enable disable-point-adjustment to avoid unintended cursor repositioning. + (when (and markdown-hide-markup + (equal (get-char-property (point) 'display) "")) + (setq disable-point-adjustment t)))) + (visual-line-mode + (let ((bol (line-beginning-position))) + (end-of-visual-line) + ;; If `end-of-visual-line' gets us past the ellipsis at the + ;; end of a line, backtrack and use `end-of-line' instead. + (when (/= bol (line-beginning-position)) + (goto-char bol) + (end-of-line)))) + (t (end-of-line))))) + +(defun markdown-beginning-of-defun (&optional arg) + "`beginning-of-defun-function' for Markdown. +This is used to find the beginning of the defun and should behave +like ‘beginning-of-defun’, returning non-nil if it found the +beginning of a defun. It moves the point backward, right before a +heading which defines a defun. When ARG is non-nil, repeat that +many times. When ARG is negative, move forward to the ARG-th +following section." + (or arg (setq arg 1)) + (when (< arg 0) (end-of-line)) + ;; Adjust position for setext headings. + (when (and (thing-at-point-looking-at markdown-regex-header-setext) + (not (= (point) (match-beginning 0))) + (not (markdown-code-block-at-point-p))) + (goto-char (match-end 0))) + (let (found) + ;; Move backward with positive argument. + (while (and (not (bobp)) (> arg 0)) + (setq found nil) + (while (and (not found) + (not (bobp)) + (re-search-backward markdown-regex-header nil 'move)) + (markdown-code-block-at-pos (match-beginning 0)) + (setq found (match-beginning 0))) + (setq arg (1- arg))) + ;; Move forward with negative argument. + (while (and (not (eobp)) (< arg 0)) + (setq found nil) + (while (and (not found) + (not (eobp)) + (re-search-forward markdown-regex-header nil 'move)) + (markdown-code-block-at-pos (match-beginning 0)) + (setq found (match-beginning 0))) + (setq arg (1+ arg))) + (when found + (beginning-of-line) + t))) + +(defun markdown-end-of-defun () + "`end-of-defun-function’ for Markdown. +This is used to find the end of the defun at point. +It is called with no argument, right after calling ‘beginning-of-defun-raw’, +so it can assume that point is at the beginning of the defun body. +It should move point to the first position after the defun." + (or (eobp) (forward-char 1)) + (let (found) + (while (and (not found) + (not (eobp)) + (re-search-forward markdown-regex-header nil 'move)) + (when (not (markdown-code-block-at-pos (match-beginning 0))) + (setq found (match-beginning 0)))) + (when found + (goto-char found) + (skip-syntax-backward "-")))) + +(defun markdown-beginning-of-text-block () + "Move backward to previous beginning of a plain text block. +This function simply looks for blank lines without considering +the surrounding context in light of Markdown syntax. For that, see +`markdown-backward-block'." + (interactive) + (let ((start (point))) + (if (re-search-backward markdown-regex-block-separator nil t) + (goto-char (match-end 0)) + (goto-char (point-min))) + (when (and (= start (point)) (not (bobp))) + (forward-line -1) + (if (re-search-backward markdown-regex-block-separator nil t) + (goto-char (match-end 0)) + (goto-char (point-min)))))) + +(defun markdown-end-of-text-block () + "Move forward to next beginning of a plain text block. +This function simply looks for blank lines without considering +the surrounding context in light of Markdown syntax. For that, see +`markdown-forward-block'." + (interactive) + (beginning-of-line) + (skip-chars-forward " \t\n") + (when (= (point) (point-min)) + (forward-char)) + (if (re-search-forward markdown-regex-block-separator nil t) + (goto-char (match-end 0)) + (goto-char (point-max))) + (skip-chars-backward " \t\n") + (forward-line)) + +(defun markdown-backward-paragraph (&optional arg) + "Move the point to the start of the current paragraph. +With argument ARG, do it ARG times; a negative argument ARG = -N +means move forward N blocks." + (interactive "^p") + (or arg (setq arg 1)) + (if (< arg 0) + (markdown-forward-paragraph (- arg)) + (dotimes (_ arg) + ;; Skip over whitespace in between paragraphs when moving backward. + (skip-chars-backward " \t\n") + (beginning-of-line) + ;; Skip over code block endings. + (when (markdown-range-properties-exist + (line-beginning-position) (line-end-position) + '(markdown-gfm-block-end + markdown-tilde-fence-end)) + (forward-line -1)) + ;; Skip over blank lines inside blockquotes. + (while (and (not (eobp)) + (looking-at markdown-regex-blockquote) + (= (length (match-string 3)) 0)) + (forward-line -1)) + ;; Proceed forward based on the type of block of paragraph. + (let (bounds skip) + (cond + ;; Blockquotes + ((looking-at markdown-regex-blockquote) + (while (and (not (bobp)) + (looking-at markdown-regex-blockquote) + (> (length (match-string 3)) 0)) ;; not blank + (forward-line -1)) + (forward-line)) + ;; List items + ((setq bounds (markdown-cur-list-item-bounds)) + (goto-char (nth 0 bounds))) + ;; Other + (t + (while (and (not (bobp)) + (not skip) + (not (markdown-cur-line-blank-p)) + (not (looking-at markdown-regex-blockquote)) + (not (markdown-range-properties-exist + (line-beginning-position) (line-end-position) + '(markdown-gfm-block-end + markdown-tilde-fence-end)))) + (setq skip (markdown-range-properties-exist + (line-beginning-position) (line-end-position) + '(markdown-gfm-block-begin + markdown-tilde-fence-begin))) + (forward-line -1)) + (unless (bobp) + (forward-line 1)))))))) + +(defun markdown-forward-paragraph (&optional arg) + "Move forward to the next end of a paragraph. +With argument ARG, do it ARG times; a negative argument ARG = -N +means move backward N blocks." + (interactive "^p") + (or arg (setq arg 1)) + (if (< arg 0) + (markdown-backward-paragraph (- arg)) + (dotimes (_ arg) + ;; Skip whitespace in between paragraphs. + (when (markdown-cur-line-blank-p) + (skip-syntax-forward "-") + (beginning-of-line)) + ;; Proceed forward based on the type of block. + (let (bounds skip) + (cond + ;; Blockquotes + ((looking-at markdown-regex-blockquote) + ;; Skip over blank lines inside blockquotes. + (while (and (not (eobp)) + (looking-at markdown-regex-blockquote) + (= (length (match-string 3)) 0)) + (forward-line)) + ;; Move to end of quoted text block + (while (and (not (eobp)) + (looking-at markdown-regex-blockquote) + (> (length (match-string 3)) 0)) ;; not blank + (forward-line))) + ;; List items + ((and (markdown-cur-list-item-bounds) + (setq bounds (markdown-next-list-item-bounds))) + (goto-char (nth 0 bounds))) + ;; Other + (t + (forward-line) + (while (and (not (eobp)) + (not skip) + (not (markdown-cur-line-blank-p)) + (not (looking-at markdown-regex-blockquote)) + (not (markdown-range-properties-exist + (line-beginning-position) (line-end-position) + '(markdown-gfm-block-begin + markdown-tilde-fence-begin)))) + (setq skip (markdown-range-properties-exist + (line-beginning-position) (line-end-position) + '(markdown-gfm-block-end + markdown-tilde-fence-end))) + (forward-line)))))))) + +(defun markdown-backward-block (&optional arg) + "Move the point to the start of the current Markdown block. +Moves across complete code blocks, list items, and blockquotes, +but otherwise stops at blank lines, headers, and horizontal +rules. With argument ARG, do it ARG times; a negative argument +ARG = -N means move forward N blocks." + (interactive "^p") + (or arg (setq arg 1)) + (if (< arg 0) + (markdown-forward-block (- arg)) + (dotimes (_ arg) + ;; Skip over whitespace in between blocks when moving backward, + ;; unless at a block boundary with no whitespace. + (skip-syntax-backward "-") + (beginning-of-line) + ;; Proceed forward based on the type of block. + (cond + ;; Code blocks + ((and (markdown-code-block-at-pos (point)) ;; this line + (markdown-code-block-at-pos (line-beginning-position 0))) ;; previous line + (forward-line -1) + (while (and (markdown-code-block-at-point-p) (not (bobp))) + (forward-line -1)) + (forward-line)) + ;; Headings + ((markdown-heading-at-point) + (goto-char (match-beginning 0))) + ;; Horizontal rules + ((looking-at markdown-regex-hr)) + ;; Blockquotes + ((looking-at markdown-regex-blockquote) + (forward-line -1) + (while (and (looking-at markdown-regex-blockquote) + (not (bobp))) + (forward-line -1)) + (forward-line)) + ;; List items + ((markdown-cur-list-item-bounds) + (markdown-beginning-of-list)) + ;; Other + (t + ;; Move forward in case it is a one line regular paragraph. + (unless (markdown-next-line-blank-p) + (forward-line)) + (unless (markdown-prev-line-blank-p) + (markdown-backward-paragraph))))))) + +(defun markdown-forward-block (&optional arg) + "Move forward to the next end of a Markdown block. +Moves across complete code blocks, list items, and blockquotes, +but otherwise stops at blank lines, headers, and horizontal +rules. With argument ARG, do it ARG times; a negative argument +ARG = -N means move backward N blocks." + (interactive "^p") + (or arg (setq arg 1)) + (if (< arg 0) + (markdown-backward-block (- arg)) + (dotimes (_ arg) + ;; Skip over whitespace in between blocks when moving forward. + (if (markdown-cur-line-blank-p) + (skip-syntax-forward "-") + (beginning-of-line)) + ;; Proceed forward based on the type of block. + (cond + ;; Code blocks + ((markdown-code-block-at-point-p) + (forward-line) + (while (and (markdown-code-block-at-point-p) (not (eobp))) + (forward-line))) + ;; Headings + ((looking-at markdown-regex-header) + (goto-char (or (match-end 4) (match-end 2) (match-end 3))) + (forward-line)) + ;; Horizontal rules + ((looking-at markdown-regex-hr) + (forward-line)) + ;; Blockquotes + ((looking-at markdown-regex-blockquote) + (forward-line) + (while (and (looking-at markdown-regex-blockquote) (not (eobp))) + (forward-line))) + ;; List items + ((markdown-cur-list-item-bounds) + (markdown-end-of-list) + (forward-line)) + ;; Other + (t (markdown-forward-paragraph)))) + (skip-syntax-backward "-") + (unless (eobp) + (forward-char 1)))) + +(defun markdown-backward-page (&optional count) + "Move backward to boundary of the current toplevel section. +With COUNT, repeat, or go forward if negative." + (interactive "p") + (or count (setq count 1)) + (if (< count 0) + (markdown-forward-page (- count)) + (skip-syntax-backward "-") + (or (markdown-back-to-heading-over-code-block t t) + (goto-char (point-min))) + (when (looking-at markdown-regex-header) + (let ((level (markdown-outline-level))) + (when (> level 1) (markdown-up-heading level)) + (when (> count 1) + (condition-case nil + (markdown-backward-same-level (1- count)) + (error (goto-char (point-min))))))))) + +(defun markdown-forward-page (&optional count) + "Move forward to boundary of the current toplevel section. +With COUNT, repeat, or go backward if negative." + (interactive "p") + (or count (setq count 1)) + (if (< count 0) + (markdown-backward-page (- count)) + (if (markdown-back-to-heading-over-code-block t t) + (let ((level (markdown-outline-level))) + (when (> level 1) (markdown-up-heading level)) + (condition-case nil + (markdown-forward-same-level count) + (error (goto-char (point-max))))) + (markdown-next-visible-heading 1)))) + +(defun markdown-next-link () + "Jump to next inline, reference, or wiki link. +If successful, return point. Otherwise, return nil. +See `markdown-wiki-link-p' and `markdown-previous-wiki-link'." + (interactive) + (let ((opoint (point))) + (when (or (markdown-link-p) (markdown-wiki-link-p)) + ;; At a link already, move past it. + (goto-char (+ (match-end 0) 1))) + ;; Search for the next wiki link and move to the beginning. + (while (and (re-search-forward (markdown-make-regex-link-generic) nil t) + (markdown-code-block-at-point-p) + (< (point) (point-max)))) + (if (and (not (eq (point) opoint)) + (or (markdown-link-p) (markdown-wiki-link-p))) + ;; Group 1 will move past non-escape character in wiki link regexp. + ;; Go to beginning of group zero for all other link types. + (goto-char (or (match-beginning 1) (match-beginning 0))) + (goto-char opoint) + nil))) + +(defun markdown-previous-link () + "Jump to previous wiki link. +If successful, return point. Otherwise, return nil. +See `markdown-wiki-link-p' and `markdown-next-wiki-link'." + (interactive) + (let ((opoint (point))) + (while (and (re-search-backward (markdown-make-regex-link-generic) nil t) + (markdown-code-block-at-point-p) + (> (point) (point-min)))) + (if (and (not (eq (point) opoint)) + (or (markdown-link-p) (markdown-wiki-link-p))) + (goto-char (or (match-beginning 1) (match-beginning 0))) + (goto-char opoint) + nil))) + + +;;; Outline =================================================================== + +(defun markdown-move-heading-common (move-fn &optional arg adjust) + "Wrapper for `outline-mode' functions to skip false positives. +MOVE-FN is a function and ARG is its argument. For example, +headings inside preformatted code blocks may match +`outline-regexp' but should not be considered as headings. +When ADJUST is non-nil, adjust the point for interactive calls +to avoid leaving the point at invisible markup. This adjustment +generally should only be done for interactive calls, since other +functions may expect the point to be at the beginning of the +regular expression." + (let ((prev -1) (start (point))) + (if arg (funcall move-fn arg) (funcall move-fn)) + (while (and (/= prev (point)) (markdown-code-block-at-point-p)) + (setq prev (point)) + (if arg (funcall move-fn arg) (funcall move-fn))) + ;; Adjust point for setext headings and invisible text. + (save-match-data + (when (and adjust (thing-at-point-looking-at markdown-regex-header)) + (if markdown-hide-markup + ;; Move to beginning of heading text if markup is hidden. + (goto-char (or (match-beginning 1) (match-beginning 5))) + ;; Move to beginning of markup otherwise. + (goto-char (or (match-beginning 1) (match-beginning 4)))))) + (if (= (point) start) nil (point)))) + +(defun markdown-next-visible-heading (arg) + "Move to the next visible heading line of any level. +With argument, repeats or can move backward if negative. ARG is +passed to `outline-next-visible-heading'." + (interactive "p") + (markdown-move-heading-common #'outline-next-visible-heading arg 'adjust)) + +(defun markdown-previous-visible-heading (arg) + "Move to the previous visible heading line of any level. +With argument, repeats or can move backward if negative. ARG is +passed to `outline-previous-visible-heading'." + (interactive "p") + (markdown-move-heading-common #'outline-previous-visible-heading arg 'adjust)) + +(defun markdown-next-heading () + "Move to the next heading line of any level." + (markdown-move-heading-common #'outline-next-heading)) + +(defun markdown-previous-heading () + "Move to the previous heading line of any level." + (markdown-move-heading-common #'outline-previous-heading)) + +(defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error) + "Move back to the beginning of the previous heading. +Returns t if the point is at a heading, the location if a heading +was found, and nil otherwise. +Only visible heading lines are considered, unless INVISIBLE-OK is +non-nil. Throw an error if there is no previous heading unless +NO-ERROR is non-nil. +Leaves match data intact for `markdown-regex-header'." + (beginning-of-line) + (or (and (markdown-heading-at-point) + (not (markdown-code-block-at-point-p))) + (let (found) + (save-excursion + (while (and (not found) + (re-search-backward markdown-regex-header nil t)) + (when (and (or invisible-ok (not (outline-invisible-p))) + (not (markdown-code-block-at-point-p))) + (setq found (point)))) + (if (not found) + (unless no-error (user-error "Before first heading")) + (setq found (point)))) + (when found (goto-char found))))) + +(defun markdown-forward-same-level (arg) + "Move forward to the ARG'th heading at same level as this one. +Stop at the first and last headings of a superior heading." + (interactive "p") + (markdown-back-to-heading-over-code-block) + (markdown-move-heading-common #'outline-forward-same-level arg 'adjust)) + +(defun markdown-backward-same-level (arg) + "Move backward to the ARG'th heading at same level as this one. +Stop at the first and last headings of a superior heading." + (interactive "p") + (markdown-back-to-heading-over-code-block) + (while (> arg 0) + (let ((point-to-move-to + (save-excursion + (markdown-move-heading-common #'outline-get-last-sibling nil 'adjust)))) + (if point-to-move-to + (progn + (goto-char point-to-move-to) + (setq arg (1- arg))) + (user-error "No previous same-level heading"))))) + +(defun markdown-up-heading (arg &optional interactive) + "Move to the visible heading line of which the present line is a subheading. +With argument, move up ARG levels. When called interactively (or +INTERACTIVE is non-nil), also push the mark." + (interactive "p\np") + (and interactive (not (eq last-command 'markdown-up-heading)) + (push-mark)) + (markdown-move-heading-common #'outline-up-heading arg 'adjust)) + +(defun markdown-back-to-heading (&optional invisible-ok) + "Move to previous heading line, or beg of this line if it's a heading. +Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." + (interactive) + (markdown-move-heading-common #'outline-back-to-heading invisible-ok)) + +(defalias 'markdown-end-of-heading 'outline-end-of-heading) + +(defun markdown-on-heading-p () + "Return non-nil if point is on a heading line." + (get-text-property (line-beginning-position) 'markdown-heading)) + +(defun markdown-end-of-subtree (&optional invisible-OK) + "Move to the end of the current subtree. +Only visible heading lines are considered, unless INVISIBLE-OK is +non-nil. +Derived from `org-end-of-subtree'." + (markdown-back-to-heading invisible-OK) + (let ((first t) + (level (markdown-outline-level))) + (while (and (not (eobp)) + (or first (> (markdown-outline-level) level))) + (setq first nil) + (markdown-next-heading)) + (if (memq (preceding-char) '(?\n ?\^M)) + (progn + ;; Go to end of line before heading + (forward-char -1) + (if (memq (preceding-char) '(?\n ?\^M)) + ;; leave blank line before heading + (forward-char -1))))) + (point)) + +(defun markdown-outline-fix-visibility () + "Hide any false positive headings that should not be shown. +For example, headings inside preformatted code blocks may match +`outline-regexp' but should not be shown as headings when cycling. +Also, the ending --- line in metadata blocks appears to be a +setext header, but should not be folded." + (save-excursion + (goto-char (point-min)) + ;; Unhide any false positives in metadata blocks + (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin) + (let ((body (progn (forward-line) + (markdown-text-property-at-point + 'markdown-yaml-metadata-section)))) + (when body + (let ((end (progn (goto-char (cl-second body)) + (markdown-text-property-at-point + 'markdown-yaml-metadata-end)))) + (outline-flag-region (point-min) (1+ (cl-second end)) nil))))) + ;; Hide any false positives in code blocks + (unless (outline-on-heading-p) + (outline-next-visible-heading 1)) + (while (< (point) (point-max)) + (when (markdown-code-block-at-point-p) + (outline-flag-region (1- (line-beginning-position)) (line-end-position) t)) + (outline-next-visible-heading 1)))) + +(defvar markdown-cycle-global-status 1) +(defvar markdown-cycle-subtree-status nil) + +(defun markdown-next-preface () + (let (finish) + (while (and (not finish) (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") + nil 'move)) + (unless (markdown-code-block-at-point-p) + (goto-char (match-beginning 0)) + (setq finish t)))) + (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp))) + (forward-char -1))) + +(defun markdown-show-entry () + (save-excursion + (outline-back-to-heading t) + (outline-flag-region (1- (point)) + (progn + (markdown-next-preface) + (if (= 1 (- (point-max) (point))) + (point-max) + (point))) + nil))) + +;; This function was originally derived from `org-cycle' from org.el. +(defun markdown-cycle (&optional arg) + "Visibility cycling for Markdown mode. +This function is called with a `\\[universal-argument]' or if ARG is t, perform +global visibility cycling. If the point is at an atx-style header, cycle +visibility of the corresponding subtree. Otherwise, indent the current line + or insert a tab, as appropriate, by calling `indent-for-tab-command'." + (interactive "P") + (cond + + ;; Global cycling + (arg + (cond + ;; Move from overview to contents + ((and (eq last-command this-command) + (eq markdown-cycle-global-status 2)) + (outline-hide-sublevels 1) + (message "CONTENTS") + (setq markdown-cycle-global-status 3) + (markdown-outline-fix-visibility)) + ;; Move from contents to all + ((and (eq last-command this-command) + (eq markdown-cycle-global-status 3)) + (outline-show-all) + (message "SHOW ALL") + (setq markdown-cycle-global-status 1)) + ;; Defaults to overview + (t + (outline-hide-body) + (message "OVERVIEW") + (setq markdown-cycle-global-status 2) + (markdown-outline-fix-visibility)))) + + ;; At a heading: rotate between three different views + ((save-excursion (beginning-of-line 1) (markdown-on-heading-p)) + (markdown-back-to-heading) + (let ((goal-column 0) eoh eol eos) + ;; Determine boundaries + (save-excursion + (markdown-back-to-heading) + (save-excursion + (beginning-of-line 2) + (while (and (not (eobp)) ;; this is like `next-line' + (get-char-property (1- (point)) 'invisible)) + (beginning-of-line 2)) (setq eol (point))) + (markdown-end-of-heading) (setq eoh (point)) + (markdown-end-of-subtree t) + (skip-chars-forward " \t\n") + (beginning-of-line 1) ; in case this is an item + (setq eos (1- (point)))) + ;; Find out what to do next and set `this-command' + (cond + ;; Nothing is hidden behind this heading + ((= eos eoh) + (message "EMPTY ENTRY") + (setq markdown-cycle-subtree-status nil)) + ;; Entire subtree is hidden in one line: open it + ((>= eol eos) + (markdown-show-entry) + (outline-show-children) + (message "CHILDREN") + (setq markdown-cycle-subtree-status 'children)) + ;; We just showed the children, now show everything. + ((and (eq last-command this-command) + (eq markdown-cycle-subtree-status 'children)) + (outline-show-subtree) + (message "SUBTREE") + (setq markdown-cycle-subtree-status 'subtree)) + ;; Default action: hide the subtree. + (t + (outline-hide-subtree) + (message "FOLDED") + (setq markdown-cycle-subtree-status 'folded))))) + + ;; In a table, move forward by one cell + ((markdown-table-at-point-p) + (call-interactively #'markdown-table-forward-cell)) + + ;; Otherwise, indent as appropriate + (t + (indent-for-tab-command)))) + +(defun markdown-shifttab () + "Handle S-TAB keybinding based on context. +When in a table, move backward one cell. +Otherwise, cycle global heading visibility by calling +`markdown-cycle' with argument t." + (interactive) + (cond ((markdown-table-at-point-p) + (call-interactively #'markdown-table-backward-cell)) + (t (markdown-cycle t)))) + +(defun markdown-outline-level () + "Return the depth to which a statement is nested in the outline." + (cond + ((and (match-beginning 0) + (markdown-code-block-at-pos (match-beginning 0))) + 7) ;; Only 6 header levels are defined. + ((match-end 2) 1) + ((match-end 3) 2) + ((match-end 4) + (length (markdown-trim-whitespace (match-string-no-properties 4)))))) + +(defun markdown-promote-subtree (&optional arg) + "Promote the current subtree of ATX headings. +Note that Markdown does not support heading levels higher than +six and therefore level-six headings will not be promoted +further. If ARG is non-nil promote the heading, otherwise +demote." + (interactive "*P") + (save-excursion + (when (and (or (thing-at-point-looking-at markdown-regex-header-atx) + (re-search-backward markdown-regex-header-atx nil t)) + (not (markdown-code-block-at-point-p))) + (let ((level (length (match-string 1))) + (promote-or-demote (if arg 1 -1)) + (remove 't)) + (markdown-cycle-atx promote-or-demote remove) + (catch 'end-of-subtree + (while (and (markdown-next-heading) + (looking-at markdown-regex-header-atx)) + ;; Exit if this not a higher level heading; promote otherwise. + (if (and (looking-at markdown-regex-header-atx) + (<= (length (match-string-no-properties 1)) level)) + (throw 'end-of-subtree nil) + (markdown-cycle-atx promote-or-demote remove)))))))) + +(defun markdown-demote-subtree () + "Demote the current subtree of ATX headings." + (interactive) + (markdown-promote-subtree t)) + +(defun markdown-move-subtree-up () + "Move the current subtree of ATX headings up." + (interactive) + (outline-move-subtree-up 1)) + +(defun markdown-move-subtree-down () + "Move the current subtree of ATX headings down." + (interactive) + (outline-move-subtree-down 1)) + +(defun markdown-outline-next () + "Move to next list item, when in a list, or next visible heading." + (interactive) + (let ((bounds (markdown-next-list-item-bounds))) + (if bounds + (goto-char (nth 0 bounds)) + (markdown-next-visible-heading 1)))) + +(defun markdown-outline-previous () + "Move to previous list item, when in a list, or previous visible heading." + (interactive) + (let ((bounds (markdown-prev-list-item-bounds))) + (if bounds + (goto-char (nth 0 bounds)) + (markdown-previous-visible-heading 1)))) + +(defun markdown-outline-next-same-level () + "Move to next list item or heading of same level." + (interactive) + (let ((bounds (markdown-cur-list-item-bounds))) + (if bounds + (markdown-next-list-item (nth 3 bounds)) + (markdown-forward-same-level 1)))) + +(defun markdown-outline-previous-same-level () + "Move to previous list item or heading of same level." + (interactive) + (let ((bounds (markdown-cur-list-item-bounds))) + (if bounds + (markdown-prev-list-item (nth 3 bounds)) + (markdown-backward-same-level 1)))) + +(defun markdown-outline-up () + "Move to previous list item, when in a list, or previous heading." + (interactive) + (unless (markdown-up-list) + (markdown-up-heading 1))) + + +;;; Marking and Narrowing ===================================================== + +(defun markdown-mark-paragraph () + "Put mark at end of this block, point at beginning. +The block marked is the one that contains point or follows point. + +Interactively, if this command is repeated or (in Transient Mark +mode) if the mark is active, it marks the next block after the +ones already marked." + (interactive) + (if (or (and (eq last-command this-command) (mark t)) + (and transient-mark-mode mark-active)) + (set-mark + (save-excursion + (goto-char (mark)) + (markdown-forward-paragraph) + (point))) + (let ((beginning-of-defun-function #'markdown-backward-paragraph) + (end-of-defun-function #'markdown-forward-paragraph)) + (mark-defun)))) + +(defun markdown-mark-block () + "Put mark at end of this block, point at beginning. +The block marked is the one that contains point or follows point. + +Interactively, if this command is repeated or (in Transient Mark +mode) if the mark is active, it marks the next block after the +ones already marked." + (interactive) + (if (or (and (eq last-command this-command) (mark t)) + (and transient-mark-mode mark-active)) + (set-mark + (save-excursion + (goto-char (mark)) + (markdown-forward-block) + (point))) + (let ((beginning-of-defun-function #'markdown-backward-block) + (end-of-defun-function #'markdown-forward-block)) + (mark-defun)))) + +(defun markdown-narrow-to-block () + "Make text outside current block invisible. +The current block is the one that contains point or follows point." + (interactive) + (let ((beginning-of-defun-function #'markdown-backward-block) + (end-of-defun-function #'markdown-forward-block)) + (narrow-to-defun))) + +(defun markdown-mark-text-block () + "Put mark at end of this plain text block, point at beginning. +The block marked is the one that contains point or follows point. + +Interactively, if this command is repeated or (in Transient Mark +mode) if the mark is active, it marks the next block after the +ones already marked." + (interactive) + (if (or (and (eq last-command this-command) (mark t)) + (and transient-mark-mode mark-active)) + (set-mark + (save-excursion + (goto-char (mark)) + (markdown-end-of-text-block) + (point))) + (let ((beginning-of-defun-function #'markdown-beginning-of-text-block) + (end-of-defun-function #'markdown-end-of-text-block)) + (mark-defun)))) + +(defun markdown-mark-page () + "Put mark at end of this top level section, point at beginning. +The top level section marked is the one that contains point or +follows point. + +Interactively, if this command is repeated or (in Transient Mark +mode) if the mark is active, it marks the next page after the +ones already marked." + (interactive) + (if (or (and (eq last-command this-command) (mark t)) + (and transient-mark-mode mark-active)) + (set-mark + (save-excursion + (goto-char (mark)) + (markdown-forward-page) + (point))) + (let ((beginning-of-defun-function #'markdown-backward-page) + (end-of-defun-function #'markdown-forward-page)) + (mark-defun)))) + +(defun markdown-narrow-to-page () + "Make text outside current top level section invisible. +The current section is the one that contains point or follows point." + (interactive) + (let ((beginning-of-defun-function #'markdown-backward-page) + (end-of-defun-function #'markdown-forward-page)) + (narrow-to-defun))) + +(defun markdown-mark-subtree () + "Mark the current subtree. +This puts point at the start of the current subtree, and mark at the end." + (interactive) + (let ((beg)) + (if (markdown-heading-at-point) + (beginning-of-line) + (markdown-previous-visible-heading 1)) + (setq beg (point)) + (markdown-end-of-subtree) + (push-mark (point) nil t) + (goto-char beg))) + +(defun markdown-narrow-to-subtree () + "Narrow buffer to the current subtree." + (interactive) + (save-excursion + (save-match-data + (narrow-to-region + (progn (markdown-back-to-heading-over-code-block t) (point)) + (progn (markdown-end-of-subtree) + (if (and (markdown-heading-at-point) (not (eobp))) + (backward-char 1)) + (point)))))) + + +;;; Generic Structure Editing, Completion, and Cycling Commands =============== + +(defun markdown-move-up () + "Move thing at point up. +When in a list item, call `markdown-move-list-item-up'. +When in a table, call `markdown-table-move-row-up'. +Otherwise, move the current heading subtree up with +`markdown-move-subtree-up'." + (interactive) + (cond + ((markdown-list-item-at-point-p) + (call-interactively #'markdown-move-list-item-up)) + ((markdown-table-at-point-p) + (call-interactively #'markdown-table-move-row-up)) + (t + (call-interactively #'markdown-move-subtree-up)))) + +(defun markdown-move-down () + "Move thing at point down. +When in a list item, call `markdown-move-list-item-down'. +Otherwise, move the current heading subtree up with +`markdown-move-subtree-down'." + (interactive) + (cond + ((markdown-list-item-at-point-p) + (call-interactively #'markdown-move-list-item-down)) + ((markdown-table-at-point-p) + (call-interactively #'markdown-table-move-row-down)) + (t + (call-interactively #'markdown-move-subtree-down)))) + +(defun markdown-promote () + "Promote or move element at point to the left. +Depending on the context, this function will promote a heading or +list item at the point, move a table column to the left, or cycle +markup." + (interactive) + (let (bounds) + (cond + ;; Promote atx heading subtree + ((thing-at-point-looking-at markdown-regex-header-atx) + (markdown-promote-subtree)) + ;; Promote setext heading + ((thing-at-point-looking-at markdown-regex-header-setext) + (markdown-cycle-setext -1)) + ;; Promote horizontal rule + ((thing-at-point-looking-at markdown-regex-hr) + (markdown-cycle-hr -1)) + ;; Promote list item + ((setq bounds (markdown-cur-list-item-bounds)) + (markdown-promote-list-item bounds)) + ;; Move table column to the left + ((markdown-table-at-point-p) + (call-interactively #'markdown-table-move-column-left)) + ;; Promote bold + ((thing-at-point-looking-at markdown-regex-bold) + (markdown-cycle-bold)) + ;; Promote italic + ((thing-at-point-looking-at markdown-regex-italic) + (markdown-cycle-italic)) + (t + (user-error "Nothing to promote at point"))))) + +(defun markdown-demote () + "Demote or move element at point to the right. +Depending on the context, this function will demote a heading or +list item at the point, move a table column to the right, or cycle +or remove markup." + (interactive) + (let (bounds) + (cond + ;; Demote atx heading subtree + ((thing-at-point-looking-at markdown-regex-header-atx) + (markdown-demote-subtree)) + ;; Demote setext heading + ((thing-at-point-looking-at markdown-regex-header-setext) + (markdown-cycle-setext 1)) + ;; Demote horizontal rule + ((thing-at-point-looking-at markdown-regex-hr) + (markdown-cycle-hr 1)) + ;; Demote list item + ((setq bounds (markdown-cur-list-item-bounds)) + (markdown-demote-list-item bounds)) + ;; Move table column to the right + ((markdown-table-at-point-p) + (call-interactively #'markdown-table-move-column-right)) + ;; Demote bold + ((thing-at-point-looking-at markdown-regex-bold) + (markdown-cycle-bold)) + ;; Demote italic + ((thing-at-point-looking-at markdown-regex-italic) + (markdown-cycle-italic)) + (t + (user-error "Nothing to demote at point"))))) + + +;;; Commands ================================================================== + +(defun markdown (&optional output-buffer-name) + "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME. +The output buffer name defaults to `markdown-output-buffer-name'. +Return the name of the output buffer used." + (interactive) + (save-window-excursion + (let* ((commands (cond ((stringp markdown-command) (split-string markdown-command)) + ((listp markdown-command) markdown-command))) + (command (car-safe commands)) + (command-args (cdr-safe commands)) + begin-region end-region) + (if (use-region-p) + (setq begin-region (region-beginning) + end-region (region-end)) + (setq begin-region (point-min) + end-region (point-max))) + + (unless output-buffer-name + (setq output-buffer-name markdown-output-buffer-name)) + (when (and (stringp command) (not (executable-find command))) + (user-error "Markdown command %s is not found" command)) + (let ((exit-code + (cond + ;; Handle case when `markdown-command' does not read from stdin + ((and (stringp command) markdown-command-needs-filename) + (if (not buffer-file-name) + (user-error "Must be visiting a file") + ;; Don’t use ‘shell-command’ because it’s not guaranteed to + ;; return the exit code of the process. + (let ((command (if (listp markdown-command) + (string-join markdown-command " ") + markdown-command))) + (shell-command-on-region + ;; Pass an empty region so that stdin is empty. + (point) (point) + (concat command " " + (shell-quote-argument buffer-file-name)) + output-buffer-name)))) + ;; Pass region to `markdown-command' via stdin + (t + (let ((buf (get-buffer-create output-buffer-name))) + (with-current-buffer buf + (setq buffer-read-only nil) + (erase-buffer)) + (if (stringp command) + (if (not (null command-args)) + (apply #'call-process-region begin-region end-region command nil buf nil command-args) + (call-process-region begin-region end-region command nil buf)) + (if markdown-command-needs-filename + (if (not buffer-file-name) + (user-error "Must be visiting a file") + (funcall markdown-command begin-region end-region buf buffer-file-name)) + (funcall markdown-command begin-region end-region buf)) + ;; If the ‘markdown-command’ function didn’t signal an + ;; error, assume it succeeded by binding ‘exit-code’ to 0. + 0)))))) + ;; The exit code can be a signal description string, so don’t use ‘=’ + ;; or ‘zerop’. + (unless (eq exit-code 0) + (user-error "%s failed with exit code %s" + markdown-command exit-code)))) + output-buffer-name)) + +(defun markdown-standalone (&optional output-buffer-name) + "Special function to provide standalone HTML output. +Insert the output in the buffer named OUTPUT-BUFFER-NAME." + (interactive) + (setq output-buffer-name (markdown output-buffer-name)) + (let ((css-path markdown-css-paths)) + (with-current-buffer output-buffer-name + (set-buffer output-buffer-name) + (setq-local markdown-css-paths css-path) + (unless (markdown-output-standalone-p) + (markdown-add-xhtml-header-and-footer output-buffer-name)) + (goto-char (point-min)) + (html-mode))) + output-buffer-name) + +(defun markdown-other-window (&optional output-buffer-name) + "Run `markdown-command' on current buffer and display in other window. +When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with +that name." + (interactive) + (markdown-display-buffer-other-window + (markdown-standalone output-buffer-name))) + +(defun markdown-output-standalone-p () + "Determine whether `markdown-command' output is standalone XHTML. +Standalone XHTML output is identified by an occurrence of +`markdown-xhtml-standalone-regexp' in the first five lines of output." + (save-excursion + (goto-char (point-min)) + (save-match-data + (re-search-forward + markdown-xhtml-standalone-regexp + (save-excursion (goto-char (point-min)) (forward-line 4) (point)) + t)))) + +(defun markdown-stylesheet-link-string (stylesheet-path) + (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\"" + (expand-file-name stylesheet-path) + "\" />")) + +(defun markdown-escape-title (title) + "Escape a minimum set of characters in TITLE so they don't clash with html." + (replace-regexp-in-string ">" ">" + (replace-regexp-in-string "<" "<" + (replace-regexp-in-string "&" "&" title)))) + +(defun markdown-add-xhtml-header-and-footer (title) + "Wrap XHTML header and footer with given TITLE around current buffer." + (goto-char (point-min)) + (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n" + "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n" + "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n" + "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n" + "<head>\n<title>") + (insert (markdown-escape-title title)) + (insert "</title>\n") + (unless (= (length markdown-content-type) 0) + (insert + (format + "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n" + markdown-content-type + (or (and markdown-coding-system + (coding-system-get markdown-coding-system + 'mime-charset)) + (coding-system-get buffer-file-coding-system + 'mime-charset) + "utf-8")))) + (if (> (length markdown-css-paths) 0) + (insert (mapconcat #'markdown-stylesheet-link-string + markdown-css-paths "\n"))) + (when (> (length markdown-xhtml-header-content) 0) + (insert markdown-xhtml-header-content)) + (insert "\n</head>\n\n" + "<body>\n\n") + (when (> (length markdown-xhtml-body-preamble) 0) + (insert markdown-xhtml-body-preamble "\n")) + (goto-char (point-max)) + (when (> (length markdown-xhtml-body-epilogue) 0) + (insert "\n" markdown-xhtml-body-epilogue)) + (insert "\n" + "</body>\n" + "</html>\n")) + +(defun markdown-preview (&optional output-buffer-name) + "Run `markdown-command' on the current buffer and view output in browser. +When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with +that name." + (interactive) + (browse-url-of-buffer + (markdown-standalone (or output-buffer-name markdown-output-buffer-name)))) + +(defun markdown-export-file-name (&optional extension) + "Attempt to generate a filename for Markdown output. +The file extension will be EXTENSION if given, or .html by default. +If the current buffer is visiting a file, we construct a new +output filename based on that filename. Otherwise, return nil." + (when (buffer-file-name) + (unless extension + (setq extension ".html")) + (let ((candidate + (concat + (cond + ((buffer-file-name) + (file-name-sans-extension (buffer-file-name))) + (t (buffer-name))) + extension))) + (cond + ((equal candidate (buffer-file-name)) + (concat candidate extension)) + (t + candidate))))) + +(defun markdown-export (&optional output-file) + "Run Markdown on the current buffer, save to file, and return the filename. +If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename +generated by `markdown-export-file-name', which will be constructed using the +current filename, but with the extension removed and replaced with .html." + (interactive) + (unless output-file + (setq output-file (markdown-export-file-name ".html"))) + (when output-file + (let* ((init-buf (current-buffer)) + (init-point (point)) + (init-buf-string (buffer-string)) + (output-buffer (find-file-noselect output-file)) + (output-buffer-name (buffer-name output-buffer))) + (run-hooks 'markdown-before-export-hook) + (markdown-standalone output-buffer-name) + (with-current-buffer output-buffer + (run-hooks 'markdown-after-export-hook) + (save-buffer) + (when markdown-export-kill-buffer (kill-buffer))) + ;; if modified, restore initial buffer + (when (buffer-modified-p init-buf) + (erase-buffer) + (insert init-buf-string) + (save-buffer) + (goto-char init-point)) + output-file))) + +(defun markdown-export-and-preview () + "Export to XHTML using `markdown-export' and browse the resulting file." + (interactive) + (browse-url-of-file (markdown-export))) + +(defvar-local markdown-live-preview-buffer nil + "Buffer used to preview markdown output in `markdown-live-preview-export'.") + +(defvar-local markdown-live-preview-source-buffer nil + "Source buffer from which current buffer was generated. +This is the inverse of `markdown-live-preview-buffer'.") + +(defvar markdown-live-preview-currently-exporting nil) + +(defun markdown-live-preview-get-filename () + "Standardize the filename exported by `markdown-live-preview-export'." + (markdown-export-file-name ".html")) + +(defun markdown-live-preview-window-eww (file) + "Preview FILE with eww. +To be used with `markdown-live-preview-window-function'." + (when (and (bound-and-true-p eww-auto-rename-buffer) + markdown-live-preview-buffer) + (kill-buffer markdown-live-preview-buffer)) + (eww-open-file file) + ;; #737 if `eww-auto-rename-buffer' is non-nil, the buffer name is not "*eww*" + ;; Try to find the buffer whose name ends with "eww*" + (if (bound-and-true-p eww-auto-rename-buffer) + (cl-loop for buf in (buffer-list) + when (string-match-p "eww\\*\\'" (buffer-name buf)) + return buf) + (get-buffer "*eww*"))) + +(defun markdown-visual-lines-between-points (beg end) + (save-excursion + (goto-char beg) + (cl-loop with count = 0 + while (progn (end-of-visual-line) + (and (< (point) end) (line-move-visual 1 t))) + do (cl-incf count) + finally return count))) + +(defun markdown-live-preview-window-serialize (buf) + "Get window point and scroll data for all windows displaying BUF." + (when (buffer-live-p buf) + (with-current-buffer buf + (mapcar + (lambda (win) + (with-selected-window win + (let* ((start (window-start)) + (pt (window-point)) + (pt-or-sym (cond ((= pt (point-min)) 'min) + ((= pt (point-max)) 'max) + (t pt))) + (diff (markdown-visual-lines-between-points + start pt))) + (list win pt-or-sym diff)))) + (get-buffer-window-list buf))))) + +(defun markdown-get-point-back-lines (pt num-lines) + (save-excursion + (goto-char pt) + (line-move-visual (- num-lines) t) + ;; in testing, can occasionally overshoot the number of lines to traverse + (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt))) + (when (> actual-num-lines num-lines) + (line-move-visual (- actual-num-lines num-lines) t))) + (point))) + +(defun markdown-live-preview-window-deserialize (window-posns) + "Apply window point and scroll data from WINDOW-POSNS. +WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'." + (cl-destructuring-bind (win pt-or-sym diff) window-posns + (when (window-live-p win) + (with-current-buffer markdown-live-preview-buffer + (set-window-buffer win (current-buffer)) + (cl-destructuring-bind (actual-pt actual-diff) + (cl-case pt-or-sym + (min (list (point-min) 0)) + (max (list (point-max) diff)) + (t (list pt-or-sym diff))) + (set-window-start + win (markdown-get-point-back-lines actual-pt actual-diff)) + (set-window-point win actual-pt)))))) + +(defun markdown-live-preview-export () + "Export to XHTML using `markdown-export'. +Browse the resulting file within Emacs using +`markdown-live-preview-window-function' Return the buffer +displaying the rendered output." + (interactive) + (let ((filename (markdown-live-preview-get-filename))) + (when filename + (let* ((markdown-live-preview-currently-exporting t) + (cur-buf (current-buffer)) + (export-file (markdown-export filename)) + ;; get positions in all windows currently displaying output buffer + (window-data + (markdown-live-preview-window-serialize + markdown-live-preview-buffer))) + (save-window-excursion + (let ((output-buffer + (funcall markdown-live-preview-window-function export-file))) + (with-current-buffer output-buffer + (setq markdown-live-preview-source-buffer cur-buf) + (add-hook 'kill-buffer-hook + #'markdown-live-preview-remove-on-kill t t)) + (with-current-buffer cur-buf + (setq markdown-live-preview-buffer output-buffer)))) + (with-current-buffer cur-buf + ;; reset all windows displaying output buffer to where they were, + ;; now with the new output + (mapc #'markdown-live-preview-window-deserialize window-data) + ;; delete html editing buffer + (let ((buf (get-file-buffer export-file))) (when buf (kill-buffer buf))) + (when (and export-file (file-exists-p export-file) + (eq markdown-live-preview-delete-export + 'delete-on-export)) + (delete-file export-file)) + markdown-live-preview-buffer))))) + +(defun markdown-live-preview-remove () + (when (buffer-live-p markdown-live-preview-buffer) + (kill-buffer markdown-live-preview-buffer)) + (setq markdown-live-preview-buffer nil) + ;; if set to 'delete-on-export, the output has already been deleted + (when (eq markdown-live-preview-delete-export 'delete-on-destroy) + (let ((outfile-name (markdown-live-preview-get-filename))) + (when (and outfile-name (file-exists-p outfile-name)) + (delete-file outfile-name))))) + +(defun markdown-get-other-window () + "Find another window to display preview or output content." + (cond + ((memq markdown-split-window-direction '(vertical below)) + (or (window-in-direction 'below) (split-window-vertically))) + ((memq markdown-split-window-direction '(horizontal right)) + (or (window-in-direction 'right) (split-window-horizontally))) + (t (split-window-sensibly (get-buffer-window))))) + +(defun markdown-display-buffer-other-window (buf) + "Display preview or output buffer BUF in another window." + (if (and display-buffer-alist (eq markdown-split-window-direction 'any)) + (display-buffer buf) + (let ((cur-buf (current-buffer)) + (window (markdown-get-other-window))) + (set-window-buffer window buf) + (set-buffer cur-buf)))) + +(defun markdown-live-preview-if-markdown () + (when (and (derived-mode-p 'markdown-mode) + markdown-live-preview-mode) + (unless markdown-live-preview-currently-exporting + (if (buffer-live-p markdown-live-preview-buffer) + (markdown-live-preview-export) + (markdown-display-buffer-other-window + (markdown-live-preview-export)))))) + +(defun markdown-live-preview-remove-on-kill () + (cond ((and (derived-mode-p 'markdown-mode) + markdown-live-preview-mode) + (markdown-live-preview-remove)) + (markdown-live-preview-source-buffer + (with-current-buffer markdown-live-preview-source-buffer + (setq markdown-live-preview-buffer nil)) + (setq markdown-live-preview-source-buffer nil)))) + +(defun markdown-live-preview-switch-to-output () + "Turn on `markdown-live-preview-mode' and switch to output buffer. +The output buffer is opened in another window." + (interactive) + (if markdown-live-preview-mode + (markdown-display-buffer-other-window (markdown-live-preview-export))) + (markdown-live-preview-mode)) + +(defun markdown-live-preview-re-export () + "Re-export the current live previewed content. +If the current buffer is a buffer displaying the exported version of a +`markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and +update this buffer's contents." + (interactive) + (when markdown-live-preview-source-buffer + (with-current-buffer markdown-live-preview-source-buffer + (markdown-live-preview-export)))) + +(defun markdown-open () + "Open file for the current buffer with `markdown-open-command'." + (interactive) + (unless markdown-open-command + (user-error "Variable `markdown-open-command' must be set")) + (if (stringp markdown-open-command) + (if (not buffer-file-name) + (user-error "Must be visiting a file") + (save-buffer) + (let ((exit-code (call-process markdown-open-command nil nil nil + buffer-file-name))) + ;; The exit code can be a signal description string, so don’t use ‘=’ + ;; or ‘zerop’. + (unless (eq exit-code 0) + (user-error "%s failed with exit code %s" + markdown-open-command exit-code)))) + (funcall markdown-open-command)) + nil) + +(defun markdown-kill-ring-save () + "Run Markdown on file and store output in the kill ring." + (interactive) + (save-window-excursion + (markdown) + (with-current-buffer markdown-output-buffer-name + (kill-ring-save (point-min) (point-max))))) + + +;;; Links ===================================================================== + +(defun markdown-backward-to-link-start () + "Backward link start position if current position is in link title." + ;; Issue #305 + (when (eq (get-text-property (point) 'face) 'markdown-link-face) + (skip-chars-backward "^[") + (forward-char -1))) + +(defun markdown-link-p () + "Return non-nil when `point' is at a non-wiki link. +See `markdown-wiki-link-p' for more information." + (save-excursion + (let ((case-fold-search nil)) + (when (and (not (markdown-wiki-link-p)) (not (markdown-code-block-at-point-p))) + (markdown-backward-to-link-start) + (or (thing-at-point-looking-at markdown-regex-link-inline) + (thing-at-point-looking-at markdown-regex-link-reference) + (thing-at-point-looking-at markdown-regex-uri) + (thing-at-point-looking-at markdown-regex-angle-uri)))))) + +(defun markdown-link-at-pos (pos) + "Return properties of link or image at position POS. +Value is a list of elements describing the link: + 0. beginning position + 1. end position + 2. link text + 3. URL + 4. reference label + 5. title text + 6. bang (nil or \"!\")" + (save-excursion + (goto-char pos) + (markdown-backward-to-link-start) + (let (begin end text url reference title bang) + (cond + ;; Inline image or link at point. + ((thing-at-point-looking-at markdown-regex-link-inline) + (setq bang (match-string-no-properties 1) + begin (match-beginning 0) + text (match-string-no-properties 3) + url (match-string-no-properties 6)) + ;; consider nested parentheses + ;; if link target contains parentheses, (match-end 0) isn't correct end position of the link + (let* ((close-pos (scan-sexps (match-beginning 5) 1)) + (destination-part (string-trim (buffer-substring-no-properties (1+ (match-beginning 5)) (1- close-pos))))) + (setq end close-pos) + ;; A link can contain spaces if it is wrapped with angle brackets + (cond ((string-match "\\`<\\(.+\\)>\\'" destination-part) + (setq url (match-string-no-properties 1 destination-part))) + ((string-match "\\([^ ]+\\)\\s-+\\(.+\\)" destination-part) + (setq url (match-string-no-properties 1 destination-part) + title (substring (match-string-no-properties 2 destination-part) 1 -1))) + (t (setq url destination-part))) + (setq url (url-unhex-string url)))) + ;; Reference link at point. + ((thing-at-point-looking-at markdown-regex-link-reference) + (setq bang (match-string-no-properties 1) + begin (match-beginning 0) + end (match-end 0) + text (match-string-no-properties 3)) + (when (char-equal (char-after (match-beginning 5)) ?\[) + (setq reference (match-string-no-properties 6)))) + ;; Angle bracket URI at point. + ((thing-at-point-looking-at markdown-regex-angle-uri) + (setq begin (match-beginning 0) + end (match-end 0) + url (match-string-no-properties 2))) + ;; Plain URI at point. + ((thing-at-point-looking-at markdown-regex-uri) + (setq begin (match-beginning 0) + end (match-end 0) + url (match-string-no-properties 1)))) + (list begin end text url reference title bang)))) + +(defun markdown-link-url () + "Return the URL part of the regular (non-wiki) link at point. +Works with both inline and reference style links, and with images. +If point is not at a link or the link reference is not defined +returns nil." + (let* ((values (markdown-link-at-pos (point))) + (text (nth 2 values)) + (url (nth 3 values)) + (ref (nth 4 values))) + (or url (and ref (car (markdown-reference-definition + (downcase (if (string= ref "") text ref)))))))) + +(defun markdown--browse-url (url) + (let* ((struct (url-generic-parse-url url)) + (full (url-fullness struct)) + (file url)) + ;; Parse URL, determine fullness, strip query string + (setq file (car (url-path-and-query struct))) + ;; Open full URLs in browser, files in Emacs + (if full + (browse-url url) + (when (and file (> (length file) 0)) + (let ((link-file (funcall markdown-translate-filename-function file))) + (if (and markdown-open-image-command (string-match-p (image-file-name-regexp) link-file)) + (if (functionp markdown-open-image-command) + (funcall markdown-open-image-command link-file) + (process-file markdown-open-image-command nil nil nil link-file)) + (find-file link-file))))))) + +(defun markdown-follow-link-at-point (&optional event) + "Open the non-wiki link at point or EVENT. +If the link is a complete URL, open in browser with `browse-url'. +Otherwise, open with `find-file' after stripping anchor and/or query string. +Translate filenames using `markdown-filename-translate-function'." + (interactive (list last-command-event)) + (if event (posn-set-point (event-start event))) + (if (markdown-link-p) + (or (run-hook-with-args-until-success 'markdown-follow-link-functions (markdown-link-url)) + (markdown--browse-url (markdown-link-url))) + (user-error "Point is not at a Markdown link or URL"))) + +(defun markdown-fontify-inline-links (last) + "Add text properties to next inline link from point to LAST." + (when (markdown-match-generic-links last nil) + (let* ((link-start (match-beginning 3)) + (link-end (match-end 3)) + (url-start (match-beginning 6)) + (url-end (match-end 6)) + (url (match-string-no-properties 6)) + (title-start (match-beginning 7)) + (title-end (match-end 7)) + (title (match-string-no-properties 7)) + ;; Markup part + (mp (list 'invisible 'markdown-markup + 'rear-nonsticky t + 'font-lock-multiline t)) + ;; Link part (without face) + (lp (list 'keymap markdown-mode-mouse-map + 'mouse-face 'markdown-highlight-face + 'font-lock-multiline t + 'help-echo (if title (concat title "\n" url) url))) + ;; URL part + (up (list 'keymap markdown-mode-mouse-map + 'invisible 'markdown-markup + 'mouse-face 'markdown-highlight-face + 'font-lock-multiline t)) + ;; URL composition character + (url-char (markdown--first-displayable markdown-url-compose-char)) + ;; Title part + (tp (list 'invisible 'markdown-markup + 'font-lock-multiline t))) + (dolist (g '(1 2 4 5 8)) + (when (match-end g) + (add-text-properties (match-beginning g) (match-end g) mp) + (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face))) + ;; Preserve existing faces applied to link part (e.g., inline code) + (when link-start + (add-text-properties link-start link-end lp) + (add-face-text-property link-start link-end 'markdown-link-face)) + (when url-start + (add-text-properties url-start url-end up) + (add-face-text-property url-start url-end 'markdown-url-face)) + (when title-start + (add-text-properties url-end title-end tp) + (add-face-text-property url-end title-end 'markdown-link-title-face)) + (when (and markdown-hide-urls url-start) + (compose-region url-start (or title-end url-end) url-char)) + t))) + +(defun markdown-fontify-reference-links (last) + "Add text properties to next reference link from point to LAST." + (when (markdown-match-generic-links last t) + (let* ((link-start (match-beginning 3)) + (link-end (match-end 3)) + (ref-start (match-beginning 6)) + (ref-end (match-end 6)) + ;; Markup part + (mp (list 'invisible 'markdown-markup + 'rear-nonsticky t + 'font-lock-multiline t)) + ;; Link part + (lp (list 'keymap markdown-mode-mouse-map + 'mouse-face 'markdown-highlight-face + 'font-lock-multiline t + 'help-echo (lambda (_ __ pos) + (save-match-data + (save-excursion + (goto-char pos) + (or (markdown-link-url) + "Undefined reference")))))) + ;; URL composition character + (url-char (markdown--first-displayable markdown-url-compose-char)) + ;; Reference part + (rp (list 'invisible 'markdown-markup + 'font-lock-multiline t))) + (dolist (g '(1 2 4 5 8)) + (when (match-end g) + (add-text-properties (match-beginning g) (match-end g) mp) + (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face))) + (when link-start + (add-text-properties link-start link-end lp) + (add-face-text-property link-start link-end 'markdown-link-face)) + (when ref-start + (add-text-properties ref-start ref-end rp) + (add-face-text-property ref-start ref-end 'markdown-reference-face) + (when (and markdown-hide-urls (> (- ref-end ref-start) 2)) + (compose-region ref-start ref-end url-char))) + t))) + +(defun markdown-fontify-angle-uris (last) + "Add text properties to angle URIs from point to LAST." + (when (markdown-match-angle-uris last) + (let* ((url-start (match-beginning 2)) + (url-end (match-end 2)) + ;; Markup part + (mp (list 'face 'markdown-markup-face + 'invisible 'markdown-markup + 'rear-nonsticky t + 'font-lock-multiline t)) + ;; URI part + (up (list 'keymap markdown-mode-mouse-map + 'face 'markdown-plain-url-face + 'mouse-face 'markdown-highlight-face + 'font-lock-multiline t))) + (dolist (g '(1 3)) + (add-text-properties (match-beginning g) (match-end g) mp)) + (add-text-properties url-start url-end up) + t))) + +(defun markdown-fontify-plain-uris (last) + "Add text properties to plain URLs from point to LAST." + (when (markdown-match-plain-uris last) + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (props (list 'keymap markdown-mode-mouse-map + 'face 'markdown-plain-url-face + 'mouse-face 'markdown-highlight-face + 'rear-nonsticky t + 'font-lock-multiline t))) + (add-text-properties start end props) + t))) + +(defun markdown-toggle-url-hiding (&optional arg) + "Toggle the display or hiding of URLs. +With a prefix argument ARG, enable URL hiding if ARG is positive, +and disable it otherwise." + (interactive (list (or current-prefix-arg 'toggle))) + (setq markdown-hide-urls + (if (eq arg 'toggle) + (not markdown-hide-urls) + (> (prefix-numeric-value arg) 0))) + (when (called-interactively-p 'interactive) + (message "markdown-mode URL hiding %s" (if markdown-hide-urls "enabled" "disabled"))) + (markdown-reload-extensions)) + + +;;; Wiki Links ================================================================ + +(defun markdown-wiki-link-p () + "Return non-nil if wiki links are enabled and `point' is at a true wiki link. +A true wiki link name matches `markdown-regex-wiki-link' but does +not match the current file name after conversion. This modifies +the data returned by `match-data'. Note that the potential wiki +link name must be available via `match-string'." + (when markdown-enable-wiki-links + (let ((case-fold-search nil)) + (and (thing-at-point-looking-at markdown-regex-wiki-link) + (not (markdown-code-block-at-point-p)) + (or (not buffer-file-name) + (not (string-equal (buffer-file-name) + (markdown-convert-wiki-link-to-filename + (markdown-wiki-link-link))))))))) + +(defun markdown-wiki-link-link () + "Return the link part of the wiki link using current match data. +The location of the link component depends on the value of +`markdown-wiki-link-alias-first'." + (if markdown-wiki-link-alias-first + (or (match-string-no-properties 5) (match-string-no-properties 3)) + (match-string-no-properties 3))) + +(defun markdown-wiki-link-alias () + "Return the alias or text part of the wiki link using current match data. +The location of the alias component depends on the value of +`markdown-wiki-link-alias-first'." + (if markdown-wiki-link-alias-first + (match-string-no-properties 3) + (or (match-string-no-properties 5) (match-string-no-properties 3)))) + +(defun markdown--wiki-link-search-types () + (let ((ret (and markdown-wiki-link-search-type + (cl-copy-list markdown-wiki-link-search-type)))) + (when (and markdown-wiki-link-search-subdirectories + (not (memq 'sub-directories markdown-wiki-link-search-type))) + (push 'sub-directories ret)) + (when (and markdown-wiki-link-search-parent-directories + (not (memq 'parent-directories markdown-wiki-link-search-type))) + (push 'parent-directories ret)) + ret)) + +(defun markdown--project-root () + (or (cl-loop for dir in '(".git" ".hg" ".svn") + when (locate-dominating-file default-directory dir) + return it) + (progn + (require 'project) + (let ((project (project-current t))) + (with-no-warnings + (if (fboundp 'project-root) + (project-root project) + (car (project-roots project)))))))) + +(defun markdown-convert-wiki-link-to-filename (name) + "Generate a filename from the wiki link NAME. +Spaces in NAME are replaced with `markdown-link-space-sub-char'. +When in `gfm-mode', follow GitHub's conventions where [[Test Test]] +and [[test test]] both map to Test-test.ext. Look in the current +directory first, then in subdirectories if +`markdown-wiki-link-search-subdirectories' is non-nil, and then +in parent directories if +`markdown-wiki-link-search-parent-directories' is non-nil." + (save-match-data + ;; This function must not overwrite match data(PR #590) + (let* ((basename (replace-regexp-in-string + "[[:space:]\n]" markdown-link-space-sub-char name)) + (basename (if (derived-mode-p 'gfm-mode) + (concat (upcase (substring basename 0 1)) + (downcase (substring basename 1 nil))) + basename)) + (search-types (markdown--wiki-link-search-types)) + directory extension default candidates dir) + (when buffer-file-name + (setq directory (file-name-directory buffer-file-name) + extension (file-name-extension buffer-file-name))) + (setq default (concat basename + (when extension (concat "." extension)))) + (cond + ;; Look in current directory first. + ((or (null buffer-file-name) + (file-exists-p default)) + default) + ;; Possibly search in subdirectories, next. + ((and (memq 'sub-directories search-types) + (setq candidates + (directory-files-recursively + directory (concat "^" default "$")))) + (car candidates)) + ;; Possibly search in parent directories as a last resort. + ((and (memq 'parent-directories search-types) + (setq dir (locate-dominating-file directory default))) + (concat dir default)) + ((and (memq 'project search-types) + (setq candidates + (directory-files-recursively + (markdown--project-root) (concat "^" default "$")))) + (car candidates)) + ;; If nothing is found, return default in current directory. + (t default))))) + +(defun markdown-follow-wiki-link (name &optional other) + "Follow the wiki link NAME. +Convert the name to a file name and call `find-file'. Ensure that +the new buffer remains in `markdown-mode'. Open the link in another +window when OTHER is non-nil." + (let ((filename (markdown-convert-wiki-link-to-filename name)) + (wp (when buffer-file-name + (file-name-directory buffer-file-name)))) + (if (not wp) + (user-error "Must be visiting a file") + (when other (other-window 1)) + (let ((default-directory wp)) + (find-file filename))) + (unless (derived-mode-p 'markdown-mode) + (markdown-mode)))) + +(defun markdown-follow-wiki-link-at-point (&optional arg) + "Find Wiki Link at point. +With prefix argument ARG, open the file in other window. +See `markdown-wiki-link-p' and `markdown-follow-wiki-link'." + (interactive "P") + (if (markdown-wiki-link-p) + (markdown-follow-wiki-link (markdown-wiki-link-link) arg) + (user-error "Point is not at a Wiki Link"))) + +(defun markdown-highlight-wiki-link (from to face) + "Highlight the wiki link in the region between FROM and TO using FACE." + (put-text-property from to 'font-lock-face face)) + +(defun markdown-unfontify-region-wiki-links (from to) + "Remove wiki link faces from the region specified by FROM and TO." + (interactive "*r") + (let ((modified (buffer-modified-p))) + (remove-text-properties from to '(font-lock-face markdown-link-face)) + (remove-text-properties from to '(font-lock-face markdown-missing-link-face)) + ;; remove-text-properties marks the buffer modified in emacs 24.3, + ;; undo that if it wasn't originally marked modified + (set-buffer-modified-p modified))) + +(defun markdown-fontify-region-wiki-links (from to) + "Search region given by FROM and TO for wiki links and fontify them. +If a wiki link is found check to see if the backing file exists +and highlight accordingly." + (goto-char from) + (save-match-data + (while (re-search-forward markdown-regex-wiki-link to t) + (when (not (markdown-code-block-at-point-p)) + (let ((highlight-beginning (match-beginning 1)) + (highlight-end (match-end 1)) + (file-name + (markdown-convert-wiki-link-to-filename + (markdown-wiki-link-link)))) + (if (condition-case nil (file-exists-p file-name) (error nil)) + (markdown-highlight-wiki-link + highlight-beginning highlight-end 'markdown-link-face) + (markdown-highlight-wiki-link + highlight-beginning highlight-end 'markdown-missing-link-face))))))) + +(defun markdown-extend-changed-region (from to) + "Extend region given by FROM and TO so that we can fontify all links. +The region is extended to the first newline before and the first +newline after." + ;; start looking for the first new line before 'from + (goto-char from) + (re-search-backward "\n" nil t) + (let ((new-from (point-min)) + (new-to (point-max))) + (if (not (= (point) from)) + (setq new-from (point))) + ;; do the same thing for the first new line after 'to + (goto-char to) + (re-search-forward "\n" nil t) + (if (not (= (point) to)) + (setq new-to (point))) + (cl-values new-from new-to))) + +(defun markdown-check-change-for-wiki-link (from to) + "Check region between FROM and TO for wiki links and re-fontify as needed." + (interactive "*r") + (let* ((modified (buffer-modified-p)) + (buffer-undo-list t) + (inhibit-read-only t) + deactivate-mark + buffer-file-truename) + (unwind-protect + (save-excursion + (save-match-data + (save-restriction + (cursor-intangible-mode +1) ;; inhibit-point-motion-hooks is obsoleted since Emacs 29 + ;; Extend the region to fontify so that it starts + ;; and ends at safe places. + (cl-multiple-value-bind (new-from new-to) + (markdown-extend-changed-region from to) + (goto-char new-from) + ;; Only refontify when the range contains text with a + ;; wiki link face or if the wiki link regexp matches. + (when (or (markdown-range-property-any + new-from new-to 'font-lock-face + '(markdown-link-face markdown-missing-link-face)) + (re-search-forward + markdown-regex-wiki-link new-to t)) + ;; Unfontify existing fontification (start from scratch) + (markdown-unfontify-region-wiki-links new-from new-to) + ;; Now do the fontification. + (markdown-fontify-region-wiki-links new-from new-to)))))) + (cursor-intangible-mode -1) + (and (not modified) + (buffer-modified-p) + (set-buffer-modified-p nil))))) + +(defun markdown-check-change-for-wiki-link-after-change (from to _) + "Check region between FROM and TO for wiki links and re-fontify as needed. +Designed to be used with the `after-change-functions' hook." + (markdown-check-change-for-wiki-link from to)) + +(defun markdown-fontify-buffer-wiki-links () + "Refontify all wiki links in the buffer." + (interactive) + (markdown-check-change-for-wiki-link (point-min) (point-max))) + +(defun markdown-toggle-wiki-links (&optional arg) + "Toggle support for wiki links. +With a prefix argument ARG, enable wiki link support if ARG is positive, +and disable it otherwise." + (interactive (list (or current-prefix-arg 'toggle))) + (setq markdown-enable-wiki-links + (if (eq arg 'toggle) + (not markdown-enable-wiki-links) + (> (prefix-numeric-value arg) 0))) + (when (called-interactively-p 'interactive) + (message "markdown-mode wiki link support %s" (if markdown-enable-wiki-links "enabled" "disabled"))) + (markdown-reload-extensions)) + +(defun markdown-setup-wiki-link-hooks () + "Add or remove hooks for fontifying wiki links. +These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil." + ;; Anytime text changes make sure it gets fontified correctly + (if (and markdown-enable-wiki-links + markdown-wiki-link-fontify-missing) + (add-hook 'after-change-functions + #'markdown-check-change-for-wiki-link-after-change t t) + (remove-hook 'after-change-functions + #'markdown-check-change-for-wiki-link-after-change t)) + ;; If we left the buffer there is a really good chance we were + ;; creating one of the wiki link documents. Make sure we get + ;; refontified when we come back. + (if (and markdown-enable-wiki-links + markdown-wiki-link-fontify-missing) + (progn + (add-hook 'window-configuration-change-hook + #'markdown-fontify-buffer-wiki-links t t) + (markdown-fontify-buffer-wiki-links)) + (remove-hook 'window-configuration-change-hook + #'markdown-fontify-buffer-wiki-links t) + (markdown-unfontify-region-wiki-links (point-min) (point-max)))) + + +;;; Following & Doing ========================================================= + +(defun markdown-follow-thing-at-point (arg) + "Follow thing at point if possible, such as a reference link or wiki link. +Opens inline and reference links in a browser. Opens wiki links +to other files in the current window, or the another window if +ARG is non-nil. +See `markdown-follow-link-at-point' and +`markdown-follow-wiki-link-at-point'." + (interactive "P") + (cond ((markdown-link-p) + (markdown-follow-link-at-point)) + ((markdown-wiki-link-p) + (markdown-follow-wiki-link-at-point arg)) + (t + (let* ((values (markdown-link-at-pos (point))) + (url (nth 3 values))) + (unless url + (user-error "Nothing to follow at point")) + (markdown--browse-url url))))) + +(defun markdown-do () + "Do something sensible based on context at point. +Jumps between reference links and definitions; between footnote +markers and footnote text." + (interactive) + (cond + ;; Footnote definition + ((markdown-footnote-text-positions) + (markdown-footnote-return)) + ;; Footnote marker + ((markdown-footnote-marker-positions) + (markdown-footnote-goto-text)) + ;; Reference link + ((thing-at-point-looking-at markdown-regex-link-reference) + (markdown-reference-goto-definition)) + ;; Reference definition + ((thing-at-point-looking-at markdown-regex-reference-definition) + (markdown-reference-goto-link (match-string-no-properties 2))) + ;; Link + ((or (markdown-link-p) (markdown-wiki-link-p)) + (markdown-follow-thing-at-point nil)) + ;; GFM task list item + ((markdown-gfm-task-list-item-at-point) + (markdown-toggle-gfm-checkbox)) + ;; Align table + ((markdown-table-at-point-p) + (call-interactively #'markdown-table-align)) + ;; Otherwise + (t + (markdown-insert-gfm-checkbox)))) + + +;;; Miscellaneous ============================================================= + +(defun markdown-compress-whitespace-string (str) + "Compress whitespace in STR and return result. +Leading and trailing whitespace is removed. Sequences of multiple +spaces, tabs, and newlines are replaced with single spaces." + (replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" "" + (replace-regexp-in-string "[ \t\n]+" " " str))) + +(defun markdown--substitute-command-keys (string) + "Like `substitute-command-keys' but, but prefers control characters. +First pass STRING to `substitute-command-keys' and then +substitute `C-i` for `TAB` and `C-m` for `RET`." + (replace-regexp-in-string + "\\<TAB\\>" "C-i" + (replace-regexp-in-string + "\\<RET\\>" "C-m" (substitute-command-keys string) t) t)) + +(defun markdown-line-number-at-pos (&optional pos) + "Return (narrowed) buffer line number at position POS. +If POS is nil, use current buffer location. +This is an exact copy of `line-number-at-pos' for use in emacs21." + (let ((opoint (or pos (point))) start) + (save-excursion + (goto-char (point-min)) + (setq start (point)) + (goto-char opoint) + (forward-line 0) + (1+ (count-lines start (point)))))) + +(defun markdown-inside-link-p () + "Return t if point is within a link." + (save-match-data + (thing-at-point-looking-at (markdown-make-regex-link-generic)))) + +(defun markdown-line-is-reference-definition-p () + "Return whether the current line is a (non-footnote) reference definition." + (save-excursion + (move-beginning-of-line 1) + (and (looking-at-p markdown-regex-reference-definition) + (not (looking-at-p "[ \t]*\\[^"))))) + +(defun markdown-adaptive-fill-function () + "Return prefix for filling paragraph or nil if not determined." + (cond + ;; List item inside blockquote + ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+") + (replace-regexp-in-string + "[0-9\\.*+-]" " " (match-string-no-properties 0))) + ;; Blockquote + ((looking-at markdown-regex-blockquote) + (buffer-substring-no-properties (match-beginning 0) (match-end 2))) + ;; List items + ((looking-at markdown-regex-list) + (match-string-no-properties 0)) + ;; Footnote definition + ((looking-at-p markdown-regex-footnote-definition) + " ") ; four spaces + ;; No match + (t nil))) + +(defun markdown-fill-paragraph (&optional justify) + "Fill paragraph at or after point. +This function is like \\[fill-paragraph], but it skips Markdown +code blocks. If the point is in a code block, or just before one, +do not fill. Otherwise, call `fill-paragraph' as usual. If +JUSTIFY is non-nil, justify text as well. Since this function +handles filling itself, it always returns t so that +`fill-paragraph' doesn't run." + (interactive "P") + (unless (or (markdown-code-block-at-point-p) + (save-excursion + (back-to-indentation) + (skip-syntax-forward "-") + (markdown-code-block-at-point-p))) + (let ((fill-prefix (save-excursion + (goto-char (line-beginning-position)) + (when (looking-at "\\([ \t]*>[ \t]*\\(?:>[ \t]*\\)+\\)") + (match-string-no-properties 1))))) + (fill-paragraph justify))) + t) + +(defun markdown-fill-forward-paragraph (&optional arg) + "Function used by `fill-paragraph' to move over ARG paragraphs. +This is a `fill-forward-paragraph-function' for `markdown-mode'. +It is called with a single argument specifying the number of +paragraphs to move. Just like `forward-paragraph', it should +return the number of paragraphs left to move." + (or arg (setq arg 1)) + (if (> arg 0) + ;; With positive ARG, move across ARG non-code-block paragraphs, + ;; one at a time. When passing a code block, don't decrement ARG. + (while (and (not (eobp)) + (> arg 0) + (= (forward-paragraph 1) 0) + (or (markdown-code-block-at-pos (line-beginning-position 0)) + (setq arg (1- arg))))) + ;; Move backward by one paragraph with negative ARG (always -1). + (let ((start (point))) + (setq arg (forward-paragraph arg)) + (while (and (not (eobp)) + (progn (move-to-left-margin) (not (eobp))) + (looking-at-p paragraph-separate)) + (forward-line 1)) + (cond + ;; Move point past whitespace following list marker. + ((looking-at markdown-regex-list) + (goto-char (match-end 0))) + ;; Move point past whitespace following pipe at beginning of line + ;; to handle Pandoc line blocks. + ((looking-at "^|\\s-*") + (goto-char (match-end 0))) + ;; Return point if the paragraph passed was a code block. + ((markdown-code-block-at-pos (line-beginning-position 2)) + (goto-char start))))) + arg) + +(defun markdown--inhibit-electric-quote () + "Function added to `electric-quote-inhibit-functions'. +Return non-nil if the quote has been inserted inside a code block +or span." + (let ((pos (1- (point)))) + (or (markdown-inline-code-at-pos pos) + (markdown-code-block-at-pos pos)))) + + +;;; Extension Framework ======================================================= + +(defun markdown-reload-extensions () + "Check settings, update font-lock keywords and hooks, and re-fontify buffer." + (interactive) + (when (derived-mode-p 'markdown-mode) + ;; Refontify buffer + (font-lock-flush) + ;; Add or remove hooks related to extensions + (markdown-setup-wiki-link-hooks))) + +(defun markdown-handle-local-variables () + "Run in `hack-local-variables-hook' to update font lock rules. +Checks to see if there is actually a ‘markdown-mode’ file local variable +before regenerating font-lock rules for extensions." + (when (or (assoc 'markdown-enable-wiki-links file-local-variables-alist) + (assoc 'markdown-enable-math file-local-variables-alist)) + (when (assoc 'markdown-enable-math file-local-variables-alist) + (markdown-toggle-math markdown-enable-math)) + (markdown-reload-extensions))) + + +;;; Math Support ============================================================== + +(defconst markdown-mode-font-lock-keywords-math + (list + ;; Equation reference (eq:foo) + '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" . ((1 markdown-markup-face) + (2 markdown-reference-face) + (3 markdown-markup-face))) + ;; Equation reference \eqref{foo} + '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" . ((1 markdown-markup-face) + (2 markdown-reference-face) + (3 markdown-markup-face)))) + "Font lock keywords to add and remove when toggling math support.") + +(defun markdown-toggle-math (&optional arg) + "Toggle support for inline and display LaTeX math expressions. +With a prefix argument ARG, enable math mode if ARG is positive, +and disable it otherwise. If called from Lisp, enable the mode +if ARG is omitted or nil." + (interactive (list (or current-prefix-arg 'toggle))) + (setq markdown-enable-math + (if (eq arg 'toggle) + (not markdown-enable-math) + (> (prefix-numeric-value arg) 0))) + (if markdown-enable-math + (font-lock-add-keywords + 'markdown-mode markdown-mode-font-lock-keywords-math) + (font-lock-remove-keywords + 'markdown-mode markdown-mode-font-lock-keywords-math)) + (when (called-interactively-p 'interactive) + (message "markdown-mode math support %s" (if markdown-enable-math "enabled" "disabled"))) + (markdown-reload-extensions)) + + +;;; GFM Checkboxes ============================================================ + +(define-button-type 'markdown-gfm-checkbox-button + 'follow-link t + 'face 'markdown-gfm-checkbox-face + 'mouse-face 'markdown-highlight-face + 'action #'markdown-toggle-gfm-checkbox-button) + +(defun markdown-gfm-task-list-item-at-point (&optional bounds) + "Return non-nil if there is a GFM task list item at the point. +Optionally, the list item BOUNDS may be given if available, as +returned by `markdown-cur-list-item-bounds'. When a task list item +is found, the return value is the same value returned by +`markdown-cur-list-item-bounds'." + (unless bounds + (setq bounds (markdown-cur-list-item-bounds))) + (> (length (nth 5 bounds)) 0)) + +(defun markdown-insert-gfm-checkbox () + "Add GFM checkbox at point. +Returns t if added. +Returns nil if non-applicable." + (interactive) + (let ((bounds (markdown-cur-list-item-bounds))) + (if bounds + (unless (cl-sixth bounds) + (let ((pos (+ (cl-first bounds) (cl-fourth bounds))) + (markup "[ ] ")) + (if (< pos (point)) + (save-excursion + (goto-char pos) + (insert markup)) + (goto-char pos) + (insert markup)) + (syntax-propertize (+ (cl-second bounds) 4)) + t)) + (unless (save-excursion + (back-to-indentation) + (or (markdown-list-item-at-point-p) + (markdown-heading-at-point) + (markdown-in-comment-p) + (markdown-code-block-at-point-p))) + (let ((pos (save-excursion + (back-to-indentation) + (point))) + (markup (concat (or (save-excursion + (beginning-of-line 0) + (cl-fifth (markdown-cur-list-item-bounds))) + markdown-unordered-list-item-prefix) + "[ ] "))) + (if (< pos (point)) + (save-excursion + (goto-char pos) + (insert markup)) + (goto-char pos) + (insert markup)) + (syntax-propertize (line-end-position)) + t))))) + +(defun markdown-toggle-gfm-checkbox () + "Toggle GFM checkbox at point. +Returns the resulting status as a string, either \"[x]\" or \"[ ]\". +Returns nil if there is no task list item at the point." + (interactive) + (save-match-data + (save-excursion + (let ((bounds (markdown-cur-list-item-bounds))) + (when bounds + ;; Move to beginning of task list item + (goto-char (cl-first bounds)) + ;; Advance to column of first non-whitespace after marker + (forward-char (cl-fourth bounds)) + (cond ((looking-at "\\[ \\]") + (replace-match + (if markdown-gfm-uppercase-checkbox "[X]" "[x]") + nil t) + (match-string-no-properties 0)) + ((looking-at "\\[[xX]\\]") + (replace-match "[ ]" nil t) + (match-string-no-properties 0)))))))) + +(defun markdown-toggle-gfm-checkbox-button (button) + "Toggle GFM checkbox BUTTON on click." + (save-match-data + (save-excursion + (goto-char (button-start button)) + (markdown-toggle-gfm-checkbox)))) + +(defun markdown-make-gfm-checkboxes-buttons (start end) + "Make GFM checkboxes buttons in region between START and END." + (save-excursion + (goto-char start) + (let ((case-fold-search t)) + (save-excursion + (while (re-search-forward markdown-regex-gfm-checkbox end t) + (make-button (match-beginning 1) (match-end 1) + :type 'markdown-gfm-checkbox-button)))))) + +;; Called when any modification is made to buffer text. +(defun markdown-gfm-checkbox-after-change-function (beg end _) + "Add to `after-change-functions' to setup GFM checkboxes as buttons. +BEG and END are the limits of scanned region." + (save-excursion + (save-match-data + ;; Rescan between start of line from `beg' and start of line after `end'. + (markdown-make-gfm-checkboxes-buttons + (progn (goto-char beg) (beginning-of-line) (point)) + (progn (goto-char end) (forward-line 1) (point)))))) + +(defun markdown-remove-gfm-checkbox-overlays () + "Remove all GFM checkbox overlays in buffer." + (save-excursion + (save-restriction + (widen) + (remove-overlays nil nil 'face 'markdown-gfm-checkbox-face)))) + + +;;; Display inline image ====================================================== + +(defvar-local markdown-inline-image-overlays nil) + +(defun markdown-remove-inline-images () + "Remove inline image overlays from image links in the buffer. +This can be toggled with `markdown-toggle-inline-images' +or \\[markdown-toggle-inline-images]." + (interactive) + (mapc #'delete-overlay markdown-inline-image-overlays) + (setq markdown-inline-image-overlays nil) + (when (fboundp 'clear-image-cache) (clear-image-cache))) + +(defcustom markdown-display-remote-images nil + "If non-nil, download and display remote images. +See also `markdown-inline-image-overlays'. + +Only image URLs specified with a protocol listed in +`markdown-remote-image-protocols' are displayed." + :group 'markdown + :type 'boolean) + +(defcustom markdown-remote-image-protocols '("https") + "List of protocols to use to download remote images. +See also `markdown-display-remote-images'." + :group 'markdown + :type '(repeat string)) + +(defvar markdown--remote-image-cache + (make-hash-table :test 'equal) + "A map from URLs to image paths.") + +(defun markdown--get-remote-image (url) + "Retrieve the image path for a given URL." + (or (gethash url markdown--remote-image-cache) + (let ((dl-path (make-temp-file "markdown-mode--image"))) + (require 'url) + (url-copy-file url dl-path t) + (puthash url dl-path markdown--remote-image-cache)))) + +(defun markdown-display-inline-images () + "Add inline image overlays to image links in the buffer. +This can be toggled with `markdown-toggle-inline-images' +or \\[markdown-toggle-inline-images]." + (interactive) + (unless (display-images-p) + (error "Cannot show images")) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward markdown-regex-link-inline nil t) + (let* ((start (match-beginning 0)) + (imagep (match-beginning 1)) + (end (match-end 0)) + (file (match-string-no-properties 6))) + (when (and imagep + (not (zerop (length file)))) + (unless (file-exists-p file) + (let* ((download-file (funcall markdown-translate-filename-function file)) + (valid-url (ignore-errors + (member (downcase (url-type (url-generic-parse-url download-file))) + markdown-remote-image-protocols)))) + (if (and markdown-display-remote-images valid-url) + (setq file (markdown--get-remote-image download-file)) + (when (not valid-url) + ;; strip query parameter + (setq file (replace-regexp-in-string "?.+\\'" "" file)) + (unless (file-exists-p file) + (setq file (url-unhex-string file))))))) + (when (file-exists-p file) + (let* ((abspath (if (file-name-absolute-p file) + file + (concat default-directory file))) + (image + (cond ((and markdown-max-image-size + (image-type-available-p 'imagemagick)) + (create-image + abspath 'imagemagick nil + :max-width (car markdown-max-image-size) + :max-height (cdr markdown-max-image-size))) + (markdown-max-image-size + (create-image abspath nil nil + :max-width (car markdown-max-image-size) + :max-height (cdr markdown-max-image-size))) + (t (create-image abspath))))) + (when image + (let ((ov (make-overlay start end))) + (overlay-put ov 'display image) + (overlay-put ov 'face 'default) + (push ov markdown-inline-image-overlays))))))))))) + +(defun markdown-toggle-inline-images () + "Toggle inline image overlays in the buffer." + (interactive) + (if markdown-inline-image-overlays + (markdown-remove-inline-images) + (markdown-display-inline-images))) + + +;;; GFM Code Block Fontification ============================================== + +(defcustom markdown-fontify-code-blocks-natively nil + "When non-nil, fontify code in code blocks using the native major mode. +This only works for fenced code blocks where the language is +specified where we can automatically determine the appropriate +mode to use. The language to mode mapping may be customized by +setting the variable `markdown-code-lang-modes'." + :group 'markdown + :type 'boolean + :safe #'booleanp + :package-version '(markdown-mode . "2.3")) + +(defcustom markdown-fontify-code-block-default-mode nil + "Default mode to use to fontify code blocks. +This mode is used when automatic detection fails, such as for GFM +code blocks with no language specified." + :group 'markdown + :type '(choice function (const :tag "None" nil)) + :package-version '(markdown-mode . "2.4")) + +(defun markdown-toggle-fontify-code-blocks-natively (&optional arg) + "Toggle the native fontification of code blocks. +With a prefix argument ARG, enable if ARG is positive, +and disable otherwise." + (interactive (list (or current-prefix-arg 'toggle))) + (setq markdown-fontify-code-blocks-natively + (if (eq arg 'toggle) + (not markdown-fontify-code-blocks-natively) + (> (prefix-numeric-value arg) 0))) + (when (called-interactively-p 'interactive) + (message "markdown-mode native code block fontification %s" + (if markdown-fontify-code-blocks-natively "enabled" "disabled"))) + (markdown-reload-extensions)) + +;; This is based on `org-src-lang-modes' from org-src.el +(defcustom markdown-code-lang-modes + '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode) + ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode) + ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode) + ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode) + ("bash" . sh-mode)) + "Alist mapping languages to their major mode. +The key is the language name, the value is the major mode. For +many languages this is simple, but for language where this is not +the case, this variable provides a way to simplify things on the +user side. For example, there is no ocaml-mode in Emacs, but the +mode to use is `tuareg-mode'." + :group 'markdown + :type '(repeat + (cons + (string "Language name") + (symbol "Major mode"))) + :package-version '(markdown-mode . "2.3")) + +(defun markdown-get-lang-mode (lang) + "Return major mode that should be used for LANG. +LANG is a string, and the returned major mode is a symbol." + (cl-find-if + #'markdown--lang-mode-predicate + (nconc (list (cdr (assoc lang markdown-code-lang-modes)) + (cdr (assoc (downcase lang) markdown-code-lang-modes))) + (and (fboundp 'treesit-language-available-p) + (list (and (treesit-language-available-p (intern lang)) + (intern (concat lang "-ts-mode"))) + (and (treesit-language-available-p (intern (downcase lang))) + (intern (concat (downcase lang) "-ts-mode"))))) + (list + (intern (concat lang "-mode")) + (intern (concat (downcase lang) "-mode")))))) + +(defun markdown--lang-mode-predicate (mode) + (and mode + (fboundp mode) + (or + ;; https://github.com/jrblevin/markdown-mode/issues/787 + ;; major-mode-remap-alist was introduced at Emacs 29.1 + (cl-loop for pair in (bound-and-true-p major-mode-remap-alist) + for func = (cdr pair) + thereis (and (atom func) (eq mode func))) + ;; https://github.com/jrblevin/markdown-mode/issues/761 + (cl-loop for pair in auto-mode-alist + for func = (cdr pair) + thereis (and (atom func) (eq mode func)))))) + +(defun markdown-fontify-code-blocks-generic (matcher last) + "Add text properties to next code block from point to LAST. +Use matching function MATCHER." + (when (funcall matcher last) + (save-excursion + (save-match-data + (let* ((start (match-beginning 0)) + (end (match-end 0)) + ;; Find positions outside opening and closing backquotes. + (bol-prev (progn (goto-char start) + (if (bolp) (line-beginning-position 0) (line-beginning-position)))) + (eol-next (progn (goto-char end) + (if (bolp) (line-beginning-position 2) (line-beginning-position 3)))) + lang) + (if (and markdown-fontify-code-blocks-natively + (or (setq lang (markdown-code-block-lang)) + markdown-fontify-code-block-default-mode)) + (markdown-fontify-code-block-natively lang start end) + (add-text-properties start end '(face markdown-pre-face))) + ;; Set background for block as well as opening and closing lines. + (font-lock-append-text-property + bol-prev eol-next 'face 'markdown-code-face) + ;; Set invisible property for lines before and after, including newline. + (add-text-properties bol-prev start '(invisible markdown-markup)) + (add-text-properties end eol-next '(invisible markdown-markup))))) + t)) + +(defun markdown-fontify-gfm-code-blocks (last) + "Add text properties to next GFM code block from point to LAST." + (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last)) + +(defun markdown-fontify-fenced-code-blocks (last) + "Add text properties to next tilde fenced code block from point to LAST." + (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last)) + +;; Based on `org-src-font-lock-fontify-block' from org-src.el. +(defun markdown-fontify-code-block-natively (lang start end) + "Fontify given GFM or fenced code block. +This function is called by Emacs for automatic fontification when +`markdown-fontify-code-blocks-natively' is non-nil. LANG is the +language used in the block. START and END specify the block +position." + (let ((lang-mode (if lang (markdown-get-lang-mode lang) + markdown-fontify-code-block-default-mode))) + (when (fboundp lang-mode) + (let ((string (buffer-substring-no-properties start end)) + (modified (buffer-modified-p)) + (markdown-buffer (current-buffer)) pos next) + (remove-text-properties start end '(face nil)) + (with-current-buffer + (get-buffer-create + (format " *markdown-code-fontification:%s*" (symbol-name lang-mode))) + ;; Make sure that modification hooks are not inhibited in + ;; the org-src-fontification buffer in case we're called + ;; from `jit-lock-function' (Bug#25132). + (let ((inhibit-modification-hooks nil)) + (delete-region (point-min) (point-max)) + (insert string " ")) ;; so there's a final property change + (unless (eq major-mode lang-mode) (funcall lang-mode)) + (font-lock-ensure) + (setq pos (point-min)) + (while (setq next (next-single-property-change pos 'face)) + (let ((val (get-text-property pos 'face))) + (when val + (put-text-property + (+ start (1- pos)) (1- (+ start next)) 'face + val markdown-buffer))) + (setq pos next))) + (add-text-properties + start end + '(font-lock-fontified t fontified t font-lock-multiline t)) + (set-buffer-modified-p modified))))) + +(require 'edit-indirect nil t) +(defvar edit-indirect-guess-mode-function) +(defvar edit-indirect-after-commit-functions) + +(defun markdown--edit-indirect-after-commit-function (beg end) + "Corrective logic run on code block content from lines BEG to END. +Restores code block indentation from BEG to END, and ensures trailing newlines +at the END of code blocks." + ;; ensure trailing newlines + (goto-char end) + (unless (eq (char-before) ?\n) + (insert "\n")) + ;; restore code block indentation + (goto-char (- beg 1)) + (let ((block-indentation (current-indentation))) + (when (> block-indentation 0) + (indent-rigidly beg end block-indentation))) + (font-lock-ensure)) + +(defun markdown-edit-code-block () + "Edit Markdown code block in an indirect buffer." + (interactive) + (save-excursion + (if (fboundp 'edit-indirect-region) + (let* ((bounds (markdown-get-enclosing-fenced-block-construct)) + (begin (and bounds (not (null (nth 0 bounds))) (goto-char (nth 0 bounds)) (line-beginning-position 2))) + (end (and bounds(not (null (nth 1 bounds))) (goto-char (nth 1 bounds)) (line-beginning-position 1)))) + (if (and begin end) + (let* ((indentation (and (goto-char (nth 0 bounds)) (current-indentation))) + (lang (markdown-code-block-lang)) + (mode (or (and lang (markdown-get-lang-mode lang)) + markdown-edit-code-block-default-mode)) + (edit-indirect-guess-mode-function + (lambda (_parent-buffer _beg _end) + (funcall mode))) + (indirect-buf (edit-indirect-region begin end 'display-buffer))) + ;; reset `sh-shell' when indirect buffer + (when (and (not (member system-type '(ms-dos windows-nt))) + (member mode '(shell-script-mode sh-mode)) + (member lang (append + (mapcar (lambda (e) (symbol-name (car e))) + sh-ancestor-alist) + '("csh" "rc" "sh")))) + (with-current-buffer indirect-buf + (sh-set-shell lang))) + (when (> indentation 0) ;; un-indent in edit-indirect buffer + (with-current-buffer indirect-buf + (indent-rigidly (point-min) (point-max) (- indentation))))) + (user-error "Not inside a GFM or tilde fenced code block"))) + (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ") + (progn (package-refresh-contents) + (package-install 'edit-indirect) + (markdown-edit-code-block)))))) + + +;;; Table Editing ============================================================= + +;; These functions were originally adapted from `org-table.el'. + +;; General helper functions + +(defmacro markdown--with-gensyms (symbols &rest body) + (declare (debug (sexp body)) (indent 1)) + `(let ,(mapcar (lambda (s) + `(,s (make-symbol (concat "--" (symbol-name ',s))))) + symbols) + ,@body)) + +(defun markdown--split-string (string &optional separators) + "Splits STRING into substrings at SEPARATORS. +SEPARATORS is a regular expression. If nil it defaults to +`split-string-default-separators'. This version returns no empty +strings if there are matches at the beginning and end of string." + (let ((start 0) notfirst list) + (while (and (string-match + (or separators split-string-default-separators) + string + (if (and notfirst + (= start (match-beginning 0)) + (< start (length string))) + (1+ start) start)) + (< (match-beginning 0) (length string))) + (setq notfirst t) + (or (eq (match-beginning 0) 0) + (and (eq (match-beginning 0) (match-end 0)) + (eq (match-beginning 0) start)) + (push (substring string start (match-beginning 0)) list)) + (setq start (match-end 0))) + (or (eq start (length string)) + (push (substring string start) list)) + (nreverse list))) + +(defun markdown--string-width (s) + "Return width of string S. +This version ignores characters with invisibility property +`markdown-markup'." + (let (b) + (when (or (eq t buffer-invisibility-spec) + (member 'markdown-markup buffer-invisibility-spec)) + (while (setq b (text-property-any + 0 (length s) + 'invisible 'markdown-markup s)) + (setq s (concat + (substring s 0 b) + (substring s (or (next-single-property-change + b 'invisible s) + (length s)))))))) + (string-width s)) + +(defun markdown--remove-invisible-markup (s) + "Remove Markdown markup from string S. +This version removes characters with invisibility property +`markdown-markup'." + (let (b) + (while (setq b (text-property-any + 0 (length s) + 'invisible 'markdown-markup s)) + (setq s (concat + (substring s 0 b) + (substring s (or (next-single-property-change + b 'invisible s) + (length s))))))) + s) + +;; Functions for maintaining tables + +(defvar markdown-table-at-point-p-function #'markdown--table-at-point-p + "Function to decide if point is inside a table. + +The indirection serves to differentiate between standard markdown +tables and gfm tables which are less strict about the markup.") + +(defconst markdown-table-line-regexp "^[ \t]*|" + "Regexp matching any line inside a table.") + +(defconst markdown-table-hline-regexp "^[ \t]*|[-:]" + "Regexp matching hline inside a table.") + +(defconst markdown-table-dline-regexp "^[ \t]*|[^-:]" + "Regexp matching dline inside a table.") + +(defun markdown-table-at-point-p () + "Return non-nil when point is inside a table." + (funcall markdown-table-at-point-p-function)) + +(defun markdown--table-at-point-p () + "Return non-nil when point is inside a table." + (save-excursion + (beginning-of-line) + (and (looking-at-p markdown-table-line-regexp) + (not (markdown-code-block-at-point-p))))) + +(defconst gfm-table-line-regexp "^.?*|" + "Regexp matching any line inside a table.") + +(defconst gfm-table-hline-regexp "^-+\\(|-\\)+" + "Regexp matching hline inside a table.") + +;; GFM simplified tables syntax is as follows: +;; - A header line for the column names, this is any text +;; separated by `|'. +;; - Followed by a string -|-|- ..., the number of dashes is optional +;; but must be higher than 1. The number of separators should match +;; the number of columns. +;; - Followed by the rows of data, which has the same format as the +;; header line. +;; Example: +;; +;; foo | bar +;; ------|--------- +;; bar | baz +;; bar | baz +(defun gfm--table-at-point-p () + "Return non-nil when point is inside a gfm-compatible table." + (or (markdown--table-at-point-p) + (save-excursion + (beginning-of-line) + (when (looking-at-p gfm-table-line-regexp) + ;; we might be at the first line of the table, check if the + ;; line below is the hline + (or (save-excursion + (forward-line 1) + (looking-at-p gfm-table-hline-regexp)) + ;; go up to find the header + (catch 'done + (while (looking-at-p gfm-table-line-regexp) + (cond + ((looking-at-p gfm-table-hline-regexp) + (throw 'done t)) + ((bobp) + (throw 'done nil))) + (forward-line -1)) + nil)))))) + +(defun markdown-table-hline-at-point-p () + "Return non-nil when point is on a hline in a table. +This function assumes point is on a table." + (save-excursion + (beginning-of-line) + (looking-at-p markdown-table-hline-regexp))) + +(defun markdown-table-begin () + "Find the beginning of the table and return its position. +This function assumes point is on a table." + (save-excursion + (while (and (not (bobp)) + (markdown-table-at-point-p)) + (forward-line -1)) + (unless (or (eobp) + (markdown-table-at-point-p)) + (forward-line 1)) + (point))) + +(defun markdown-table-end () + "Find the end of the table and return its position. +This function assumes point is on a table." + (save-excursion + (while (and (not (eobp)) + (markdown-table-at-point-p)) + (forward-line 1)) + (point))) + +(defun markdown-table-get-dline () + "Return index of the table data line at point. +This function assumes point is on a table." + (let ((pos (point)) (end (markdown-table-end)) (cnt 0)) + (save-excursion + (goto-char (markdown-table-begin)) + (while (and (re-search-forward + markdown-table-dline-regexp end t) + (setq cnt (1+ cnt)) + (< (line-end-position) pos)))) + cnt)) + +(defun markdown--thing-at-wiki-link (pos) + (when markdown-enable-wiki-links + (save-excursion + (save-match-data + (goto-char pos) + (thing-at-point-looking-at markdown-regex-wiki-link))))) + +(defun markdown-table-get-column () + "Return table column at point. +This function assumes point is on a table." + (let ((pos (point)) (cnt 0)) + (save-excursion + (beginning-of-line) + (while (search-forward "|" pos t) + (when (and (not (looking-back "\\\\|" (line-beginning-position))) + (not (markdown--thing-at-wiki-link (match-beginning 0)))) + (setq cnt (1+ cnt))))) + cnt)) + +(defun markdown-table-get-cell (&optional n) + "Return the content of the cell in column N of current row. +N defaults to column at point. This function assumes point is on +a table." + (and n (markdown-table-goto-column n)) + (skip-chars-backward "^|\n") (backward-char 1) + (if (looking-at "|[^|\r\n]*") + (let* ((pos (match-beginning 0)) + (val (buffer-substring (1+ pos) (match-end 0)))) + (goto-char (min (line-end-position) (+ 2 pos))) + ;; Trim whitespaces + (setq val (replace-regexp-in-string "\\`[ \t]+" "" val) + val (replace-regexp-in-string "[ \t]+\\'" "" val))) + (forward-char 1) "")) + +(defun markdown-table-goto-dline (n) + "Go to the Nth data line in the table at point. +Return t when the line exists, nil otherwise. This function +assumes point is on a table." + (goto-char (markdown-table-begin)) + (let ((end (markdown-table-end)) (cnt 0)) + (while (and (re-search-forward + markdown-table-dline-regexp end t) + (< (setq cnt (1+ cnt)) n))) + (= cnt n))) + +(defun markdown-table-goto-column (n &optional on-delim) + "Go to the Nth column in the table line at point. +With optional argument ON-DELIM, stop with point before the left +delimiter of the cell. If there are less than N cells, just go +beyond the last delimiter. This function assumes point is on a +table." + (beginning-of-line 1) + (when (> n 0) + (while (and (> n 0) (search-forward "|" (line-end-position) t)) + (when (and (not (looking-back "\\\\|" (line-beginning-position))) + (not (markdown--thing-at-wiki-link (match-beginning 0)))) + (cl-decf n))) + (if on-delim + (backward-char 1) + (when (looking-at " ") (forward-char 1))))) + +(defmacro markdown-table-save-cell (&rest body) + "Save cell at point, execute BODY and restore cell. +This function assumes point is on a table." + (declare (debug (body))) + (markdown--with-gensyms (line column) + `(let ((,line (copy-marker (line-beginning-position))) + (,column (markdown-table-get-column))) + (unwind-protect + (progn ,@body) + (goto-char ,line) + (markdown-table-goto-column ,column) + (set-marker ,line nil))))) + +(defun markdown-table-blank-line (s) + "Convert a table line S into a line with blank cells." + (if (string-match "^[ \t]*|-" s) + (setq s (mapconcat + (lambda (x) (if (member x '(?| ?+)) "|" " ")) + s "")) + (with-temp-buffer + (insert s) + (goto-char (point-min)) + (when (re-search-forward "|" nil t) + (let ((cur (point)) + ret) + (while (re-search-forward "|" nil t) + (when (and (not (eql (char-before (match-beginning 0)) ?\\)) + (not (markdown--thing-at-wiki-link (match-beginning 0)))) + (push (make-string (- (match-beginning 0) cur) ? ) ret) + (setq cur (match-end 0)))) + (format "|%s|" (string-join (nreverse ret) "|"))))))) + +(defun markdown-table-colfmt (fmtspec) + "Process column alignment specifier FMTSPEC for tables." + (when (stringp fmtspec) + (mapcar (lambda (x) + (cond ((string-match-p "^:.*:$" x) 'c) + ((string-match-p "^:" x) 'l) + ((string-match-p ":$" x) 'r) + (t 'd))) + (markdown--split-string fmtspec "\\s-*|\\s-*")))) + +(defun markdown--first-column-p (bar-pos) + (save-excursion + (save-match-data + (goto-char bar-pos) + (looking-back "^\\s-*" (line-beginning-position))))) + +(defun markdown--table-line-to-columns (line) + (with-temp-buffer + (insert line) + (goto-char (point-min)) + (let ((cur (point)) + ret) + (while (and (re-search-forward "\\s-*\\(|\\)\\s-*" nil t)) + (when (not (markdown--face-p (match-beginning 1) '(markdown-inline-code-face))) + (if (markdown--first-column-p (match-beginning 1)) + (setq cur (match-end 0)) + (cond ((eql (char-before (match-beginning 1)) ?\\) + ;; keep spaces + (goto-char (match-end 1))) + ((markdown--thing-at-wiki-link (match-beginning 1))) ;; do nothing + (t + (push (buffer-substring-no-properties cur (match-beginning 0)) ret) + (setq cur (match-end 0))))))) + (when (< cur (length line)) + (push (buffer-substring-no-properties cur (point-max)) ret)) + (nreverse ret)))) + +(defsubst markdown--is-delimiter-row (line) + (and (string-match-p "\\`[ \t]*|[ \t]*[-:]" line) + (cl-loop for c across line + always (member c '(?| ?- ?: ?\t ? ))))) + +(defun markdown-table-align () + "Align table at point. +This function assumes point is on a table." + (interactive) + (let ((begin (markdown-table-begin)) + (end (copy-marker (markdown-table-end)))) + (markdown-table-save-cell + (goto-char begin) + (let* (fmtspec + ;; Store table indent + (indent (progn (looking-at "[ \t]*") (match-string 0))) + ;; Split table in lines and save column format specifier + (lines (mapcar (lambda (line) + (if (markdown--is-delimiter-row line) + (progn (setq fmtspec (or fmtspec line)) nil) + line)) + (markdown--split-string (buffer-substring begin end) "\n"))) + ;; Split lines in cells + (cells (mapcar (lambda (l) (markdown--table-line-to-columns l)) + (remq nil lines))) + ;; Calculate maximum number of cells in a line + (maxcells (if cells + (apply #'max (mapcar #'length cells)) + (user-error "Empty table"))) + ;; Empty cells to fill short lines + (emptycells (make-list maxcells "")) + maxwidths) + ;; Calculate maximum width for each column + (dotimes (i maxcells) + (let ((column (mapcar (lambda (x) (or (nth i x) "")) cells))) + (push (apply #'max 1 (mapcar #'markdown--string-width column)) + maxwidths))) + (setq maxwidths (nreverse maxwidths)) + ;; Process column format specifier + (setq fmtspec (markdown-table-colfmt fmtspec)) + ;; Compute formats needed for output of table lines + (let ((hfmt (concat indent "|")) + (rfmt (concat indent "|")) + hfmt1 rfmt1 fmt) + (dolist (width maxwidths (setq hfmt (concat (substring hfmt 0 -1) "|"))) + (setq fmt (pop fmtspec)) + (cond ((equal fmt 'l) (setq hfmt1 ":%s-|" rfmt1 " %%-%ds |")) + ((equal fmt 'r) (setq hfmt1 "-%s:|" rfmt1 " %%%ds |")) + ((equal fmt 'c) (setq hfmt1 ":%s:|" rfmt1 " %%-%ds |")) + (t (setq hfmt1 "-%s-|" rfmt1 " %%-%ds |"))) + (setq rfmt (concat rfmt (format rfmt1 width))) + (setq hfmt (concat hfmt (format hfmt1 (make-string width ?-))))) + ;; Replace modified lines only + (dolist (line lines) + (let ((line (if line + (apply #'format rfmt (append (pop cells) emptycells)) + hfmt)) + (previous (buffer-substring (point) (line-end-position)))) + (if (equal previous line) + (forward-line) + (insert line "\n") + (delete-region (point) (line-beginning-position 2)))))) + (set-marker end nil))))) + +(defun markdown-table-insert-row (&optional arg) + "Insert a new row above the row at point into the table. +With optional argument ARG, insert below the current row." + (interactive "P") + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (let* ((line (buffer-substring + (line-beginning-position) (line-end-position))) + (new (markdown-table-blank-line line))) + (beginning-of-line (if arg 2 1)) + (unless (bolp) (insert "\n")) + (insert-before-markers new "\n") + (beginning-of-line 0) + (re-search-forward "| ?" (line-end-position) t))) + +(defun markdown-table-delete-row () + "Delete row or horizontal line at point from the table." + (interactive) + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (let ((col (current-column))) + (kill-region (line-beginning-position) + (min (1+ (line-end-position)) (point-max))) + (unless (markdown-table-at-point-p) (beginning-of-line 0)) + (move-to-column col))) + +(defun markdown-table-move-row (&optional up) + "Move table line at point down. +With optional argument UP, move it up." + (interactive "P") + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (let* ((col (current-column)) (pos (point)) + (tonew (if up 0 2)) txt) + (beginning-of-line tonew) + (unless (markdown-table-at-point-p) + (goto-char pos) (user-error "Cannot move row further")) + (goto-char pos) (beginning-of-line 1) (setq pos (point)) + (setq txt (buffer-substring (point) (1+ (line-end-position)))) + (delete-region (point) (1+ (line-end-position))) + (beginning-of-line tonew) + (insert txt) (beginning-of-line 0) + (move-to-column col))) + +(defun markdown-table-move-row-up () + "Move table row at point up." + (interactive) + (markdown-table-move-row 'up)) + +(defun markdown-table-move-row-down () + "Move table row at point down." + (interactive) + (markdown-table-move-row nil)) + +(defun markdown-table-insert-column () + "Insert a new table column." + (interactive) + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (let* ((col (max 1 (markdown-table-get-column))) + (begin (markdown-table-begin)) + (end (copy-marker (markdown-table-end)))) + (markdown-table-save-cell + (goto-char begin) + (while (< (point) end) + (markdown-table-goto-column col t) + (if (markdown-table-hline-at-point-p) + (insert "|---") + (insert "| ")) + (forward-line))) + (set-marker end nil) + (when markdown-table-align-p + (markdown-table-align)))) + +(defun markdown-table-delete-column () + "Delete column at point from table." + (interactive) + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (let ((col (markdown-table-get-column)) + (begin (markdown-table-begin)) + (end (copy-marker (markdown-table-end)))) + (markdown-table-save-cell + (goto-char begin) + (while (< (point) end) + (markdown-table-goto-column col t) + (and (looking-at "|\\(?:\\\\|\\|[^|\n]\\)+|") + (replace-match "|")) + (forward-line))) + (set-marker end nil) + (markdown-table-goto-column (max 1 (1- col))) + (when markdown-table-align-p + (markdown-table-align)))) + +(defun markdown-table-move-column (&optional left) + "Move table column at point to the right. +With optional argument LEFT, move it to the left." + (interactive "P") + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (let* ((col (markdown-table-get-column)) + (col1 (if left (1- col) col)) + (colpos (if left (1- col) (1+ col))) + (begin (markdown-table-begin)) + (end (copy-marker (markdown-table-end)))) + (when (and left (= col 1)) + (user-error "Cannot move column further left")) + (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) + (user-error "Cannot move column further right")) + (markdown-table-save-cell + (goto-char begin) + (while (< (point) end) + (markdown-table-goto-column col1 t) + (when (looking-at "|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|") + (replace-match "|\\2|\\1|")) + (forward-line))) + (set-marker end nil) + (markdown-table-goto-column colpos) + (when markdown-table-align-p + (markdown-table-align)))) + +(defun markdown-table-move-column-left () + "Move table column at point to the left." + (interactive) + (markdown-table-move-column 'left)) + +(defun markdown-table-move-column-right () + "Move table column at point to the right." + (interactive) + (markdown-table-move-column nil)) + +(defun markdown-table-next-row () + "Go to the next row (same column) in the table. +Create new table lines if required." + (interactive) + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (if (or (looking-at "[ \t]*$") + (save-excursion (skip-chars-backward " \t") (bolp))) + (newline) + (when markdown-table-align-p + (markdown-table-align)) + (let ((col (markdown-table-get-column))) + (beginning-of-line 2) + (if (or (not (markdown-table-at-point-p)) + (markdown-table-hline-at-point-p)) + (progn + (beginning-of-line 0) + (markdown-table-insert-row 'below))) + (markdown-table-goto-column col) + (skip-chars-backward "^|\n\r") + (when (looking-at " ") (forward-char 1))))) + +(defun markdown-table-forward-cell () + "Go to the next cell in the table. +Create new table lines if required." + (interactive) + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (when markdown-table-align-p + (markdown-table-align)) + (let ((end (markdown-table-end))) + (when (markdown-table-hline-at-point-p) (end-of-line 1)) + (condition-case nil + (progn + (re-search-forward "\\(?:^\\|[^\\]\\)|" end) + (when (looking-at "[ \t]*$") + (re-search-forward "\\(?:^\\|[^\\]:\\)|" end)) + (when (and (looking-at "[-:]") + (re-search-forward "^\\(?:[ \t]*\\|[^\\]\\)|\\([^-:]\\)" end t)) + (goto-char (match-beginning 1))) + (if (looking-at "[-:]") + (progn + (beginning-of-line 0) + (markdown-table-insert-row 'below)) + (when (looking-at " ") (forward-char 1)))) + (error (markdown-table-insert-row 'below))))) + +(defun markdown-table-backward-cell () + "Go to the previous cell in the table." + (interactive) + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (when markdown-table-align-p + (markdown-table-align)) + (when (markdown-table-hline-at-point-p) (beginning-of-line 1)) + (condition-case nil + (progn + (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)) + ;; When this function is called while in the first cell in a + ;; table, the point will now be at the beginning of a line. In + ;; this case, we need to move past one additional table + ;; boundary, the end of the table on the previous line. + (when (= (point) (line-beginning-position)) + (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) + (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) + (error (user-error "Cannot move to previous table cell"))) + (when (looking-at "\\(?:^\\|[^\\]\\)| ?") (goto-char (match-end 0))) + + ;; This may have dropped point on the hline. + (when (markdown-table-hline-at-point-p) + (markdown-table-backward-cell))) + +(defun markdown-table-transpose () + "Transpose table at point. +Horizontal separator lines will be eliminated." + (interactive) + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (let* ((table (buffer-substring-no-properties + (markdown-table-begin) (markdown-table-end))) + ;; Convert table to Lisp structure + (table (delq nil + (mapcar + (lambda (x) + (unless (string-match-p + markdown-table-hline-regexp x) + (markdown--table-line-to-columns x))) + (markdown--split-string table "[ \t]*\n[ \t]*")))) + (dline_old (markdown-table-get-dline)) + (col_old (markdown-table-get-column)) + (contents (mapcar (lambda (_) + (let ((tp table)) + (mapcar + (lambda (_) + (prog1 + (pop (car tp)) + (setq tp (cdr tp)))) + table))) + (car table)))) + (goto-char (markdown-table-begin)) + (save-excursion + (re-search-forward "|") (backward-char) + (delete-region (point) (markdown-table-end)) + (insert (mapconcat + (lambda(x) + (concat "| " (mapconcat 'identity x " | " ) " |\n")) + contents ""))) + (markdown-table-goto-dline col_old) + (markdown-table-goto-column dline_old)) + (when markdown-table-align-p + (markdown-table-align))) + +(defun markdown-table-sort-lines (&optional sorting-type) + "Sort table lines according to the column at point. + +The position of point indicates the column to be used for +sorting, and the range of lines is the range between the nearest +horizontal separator lines, or the entire table of no such lines +exist. If point is before the first column, user will be prompted +for the sorting column. If there is an active region, the mark +specifies the first line and the sorting column, while point +should be in the last line to be included into the sorting. + +The command then prompts for the sorting type which can be +alphabetically or numerically. Sorting in reverse order is also +possible. + +If SORTING-TYPE is specified when this function is called from a +Lisp program, no prompting will take place. SORTING-TYPE must be +a character, any of (?a ?A ?n ?N) where the capital letters +indicate that sorting should be done in reverse order." + (interactive) + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + ;; Set sorting type and column used for sorting + (let ((column (let ((c (markdown-table-get-column))) + (cond ((> c 0) c) + ((called-interactively-p 'any) + (read-number "Use column N for sorting: ")) + (t 1)))) + (sorting-type + (or sorting-type + (progn + ;; workaround #641 + ;; Emacs < 28 hides prompt message by another message. This erases it. + (message "") + (read-char-exclusive + "Sort type: [a]lpha [n]umeric (A/N means reversed): "))))) + (save-restriction + ;; Narrow buffer to appropriate sorting area + (if (region-active-p) + (narrow-to-region + (save-excursion + (progn + (goto-char (region-beginning)) (line-beginning-position))) + (save-excursion + (progn + (goto-char (region-end)) (line-end-position)))) + (let ((start (markdown-table-begin)) + (end (markdown-table-end))) + (narrow-to-region + (save-excursion + (if (re-search-backward + markdown-table-hline-regexp start t) + (line-beginning-position 2) + start)) + (if (save-excursion (re-search-forward + markdown-table-hline-regexp end t)) + (match-beginning 0) + end)))) + ;; Determine arguments for `sort-subr' + (let* ((extract-key-from-cell + (cl-case sorting-type + ((?a ?A) #'markdown--remove-invisible-markup) ;; #'identity) + ((?n ?N) #'string-to-number) + (t (user-error "Invalid sorting type: %c" sorting-type)))) + (predicate + (cl-case sorting-type + ((?n ?N) #'<) + ((?a ?A) #'string<)))) + ;; Sort selected area + (goto-char (point-min)) + (sort-subr (memq sorting-type '(?A ?N)) + (lambda () + (forward-line) + (while (and (not (eobp)) + (not (looking-at + markdown-table-dline-regexp))) + (forward-line))) + #'end-of-line + (lambda () + (funcall extract-key-from-cell + (markdown-table-get-cell column))) + nil + predicate) + (goto-char (point-min)))))) + +(defun markdown-table-convert-region (begin end &optional separator) + "Convert region from BEGIN to END to table with SEPARATOR. + +If every line contains at least one TAB character, the function +assumes that the material is tab separated (TSV). If every line +contains a comma, comma-separated values (CSV) are assumed. If +not, lines are split at whitespace into cells. + +You can use a prefix argument to force a specific separator: +\\[universal-argument] once forces CSV, \\[universal-argument] +twice forces TAB, and \\[universal-argument] three times will +prompt for a regular expression to match the separator, and a +numeric argument N indicates that at least N consecutive +spaces, or alternatively a TAB should be used as the separator." + + (interactive "r\nP") + (let* ((begin (min begin end)) (end (max begin end)) re) + (goto-char begin) (beginning-of-line 1) + (setq begin (point-marker)) + (goto-char end) + (if (bolp) (backward-char 1) (end-of-line 1)) + (setq end (point-marker)) + (when (equal separator '(64)) + (setq separator (read-regexp "Regexp for cell separator: "))) + (unless separator + ;; Get the right cell separator + (goto-char begin) + (setq separator + (cond + ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) + ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) + (t 1)))) + (goto-char begin) + (if (equal separator '(4)) + ;; Parse CSV + (while (< (point) end) + (cond + ((looking-at "^") (insert "| ")) + ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) + ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") + (replace-match "\\1") (if (looking-at "\"") (insert "\""))) + ((looking-at "[^,\n]+") (goto-char (match-end 0))) + ((looking-at "[ \t]*,") (replace-match " | ")) + (t (beginning-of-line 2)))) + (setq re + (cond + ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") + ((equal separator '(16)) "^\\|\t") + ((integerp separator) + (if (< separator 1) + (user-error "Cell separator must contain one or more spaces") + (format "^ *\\| *\t *\\| \\{%d,\\}\\|$" separator))) + ((stringp separator) (format "^ *\\|%s" separator)) + (t (error "Invalid cell separator")))) + (let (finish) + (while (and (not finish) (re-search-forward re end t)) + (if (eolp) + (progn + (replace-match "|" t t) + (forward-line 1) + (when (eobp) + (setq finish t))) + (replace-match "| " t t))))) + (goto-char begin) + (when markdown-table-align-p + (markdown-table-align)))) + +(defun markdown-insert-table (&optional rows columns align) + "Insert an empty pipe table. +Optional arguments ROWS, COLUMNS, and ALIGN specify number of +rows and columns and the column alignment." + (interactive) + (let* ((rows (or rows (read-number "Number of Rows: "))) + (columns (or columns (read-number "Number of Columns: "))) + (align (or align (read-string "Alignment ([l]eft, [r]ight, [c]enter, or RET for default): "))) + (align (cond ((equal align "l") ":--") + ((equal align "r") "--:") + ((equal align "c") ":-:") + (t "---"))) + (pos (point)) + (indent (make-string (current-column) ?\ )) + (line (concat + (apply 'concat indent "|" + (make-list columns " |")) "\n")) + (hline (apply 'concat indent "|" + (make-list columns (concat align "|"))))) + (if (string-match + "^[ \t]*$" (buffer-substring-no-properties + (line-beginning-position) (point))) + (beginning-of-line 1) + (newline)) + (dotimes (_ rows) (insert line)) + (goto-char pos) + (if (> rows 1) + (progn + (end-of-line 1) (insert (concat "\n" hline)) (goto-char pos))) + (markdown-table-forward-cell))) + + +;;; ElDoc Support ============================================================= + +(defun markdown-eldoc-function (&rest _ignored) + "Return a helpful string when appropriate based on context. +* Report URL when point is at a hidden URL. +* Report language name when point is a code block with hidden markup." + (cond + ;; Hidden URL or reference for inline link + ((and (or (thing-at-point-looking-at markdown-regex-link-inline) + (thing-at-point-looking-at markdown-regex-link-reference)) + (or markdown-hide-urls markdown-hide-markup)) + (let* ((imagep (string-equal (match-string 1) "!")) + (referencep (string-equal (match-string 5) "[")) + (link (match-string-no-properties 6)) + (edit-keys (markdown--substitute-command-keys + (if imagep + "\\[markdown-insert-image]" + "\\[markdown-insert-link]"))) + (edit-str (propertize edit-keys 'face 'font-lock-constant-face)) + (object (if referencep "reference" "URL"))) + (format "Hidden %s (%s to edit): %s" object edit-str + (if referencep + (concat + (propertize "[" 'face 'markdown-markup-face) + (propertize link 'face 'markdown-reference-face) + (propertize "]" 'face 'markdown-markup-face)) + (propertize link 'face 'markdown-url-face))))) + ;; Hidden language name for fenced code blocks + ((and (markdown-code-block-at-point-p) + (not (get-text-property (point) 'markdown-pre)) + markdown-hide-markup) + (let ((lang (save-excursion (markdown-code-block-lang)))) + (unless lang (setq lang "[unspecified]")) + (format "Hidden code block language: %s (%s to toggle markup)" + (propertize lang 'face 'markdown-language-keyword-face) + (markdown--substitute-command-keys + "\\[markdown-toggle-markup-hiding]")))))) + +(defun markdown--image-media-handler (mimetype data) + (let* ((ext (symbol-name (mailcap-mime-type-to-extension mimetype))) + (filename (read-string "Insert filename for image: ")) + (link-text (read-string "Link text: ")) + (filepath (file-name-with-extension filename ext)) + (dir (file-name-directory filepath))) + (when (and dir (not (file-directory-p dir))) + (make-directory dir t)) + (with-temp-file filepath + (insert data)) + (when (string-match-p "\\s-" filepath) + (setq filepath (concat "<" filepath ">"))) + (markdown-insert-inline-image link-text filepath))) + +(defun markdown--file-media-handler (_mimetype data) + (let* ((data (split-string data "[\0\r\n]" t "^file://")) + (files (cdr data))) + (while (not (null files)) + (let* ((file (url-unhex-string (car files))) + (file (file-relative-name file)) + (prompt (format "Link text(%s): " (file-name-nondirectory file))) + (link-text (read-string prompt))) + (when (string-match-p "\\s-" file) + (setq file (concat "<" file ">"))) + (markdown-insert-inline-image link-text file) + (when (not (null (cdr files))) + (insert " ")) + (setq files (cdr files)))))) + +(defun markdown--dnd-local-file-handler (url _action) + (require 'mailcap) + (require 'dnd) + (let* ((filename (dnd-get-local-file-name url)) + (mimetype (mailcap-file-name-to-mime-type filename)) + (file (file-relative-name filename)) + (link-text "link text")) + (when (string-match-p "\\s-" file) + (setq file (concat "<" file ">"))) + (if (string-prefix-p "image/" mimetype) + (markdown-insert-inline-image link-text file) + (markdown-insert-inline-link link-text file)))) + + +;;; Mode Definition ========================================================== + +(defun markdown-show-version () + "Show the version number in the minibuffer." + (interactive) + (message "markdown-mode, version %s" markdown-mode-version)) + +(defun markdown-mode-info () + "Open the `markdown-mode' homepage." + (interactive) + (browse-url "https://jblevins.org/projects/markdown-mode/")) + +;;;###autoload +(define-derived-mode markdown-mode text-mode "Markdown" + "Major mode for editing Markdown files." + (when buffer-read-only + (when (or (not (buffer-file-name)) (file-writable-p (buffer-file-name))) + (setq-local buffer-read-only nil))) + ;; Natural Markdown tab width + (setq tab-width 4) + ;; Comments + (setq-local comment-start "<!-- ") + (setq-local comment-end " -->") + (setq-local comment-start-skip "<!--[ \t]*") + (setq-local comment-column 0) + (setq-local comment-auto-fill-only-comments nil) + (setq-local comment-use-syntax t) + ;; Sentence + (setq-local sentence-end-base "[.?!…‽][]\"'”’)}»›*_`~]*") + ;; Syntax + (add-hook 'syntax-propertize-extend-region-functions + #'markdown-syntax-propertize-extend-region nil t) + (add-hook 'jit-lock-after-change-extend-region-functions + #'markdown-font-lock-extend-region-function t t) + (setq-local syntax-propertize-function #'markdown-syntax-propertize) + (syntax-propertize (point-max)) ;; Propertize before hooks run, etc. + ;; Font lock. + (setq font-lock-defaults + '(markdown-mode-font-lock-keywords + nil nil nil nil + (font-lock-multiline . t) + (font-lock-syntactic-face-function . markdown-syntactic-face) + (font-lock-extra-managed-props + . (composition display invisible rear-nonsticky + keymap help-echo mouse-face)))) + (if markdown-hide-markup + (add-to-invisibility-spec 'markdown-markup) + (remove-from-invisibility-spec 'markdown-markup)) + ;; Wiki links + (markdown-setup-wiki-link-hooks) + ;; Math mode + (when markdown-enable-math (markdown-toggle-math t)) + ;; Add a buffer-local hook to reload after file-local variables are read + (add-hook 'hack-local-variables-hook #'markdown-handle-local-variables nil t) + ;; For imenu support + (setq imenu-create-index-function + (if markdown-nested-imenu-heading-index + #'markdown-imenu-create-nested-index + #'markdown-imenu-create-flat-index)) + + ;; Defun movement + (setq-local beginning-of-defun-function #'markdown-beginning-of-defun) + (setq-local end-of-defun-function #'markdown-end-of-defun) + ;; Paragraph filling + (setq-local fill-paragraph-function #'markdown-fill-paragraph) + (setq-local paragraph-start + ;; Should match start of lines that start or separate paragraphs + (mapconcat #'identity + '( + "\f" ; starts with a literal line-feed + "[ \t\f]*$" ; space-only line + "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote + "[ \t]*[*+-][ \t]+" ; unordered list item + "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item + "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def + "[ \t]*:[ \t]+" ; definition + "^|" ; table or Pandoc line block + ) + "\\|")) + (setq-local paragraph-separate + ;; Should match lines that separate paragraphs without being + ;; part of any paragraph: + (mapconcat #'identity + '("[ \t\f]*$" ; space-only line + "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote + ;; The following is not ideal, but the Fill customization + ;; options really only handle paragraph-starting prefixes, + ;; not paragraph-ending suffixes: + ".* $" ; line ending in two spaces + "^#+" + "^\\(?: \\)?[-=]+[ \t]*$" ;; setext + "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def + "\\|")) + (setq-local adaptive-fill-first-line-regexp "\\`[ \t]*[A-Z]?>[ \t]*?\\'") + (setq-local adaptive-fill-regexp "\\s-*") + (setq-local adaptive-fill-function #'markdown-adaptive-fill-function) + (setq-local fill-forward-paragraph-function #'markdown-fill-forward-paragraph) + ;; Outline mode + (setq-local outline-regexp markdown-regex-header) + (setq-local outline-level #'markdown-outline-level) + ;; Cause use of ellipses for invisible text. + (add-to-invisibility-spec '(outline . t)) + ;; ElDoc support + (if (boundp 'eldoc-documentation-functions) + (add-hook 'eldoc-documentation-functions #'markdown-eldoc-function nil t) + (add-function :before-until (local 'eldoc-documentation-function) + #'markdown-eldoc-function)) + ;; Inhibiting line-breaking: + ;; Separating out each condition into a separate function so that users can + ;; override if desired (with remove-hook) + (add-hook 'fill-nobreak-predicate + #'markdown-line-is-reference-definition-p nil t) + (add-hook 'fill-nobreak-predicate + #'markdown-pipe-at-bol-p nil t) + + ;; Indentation + (setq-local indent-line-function markdown-indent-function) + (setq-local indent-region-function #'markdown--indent-region) + + ;; Flyspell + (setq-local flyspell-generic-check-word-predicate + #'markdown-flyspell-check-word-p) + + ;; Electric quoting + (add-hook 'electric-quote-inhibit-functions + #'markdown--inhibit-electric-quote nil :local) + + ;; drag and drop handler + (setq-local dnd-protocol-alist (cons '("^file:///" . markdown--dnd-local-file-handler) + dnd-protocol-alist)) + + ;; media handler + (when (version< "29" emacs-version) + (yank-media-handler "image/.*" #'markdown--image-media-handler) + ;; TODO support other than GNOME, like KDE etc + (yank-media-handler "x-special/gnome-copied-files" #'markdown--file-media-handler)) + + ;; Make checkboxes buttons + (when markdown-make-gfm-checkboxes-buttons + (markdown-make-gfm-checkboxes-buttons (point-min) (point-max)) + (add-hook 'after-change-functions #'markdown-gfm-checkbox-after-change-function t t) + (add-hook 'change-major-mode-hook #'markdown-remove-gfm-checkbox-overlays t t)) + + ;; edit-indirect + (add-hook 'edit-indirect-after-commit-functions + #'markdown--edit-indirect-after-commit-function + nil 'local) + + ;; Marginalized headings + (when markdown-marginalize-headers + (add-hook 'window-configuration-change-hook + #'markdown-marginalize-update-current nil t)) + + ;; add live preview export hook + (add-hook 'after-save-hook #'markdown-live-preview-if-markdown t t) + (add-hook 'kill-buffer-hook #'markdown-live-preview-remove-on-kill t t) + + ;; Add a custom keymap for `visual-line-mode' so that activating + ;; this minor mode does not override markdown-mode's keybindings. + ;; FIXME: Probably `visual-line-mode' should take care of this. + (let ((oldmap (cdr (assoc 'visual-line-mode minor-mode-map-alist))) + (newmap (make-sparse-keymap))) + (set-keymap-parent newmap oldmap) + (define-key newmap [remap move-beginning-of-line] nil) + (define-key newmap [remap move-end-of-line] nil) + (make-local-variable 'minor-mode-overriding-map-alist) + (push `(visual-line-mode . ,newmap) minor-mode-overriding-map-alist))) + +;;;###autoload +(add-to-list 'auto-mode-alist + '("\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" . markdown-mode)) + + +;;; GitHub Flavored Markdown Mode ============================================ + +(defun gfm--electric-pair-fence-code-block () + (when (and electric-pair-mode + (not markdown-gfm-use-electric-backquote) + (eql last-command-event ?`) + (let ((count 0)) + (while (eql (char-before (- (point) count)) ?`) + (cl-incf count)) + (= count 3)) + (eql (char-after) ?`)) + (save-excursion (insert (make-string 2 ?`))))) + +(defvar gfm-mode-hook nil + "Hook run when entering GFM mode.") + +;;;###autoload +(define-derived-mode gfm-mode markdown-mode "GFM" + "Major mode for editing GitHub Flavored Markdown files." + (setq markdown-link-space-sub-char "-") + (setq markdown-wiki-link-search-subdirectories t) + (setq-local markdown-table-at-point-p-function #'gfm--table-at-point-p) + (setq-local paragraph-separate + (concat paragraph-separate + "\\|" + ;; GFM alert syntax + "^>\s-*\\[!\\(?:NOTE\\|TIP\\|IMPORTANT\\|WARNING\\|CAUTION\\)\\]")) + (add-hook 'post-self-insert-hook #'gfm--electric-pair-fence-code-block 'append t) + (markdown-gfm-parse-buffer-for-languages)) + + +;;; Viewing modes ============================================================= + +(defcustom markdown-hide-markup-in-view-modes t + "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'." + :group 'markdown + :type 'boolean + :safe #'booleanp) + +(defvar markdown-view-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "p") #'markdown-outline-previous) + (define-key map (kbd "n") #'markdown-outline-next) + (define-key map (kbd "f") #'markdown-outline-next-same-level) + (define-key map (kbd "b") #'markdown-outline-previous-same-level) + (define-key map (kbd "u") #'markdown-outline-up) + (define-key map (kbd "DEL") #'scroll-down-command) + (define-key map (kbd "SPC") #'scroll-up-command) + (define-key map (kbd ">") #'end-of-buffer) + (define-key map (kbd "<") #'beginning-of-buffer) + (define-key map (kbd "q") #'kill-this-buffer) + (define-key map (kbd "?") #'describe-mode) + map) + "Keymap for `markdown-view-mode'.") + +(defun markdown--filter-visible (beg end &optional delete) + (let ((result "") + (invisible-faces '(markdown-header-delimiter-face markdown-header-rule-face))) + (while (< beg end) + (when (markdown--face-p beg invisible-faces) + (cl-incf beg) + (while (and (markdown--face-p beg invisible-faces) (< beg end)) + (cl-incf beg))) + (let ((next (next-single-char-property-change beg 'invisible))) + (unless (get-char-property beg 'invisible) + (setq result (concat result (buffer-substring beg (min end next))))) + (setq beg next))) + (prog1 result + (when delete + (let ((inhibit-read-only t)) + (delete-region beg end)))))) + +;;;###autoload +(define-derived-mode markdown-view-mode markdown-mode "Markdown-View" + "Major mode for viewing Markdown content." + (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) + (add-to-invisibility-spec 'markdown-markup) + (setq-local filter-buffer-substring-function #'markdown--filter-visible) + (read-only-mode 1)) + +(defvar gfm-view-mode-map + markdown-view-mode-map + "Keymap for `gfm-view-mode'.") + +;;;###autoload +(define-derived-mode gfm-view-mode gfm-mode "GFM-View" + "Major mode for viewing GitHub Flavored Markdown content." + (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) + (setq-local markdown-fontify-code-blocks-natively t) + (setq-local filter-buffer-substring-function #'markdown--filter-visible) + (add-to-invisibility-spec 'markdown-markup) + (read-only-mode 1)) + + +;;; Live Preview Mode ======================================================== +;;;###autoload +(define-minor-mode markdown-live-preview-mode + "Toggle native previewing on save for a specific markdown file." + :lighter " MD-Preview" + (if markdown-live-preview-mode + (if (markdown-live-preview-get-filename) + (markdown-display-buffer-other-window (markdown-live-preview-export)) + (markdown-live-preview-mode -1) + (user-error "Buffer %s does not visit a file" (current-buffer))) + (markdown-live-preview-remove))) + + +(provide 'markdown-mode) + +;; Local Variables: +;; indent-tabs-mode: nil +;; coding: utf-8 +;; End: +;;; markdown-mode.el ends here diff --git a/emacs/elpa/markdown-mode-20241117.1510/markdown-mode.elc b/emacs/elpa/markdown-mode-20241117.1510/markdown-mode.elc Binary files differ. diff --git a/emacs/elpa/markdown-mode-20241117.307/markdown-mode-pkg.el b/emacs/elpa/markdown-mode-20241117.307/markdown-mode-pkg.el @@ -1,10 +0,0 @@ -;; -*- no-byte-compile: t; lexical-binding: nil -*- -(define-package "markdown-mode" "20241117.307" - "Major mode for Markdown-formatted text." - '((emacs "27.1")) - :url "https://github.com/jrblevin/markdown-mode" - :commit "1716694217bfb802f768d2353cb801459027c294" - :revdesc "1716694217bf" - :keywords '("markdown" "github flavored markdown" "itex") - :authors '(("Jason R. Blevins" . "jblevins@xbeta.org")) - :maintainers '(("Jason R. Blevins" . "jblevins@xbeta.org"))) diff --git a/emacs/elpa/markdown-mode-20241117.307/markdown-mode.el b/emacs/elpa/markdown-mode-20241117.307/markdown-mode.el @@ -1,10401 +0,0 @@ -;;; markdown-mode.el --- Major mode for Markdown-formatted text -*- lexical-binding: t; -*- - -;; Copyright (C) 2007-2023 Jason R. Blevins and markdown-mode -;; contributors (see the commit log for details). - -;; Author: Jason R. Blevins <jblevins@xbeta.org> -;; Maintainer: Jason R. Blevins <jblevins@xbeta.org> -;; Created: May 24, 2007 -;; Package-Version: 20241117.307 -;; Package-Revision: 1716694217bf -;; Package-Requires: ((emacs "27.1")) -;; Keywords: Markdown, GitHub Flavored Markdown, itex -;; URL: https://jblevins.org/projects/markdown-mode/ - -;; 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 this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; See the README.md file for details. - - -;;; Code: - -(require 'easymenu) -(require 'outline) -(require 'thingatpt) -(require 'cl-lib) -(require 'url-parse) -(require 'button) -(require 'color) -(require 'rx) -(require 'subr-x) - -(defvar jit-lock-start) -(defvar jit-lock-end) -(defvar flyspell-generic-check-word-predicate) -(defvar electric-pair-pairs) -(defvar sh-ancestor-alist) - -(declare-function project-roots "project") -(declare-function sh-set-shell "sh-script") -(declare-function mailcap-file-name-to-mime-type "mailcap") -(declare-function dnd-get-local-file-name "dnd") - -;; for older emacs<29 -(declare-function mailcap-mime-type-to-extension "mailcap") -(declare-function file-name-with-extension "files") -(declare-function yank-media-handler "yank-media") - - -;;; Constants ================================================================= - -(defconst markdown-mode-version "2.7-alpha" - "Markdown mode version number.") - -(defconst markdown-output-buffer-name "*markdown-output*" - "Name of temporary buffer for markdown command output.") - - -;;; Global Variables ========================================================== - -(defvar markdown-reference-label-history nil - "History of used reference labels.") - -(defvar markdown-live-preview-mode nil - "Sentinel variable for command `markdown-live-preview-mode'.") - -(defvar markdown-gfm-language-history nil - "History list of languages used in the current buffer in GFM code blocks.") - -(defvar markdown-follow-link-functions nil - "Functions used to follow a link. -Each function is called with one argument, the link's URL. It -should return non-nil if it followed the link, or nil if not. -Functions are called in order until one of them returns non-nil; -otherwise the default link-following function is used.") - - -;;; Customizable Variables ==================================================== - -(defvar markdown-mode-hook nil - "Hook run when entering Markdown mode.") - -(defvar markdown-before-export-hook nil - "Hook run before running Markdown to export XHTML output. -The hook may modify the buffer, which will be restored to it's -original state after exporting is complete.") - -(defvar markdown-after-export-hook nil - "Hook run after XHTML output has been saved. -Any changes to the output buffer made by this hook will be saved.") - -(defgroup markdown nil - "Major mode for editing text files in Markdown format." - :prefix "markdown-" - :group 'text - :link '(url-link "https://jblevins.org/projects/markdown-mode/")) - -(defcustom markdown-command (let ((command (cl-loop for cmd in '("markdown" "pandoc" "markdown_py") - when (executable-find cmd) - return (file-name-nondirectory it)))) - (or command "markdown")) - "Command to run markdown." - :group 'markdown - :type '(choice (string :tag "Shell command") (repeat (string)) function)) - -(defcustom markdown-command-needs-filename nil - "Set to non-nil if `markdown-command' does not accept input from stdin. -Instead, it will be passed a filename as the final command line -option. As a result, you will only be able to run Markdown from -buffers which are visiting a file." - :group 'markdown - :type 'boolean) - -(defcustom markdown-open-command nil - "Command used for opening Markdown files directly. -For example, a standalone Markdown previewer. This command will -be called with a single argument: the filename of the current -buffer. It can also be a function, which will be called without -arguments." - :group 'markdown - :type '(choice file function (const :tag "None" nil))) - -(defcustom markdown-open-image-command nil - "Command used for opening image files directly. -This is used at `markdown-follow-link-at-point'." - :group 'markdown - :type '(choice file function (const :tag "None" nil))) - -(defcustom markdown-hr-strings - '("-------------------------------------------------------------------------------" - "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *" - "---------------------------------------" - "* * * * * * * * * * * * * * * * * * * *" - "---------" - "* * * * *") - "Strings to use when inserting horizontal rules. -The first string in the list will be the default when inserting a -horizontal rule. Strings should be listed in decreasing order of -prominence (as in headings from level one to six) for use with -promotion and demotion functions." - :group 'markdown - :type '(repeat string)) - -(defcustom markdown-bold-underscore nil - "Use two underscores when inserting bold text instead of two asterisks." - :group 'markdown - :type 'boolean) - -(defcustom markdown-italic-underscore nil - "Use underscores when inserting italic text instead of asterisks." - :group 'markdown - :type 'boolean) - -(defcustom markdown-marginalize-headers nil - "When non-nil, put opening atx header markup in a left margin. - -This setting goes well with `markdown-asymmetric-header'. But -sadly it conflicts with `linum-mode' since they both use the -same margin." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-marginalize-headers-margin-width 6 - "Character width of margin used for marginalized headers. -The default value is based on there being six heading levels -defined by Markdown and HTML. Increasing this produces extra -whitespace on the left. Decreasing it may be preferred when -fewer than six nested heading levels are used." - :group 'markdown - :type 'integer - :safe 'natnump - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-asymmetric-header nil - "Determines if atx header style will be asymmetric. -Set to a non-nil value to use asymmetric header styling, placing -header markup only at the beginning of the line. By default, -balanced markup will be inserted at the beginning and end of the -line around the header title." - :group 'markdown - :type 'boolean) - -(defcustom markdown-indent-function 'markdown-indent-line - "Function to use to indent." - :group 'markdown - :type 'function) - -(defcustom markdown-indent-on-enter t - "Determines indentation behavior when pressing \\[newline]. -Possible settings are nil, t, and \\='indent-and-new-item. - -When non-nil, pressing \\[newline] will call `newline-and-indent' -to indent the following line according to the context using -`markdown-indent-function'. In this case, note that -\\[electric-newline-and-maybe-indent] can still be used to insert -a newline without indentation. - -When set to \\='indent-and-new-item and the point is in a list item -when \\[newline] is pressed, the list will be continued on the next -line, where a new item will be inserted. - -When set to nil, simply call `newline' as usual. In this case, -you can still indent lines using \\[markdown-cycle] and continue -lists with \\[markdown-insert-list-item]. - -Note that this assumes the variable `electric-indent-mode' is -non-nil (enabled). When it is *disabled*, the behavior of -\\[newline] and `\\[electric-newline-and-maybe-indent]' are -reversed." - :group 'markdown - :type '(choice (const :tag "Don't automatically indent" nil) - (const :tag "Automatically indent" t) - (const :tag "Automatically indent and insert new list items" indent-and-new-item))) - -(defcustom markdown-enable-wiki-links nil - "Syntax highlighting for wiki links. -Set this to a non-nil value to turn on wiki link support by default. -Support can be toggled later using the `markdown-toggle-wiki-links' -function or \\[markdown-toggle-wiki-links]." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-wiki-link-alias-first t - "When non-nil, treat aliased wiki links like [[alias text|PageName]]. -Otherwise, they will be treated as [[PageName|alias text]]." - :group 'markdown - :type 'boolean - :safe 'booleanp) - -(defcustom markdown-wiki-link-search-subdirectories nil - "When non-nil, search for wiki link targets in subdirectories. -This is the default search behavior for GitHub and is -automatically set to t in `gfm-mode'." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-wiki-link-search-parent-directories nil - "When non-nil, search for wiki link targets in parent directories. -This is the default search behavior of Ikiwiki." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-wiki-link-search-type nil - "Searching type for markdown wiki link. - -sub-directories: search for wiki link targets in sub directories -parent-directories: search for wiki link targets in parent directories -project: search for wiki link targets under project root" - :group 'markdown - :type '(set - (const :tag "search wiki link from subdirectories" sub-directories) - (const :tag "search wiki link from parent directories" parent-directories) - (const :tag "search wiki link under project root" project)) - :package-version '(markdown-mode . "2.5")) - -(make-obsolete-variable 'markdown-wiki-link-search-subdirectories 'markdown-wiki-link-search-type "2.5") -(make-obsolete-variable 'markdown-wiki-link-search-parent-directories 'markdown-wiki-link-search-type "2.5") - -(defcustom markdown-wiki-link-fontify-missing nil - "When non-nil, change wiki link face according to existence of target files. -This is expensive because it requires checking for the file each time the buffer -changes or the user switches windows. It is disabled by default because it may -cause lag when typing on slower machines." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-uri-types - '("acap" "cid" "data" "dav" "fax" "file" "ftp" - "geo" "gopher" "http" "https" "imap" "ldap" "mailto" - "mid" "message" "modem" "news" "nfs" "nntp" - "pop" "prospero" "rtsp" "service" "sip" "tel" - "telnet" "tip" "urn" "vemmi" "wais") - "Link types for syntax highlighting of URIs." - :group 'markdown - :type '(repeat (string :tag "URI scheme"))) - -(defcustom markdown-url-compose-char - '(?∞ ?… ?⋯ ?# ?★ ?⚓) - "Placeholder character for hidden URLs. -This may be a single character or a list of characters. In case -of a list, the first one that satisfies `char-displayable-p' will -be used." - :type '(choice - (character :tag "Single URL replacement character") - (repeat :tag "List of possible URL replacement characters" - character)) - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-blockquote-display-char - '("▌" "┃" ">") - "String to display when hiding blockquote markup. -This may be a single string or a list of string. In case of a -list, the first one that satisfies `char-displayable-p' will be -used." - :type '(choice - (string :tag "Single blockquote display string") - (repeat :tag "List of possible blockquote display strings" string)) - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-hr-display-char - '(?─ ?━ ?-) - "Character for hiding horizontal rule markup. -This may be a single character or a list of characters. In case -of a list, the first one that satisfies `char-displayable-p' will -be used." - :group 'markdown - :type '(choice - (character :tag "Single HR display character") - (repeat :tag "List of possible HR display characters" character)) - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-definition-display-char - '(?⁘ ?⁙ ?≡ ?⌑ ?◊ ?:) - "Character for replacing definition list markup. -This may be a single character or a list of characters. In case -of a list, the first one that satisfies `char-displayable-p' will -be used." - :type '(choice - (character :tag "Single definition list character") - (repeat :tag "List of possible definition list characters" character)) - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-enable-math nil - "Syntax highlighting for inline LaTeX and itex expressions. -Set this to a non-nil value to turn on math support by default. -Math support can be enabled, disabled, or toggled later using -`markdown-toggle-math' or \\[markdown-toggle-math]." - :group 'markdown - :type 'boolean - :safe 'booleanp) -(make-variable-buffer-local 'markdown-enable-math) - -(defcustom markdown-enable-html t - "Enable font-lock support for HTML tags and attributes." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-enable-highlighting-syntax nil - "Enable highlighting syntax." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.5")) - -(defcustom markdown-css-paths nil - "List of URLs of CSS files to link to in the output XHTML." - :group 'markdown - :safe (apply-partially #'seq-every-p #'stringp) - :type '(repeat (string :tag "CSS File Path"))) - -(defcustom markdown-content-type "text/html" - "Content type string for the http-equiv header in XHTML output. -When set to an empty string, this attribute is omitted. Defaults to -`text/html'." - :group 'markdown - :type 'string) - -(defcustom markdown-coding-system nil - "Character set string for the http-equiv header in XHTML output. -Defaults to `buffer-file-coding-system' (and falling back to -`utf-8' when not available). Common settings are `iso-8859-1' -and `iso-latin-1'. Use `list-coding-systems' for more choices." - :group 'markdown - :type 'coding-system) - -(defcustom markdown-export-kill-buffer t - "Kill output buffer after HTML export. -When non-nil, kill the HTML output buffer after -exporting with `markdown-export'." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-xhtml-header-content "" - "Additional content to include in the XHTML <head> block." - :group 'markdown - :type 'string) - -(defcustom markdown-xhtml-body-preamble "" - "Content to include in the XHTML <body> block, before the output." - :group 'markdown - :type 'string - :safe 'stringp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-xhtml-body-epilogue "" - "Content to include in the XHTML <body> block, after the output." - :group 'markdown - :type 'string - :safe 'stringp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-xhtml-standalone-regexp - "^\\(<\\?xml\\|<!DOCTYPE\\|<html\\)" - "Regexp indicating whether `markdown-command' output is standalone XHTML." - :group 'markdown - :type 'regexp) - -(defcustom markdown-link-space-sub-char "_" - "Character to use instead of spaces when mapping wiki links to filenames." - :group 'markdown - :type 'string) - -(defcustom markdown-reference-location 'header - "Position where new reference definitions are inserted in the document." - :group 'markdown - :type '(choice (const :tag "At the end of the document" end) - (const :tag "Immediately after the current block" immediately) - (const :tag "At the end of the subtree" subtree) - (const :tag "Before next header" header))) - -(defcustom markdown-footnote-location 'end - "Position where new footnotes are inserted in the document." - :group 'markdown - :type '(choice (const :tag "At the end of the document" end) - (const :tag "Immediately after the current block" immediately) - (const :tag "At the end of the subtree" subtree) - (const :tag "Before next header" header))) - -(defcustom markdown-footnote-display '((raise 0.2) (height 0.8)) - "Display specification for footnote markers and inline footnotes. -By default, footnote text is reduced in size and raised. Set to -nil to disable this." - :group 'markdown - :type '(choice (sexp :tag "Display specification") - (const :tag "Don't set display property" nil)) - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-sub-superscript-display - '(((raise -0.3) (height 0.7)) . ((raise 0.3) (height 0.7))) - "Display specification for subscript and superscripts. -The car is used for subscript, the cdr is used for superscripts." - :group 'markdown - :type '(cons (choice (sexp :tag "Subscript form") - (const :tag "No lowering" nil)) - (choice (sexp :tag "Superscript form") - (const :tag "No raising" nil))) - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-unordered-list-item-prefix " * " - "String inserted before unordered list items." - :group 'markdown - :type 'string) - -(defcustom markdown-ordered-list-enumeration t - "When non-nil, use enumerated numbers(1. 2. 3. etc.) for ordered list marker. -While nil, always uses '1.' for the marker" - :group 'markdown - :type 'boolean - :package-version '(markdown-mode . "2.5")) - -(defcustom markdown-nested-imenu-heading-index t - "Use nested or flat imenu heading index. -A nested index may provide more natural browsing from the menu, -but a flat list may allow for faster keyboard navigation via tab -completion." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-add-footnotes-to-imenu t - "Add footnotes to end of imenu heading index." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-make-gfm-checkboxes-buttons t - "When non-nil, make GFM checkboxes into buttons." - :group 'markdown - :type 'boolean) - -(defcustom markdown-use-pandoc-style-yaml-metadata nil - "When non-nil, allow YAML metadata anywhere in the document." - :group 'markdown - :type 'boolean) - -(defcustom markdown-split-window-direction 'any - "Preference for splitting windows for static and live preview. -The default value is \\='any, which instructs Emacs to use -`split-window-sensibly' to automatically choose how to split -windows based on the values of `split-width-threshold' and -`split-height-threshold' and the available windows. To force -vertically split (left and right) windows, set this to \\='vertical -or \\='right. To force horizontally split (top and bottom) windows, -set this to \\='horizontal or \\='below. - -If this value is \\='any and `display-buffer-alist' is set then -`display-buffer' is used for open buffer function" - :group 'markdown - :type '(choice (const :tag "Automatic" any) - (const :tag "Right (vertical)" right) - (const :tag "Below (horizontal)" below)) - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-live-preview-window-function - #'markdown-live-preview-window-eww - "Function to display preview of Markdown output within Emacs. -Function must update the buffer containing the preview and return -the buffer." - :group 'markdown - :type 'function) - -(defcustom markdown-live-preview-delete-export 'delete-on-destroy - "Delete exported HTML file when using `markdown-live-preview-export'. -If set to \\='delete-on-export, delete on every export. When set to -\\='delete-on-destroy delete when quitting from command -`markdown-live-preview-mode'. Never delete if set to nil." - :group 'markdown - :type '(choice - (const :tag "Delete on every export" delete-on-export) - (const :tag "Delete when quitting live preview" delete-on-destroy) - (const :tag "Never delete" nil))) - -(defcustom markdown-list-indent-width 4 - "Depth of indentation for markdown lists. -Used in `markdown-demote-list-item' and -`markdown-promote-list-item'." - :group 'markdown - :type 'integer) - -(defcustom markdown-enable-prefix-prompts t - "Display prompts for certain prefix commands. -Set to nil to disable these prompts." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-gfm-additional-languages nil - "Extra languages made available when inserting GFM code blocks. -Language strings must have be trimmed of whitespace and not -contain any curly braces. They may be of arbitrary -capitalization, though." - :group 'markdown - :type '(repeat (string :validate markdown-validate-language-string))) - -(defcustom markdown-gfm-use-electric-backquote t - "Use `markdown-electric-backquote' when backquote is hit three times." - :group 'markdown - :type 'boolean) - -(defcustom markdown-gfm-downcase-languages t - "If non-nil, downcase suggested languages. -This applies to insertions done with -`markdown-electric-backquote'." - :group 'markdown - :type 'boolean) - -(defcustom markdown-edit-code-block-default-mode 'normal-mode - "Default mode to use for editing code blocks. -This mode is used when automatic detection fails, such as for GFM -code blocks with no language specified." - :group 'markdown - :type '(choice function (const :tag "None" nil)) - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-gfm-uppercase-checkbox nil - "If non-nil, use [X] for completed checkboxes, [x] otherwise." - :group 'markdown - :type 'boolean - :safe 'booleanp) - -(defcustom markdown-hide-urls nil - "Hide URLs of inline links and reference tags of reference links. -Such URLs will be replaced by a single customizable -character, defined by `markdown-url-compose-char', but are still part -of the buffer. Links can be edited interactively with -\\[markdown-insert-link] or, for example, by deleting the final -parenthesis to remove the invisibility property. You can also -hover your mouse pointer over the link text to see the URL. -Set this to a non-nil value to turn this feature on by default. -You can interactively set the value of this variable by calling -`markdown-toggle-url-hiding', pressing \\[markdown-toggle-url-hiding], -or from the menu Markdown > Links & Images menu." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.3")) -(make-variable-buffer-local 'markdown-hide-urls) - -(defcustom markdown-translate-filename-function #'identity - "Function to use to translate filenames when following links. -\\<markdown-mode-map>\\[markdown-follow-thing-at-point] and \\[markdown-follow-link-at-point] -call this function with the filename as only argument whenever -they encounter a filename (instead of a URL) to be visited and -use its return value instead of the filename in the link. For -example, if absolute filenames are actually relative to a server -root directory, you can set -`markdown-translate-filename-function' to a function that -prepends the root directory to the given filename." - :group 'markdown - :type 'function - :risky t - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-max-image-size nil - "Maximum width and height for displayed inline images. -This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT). -When nil, use the actual size. Otherwise, use ImageMagick to -resize larger images to be of the given maximum dimensions. This -requires Emacs to be built with ImageMagick support." - :group 'markdown - :package-version '(markdown-mode . "2.4") - :type '(choice - (const :tag "Use actual image width" nil) - (cons (choice (sexp :tag "Maximum width in pixels") - (const :tag "No maximum width" nil)) - (choice (sexp :tag "Maximum height in pixels") - (const :tag "No maximum height" nil))))) - -(defcustom markdown-mouse-follow-link t - "Non-nil means mouse on a link will follow the link. -This variable must be set before loading markdown-mode." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.5")) - -(defcustom markdown-table-align-p t - "Non-nil means that table is aligned after table operation." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.5")) - -(defcustom markdown-fontify-whole-heading-line nil - "Non-nil means fontify the whole line for headings. -This is useful when setting a background color for the -markdown-header-face-* faces." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.5")) - -(defcustom markdown-special-ctrl-a/e nil - "Non-nil means `C-a' and `C-e' behave specially in headlines and items. - -When t, `C-a' will bring back the cursor to the beginning of the -headline text. In an item, this will be the position after bullet -and check-box, if any. When the cursor is already at that -position, another `C-a' will bring it to the beginning of the -line. - -`C-e' will jump to the end of the headline, ignoring the presence -of closing tags in the headline. A second `C-e' will then jump to -the true end of the line, after closing tags. This also means -that, when this variable is non-nil, `C-e' also will never jump -beyond the end of the heading of a folded section, i.e. not after -the ellipses. - -When set to the symbol `reversed', the first `C-a' or `C-e' works -normally, going to the true line boundary first. Only a directly -following, identical keypress will bring the cursor to the -special positions. - -This may also be a cons cell where the behavior for `C-a' and -`C-e' is set separately." - :group 'markdown - :type '(choice - (const :tag "off" nil) - (const :tag "on: after hashes/bullet and before closing tags first" t) - (const :tag "reversed: true line boundary first" reversed) - (cons :tag "Set C-a and C-e separately" - (choice :tag "Special C-a" - (const :tag "off" nil) - (const :tag "on: after hashes/bullet first" t) - (const :tag "reversed: before hashes/bullet first" reversed)) - (choice :tag "Special C-e" - (const :tag "off" nil) - (const :tag "on: before closing tags first" t) - (const :tag "reversed: after closing tags first" reversed)))) - :package-version '(markdown-mode . "2.7")) - -;;; Markdown-Specific `rx' Macro ============================================== - -;; Based on python-rx from python.el. -(defmacro markdown-rx (&rest regexps) - "Markdown mode specialized rx macro. -This variant of `rx' supports common Markdown named REGEXPS." - `(rx-let ((newline "\n") - ;; Note: #405 not consider markdown-list-indent-width however this is never used - (indent (or (repeat 4 " ") "\t")) - (block-end (and (or (one-or-more (zero-or-more blank) "\n") line-end))) - (numeral (and (one-or-more (any "0-9#")) ".")) - (bullet (any "*+:-")) - (list-marker (or (and (one-or-more (any "0-9#")) ".") - (any "*+:-"))) - (checkbox (seq "[" (any " xX") "]"))) - (rx ,@regexps))) - - -;;; Regular Expressions ======================================================= - -(defconst markdown-regex-comment-start - "<!--" - "Regular expression matches HTML comment opening.") - -(defconst markdown-regex-comment-end - "--[ \t]*>" - "Regular expression matches HTML comment closing.") - -(defconst markdown-regex-link-inline - "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)" - "Regular expression for a [text](file) or an image link ![text](file). -Group 1 matches the leading exclamation point (optional). -Group 2 matches the opening square bracket. -Group 3 matches the text inside the square brackets. -Group 4 matches the closing square bracket. -Group 5 matches the opening parenthesis. -Group 6 matches the URL. -Group 7 matches the title (optional). -Group 8 matches the closing parenthesis.") - -(defconst markdown-regex-link-reference - "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:[^]^][^]]*\\|\\)\\(?4:\\]\\)\\(?5:\\[\\)\\(?6:[^]]*?\\)\\(?7:\\]\\)" - "Regular expression for a reference link [text][id]. -Group 1 matches the leading exclamation point (optional). -Group 2 matches the opening square bracket for the link text. -Group 3 matches the text inside the square brackets. -Group 4 matches the closing square bracket for the link text. -Group 5 matches the opening square bracket for the reference label. -Group 6 matches the reference label. -Group 7 matches the closing square bracket for the reference label.") - -(defconst markdown-regex-reference-definition - "^ \\{0,3\\}\\(?1:\\[\\)\\(?2:[^]\n]+?\\)\\(?3:\\]\\)\\(?4::\\)\\s *\\(?5:.*?\\)\\s *\\(?6: \"[^\"]*\"$\\|$\\)" - "Regular expression for a reference definition. -Group 1 matches the opening square bracket. -Group 2 matches the reference label. -Group 3 matches the closing square bracket. -Group 4 matches the colon. -Group 5 matches the URL. -Group 6 matches the title attribute (optional).") - -(defconst markdown-regex-footnote - "\\(?1:\\[\\^\\)\\(?2:.+?\\)\\(?3:\\]\\)" - "Regular expression for a footnote marker [^fn]. -Group 1 matches the opening square bracket and carat. -Group 2 matches only the label, without the surrounding markup. -Group 3 matches the closing square bracket.") - -(defconst markdown-regex-header - "^\\(?:\\(?1:[^\r\n\t -].*\\)\n\\(?:\\(?2:=+\\)\\|\\(?3:-+\\)\\)\\|\\(?4:#+[ \t]+\\)\\(?5:.*?\\)\\(?6:[ \t]+#+\\)?\\)$" - "Regexp identifying Markdown headings. -Group 1 matches the text of a setext heading. -Group 2 matches the underline of a level-1 setext heading. -Group 3 matches the underline of a level-2 setext heading. -Group 4 matches the opening hash marks of an atx heading and whitespace. -Group 5 matches the text, without surrounding whitespace, of an atx heading. -Group 6 matches the closing whitespace and hash marks of an atx heading.") - -(defconst markdown-regex-header-setext - "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$" - "Regular expression for generic setext-style (underline) headers.") - -(defconst markdown-regex-header-atx - "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$" - "Regular expression for generic atx-style (hash mark) headers.") - -(defconst markdown-regex-hr - (rx line-start - (group (or (and (repeat 3 (and "*" (? " "))) (* (any "* "))) - (and (repeat 3 (and "-" (? " "))) (* (any "- "))) - (and (repeat 3 (and "_" (? " "))) (* (any "_ "))))) - line-end) - "Regular expression for matching Markdown horizontal rules.") - -(defconst markdown-regex-code - "\\(?:\\`\\|[^\\]\\)\\(?1:\\(?2:`+\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(?4:\\2\\)\\)\\(?:[^`]\\|\\'\\)" - "Regular expression for matching inline code fragments. - -Group 1 matches the entire code fragment including the backquotes. -Group 2 matches the opening backquotes. -Group 3 matches the code fragment itself, without backquotes. -Group 4 matches the closing backquotes. - -The leading, unnumbered group ensures that the leading backquote -character is not escaped. -The last group, also unnumbered, requires that the character -following the code fragment is not a backquote. -Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines, -but not two newlines in a row.") - -(defconst markdown-regex-kbd - "\\(?1:<kbd>\\)\\(?2:\\(?:.\\|\n[^\n]\\)*?\\)\\(?3:</kbd>\\)" - "Regular expression for matching <kbd> tags. -Groups 1 and 3 match the opening and closing tags. -Group 2 matches the key sequence.") - -(defconst markdown-regex-gfm-code-block-open - "^[[:blank:]]*\\(?1:```\\)\\(?2:[[:blank:]]*{?[[:blank:]]*\\)\\(?3:[^`[:space:]]+?\\)?\\(?:[[:blank:]]+\\(?4:.+?\\)\\)?\\(?5:[[:blank:]]*}?[[:blank:]]*\\)$" - "Regular expression matching opening of GFM code blocks. -Group 1 matches the opening three backquotes and any following whitespace. -Group 2 matches the opening brace (optional) and surrounding whitespace. -Group 3 matches the language identifier (optional). -Group 4 matches the info string (optional). -Group 5 matches the closing brace (optional), whitespace, and newline. -Groups need to agree with `markdown-regex-tilde-fence-begin'.") - -(defconst markdown-regex-gfm-code-block-close - "^[[:blank:]]*\\(?1:```\\)\\(?2:\\s *?\\)$" - "Regular expression matching closing of GFM code blocks. -Group 1 matches the closing three backquotes. -Group 2 matches any whitespace and the final newline.") - -(defconst markdown-regex-pre - "^\\( \\|\t\\).*$" - "Regular expression for matching preformatted text sections.") - -(defconst markdown-regex-list - (markdown-rx line-start - ;; 1. Leading whitespace - (group (* blank)) - ;; 2. List marker: a numeral, bullet, or colon - (group list-marker) - ;; 3. Trailing whitespace - (group (+ blank)) - ;; 4. Optional checkbox for GFM task list items - (opt (group (and checkbox (* blank))))) - "Regular expression for matching list items.") - -(defconst markdown-regex-bold - "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:\\*\\*\\|__\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:\\3\\)\\)" - "Regular expression for matching bold text. -Group 1 matches the character before the opening asterisk or -underscore, if any, ensuring that it is not a backslash escape. -Group 2 matches the entire expression, including delimiters. -Groups 3 and 5 matches the opening and closing delimiters. -Group 4 matches the text inside the delimiters.") - -(defconst markdown-regex-italic - "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?4:\\2\\)\\)" - "Regular expression for matching italic text. -The leading unnumbered matches the character before the opening -asterisk or underscore, if any, ensuring that it is not a -backslash escape. -Group 1 matches the entire expression, including delimiters. -Groups 2 and 4 matches the opening and closing delimiters. -Group 3 matches the text inside the delimiters.") - -(defconst markdown-regex-strike-through - "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:~~\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:~~\\)\\)" - "Regular expression for matching strike-through text. -Group 1 matches the character before the opening tilde, if any, -ensuring that it is not a backslash escape. -Group 2 matches the entire expression, including delimiters. -Groups 3 and 5 matches the opening and closing delimiters. -Group 4 matches the text inside the delimiters.") - -(defconst markdown-regex-gfm-italic - "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\2\\)\\)" - "Regular expression for matching italic text in GitHub Flavored Markdown. -Underscores in words are not treated as special. -Group 1 matches the entire expression, including delimiters. -Groups 2 and 4 matches the opening and closing delimiters. -Group 3 matches the text inside the delimiters.") - -(defconst markdown-regex-blockquote - "^[ \t]*\\(?1:[A-Z]?>\\)\\(?2:[ \t]*\\)\\(?3:.*\\)$" - "Regular expression for matching blockquote lines. -Also accounts for a potential capital letter preceding the angle -bracket, for use with Leanpub blocks (asides, warnings, info -blocks, etc.). -Group 1 matches the leading angle bracket. -Group 2 matches the separating whitespace. -Group 3 matches the text.") - -(defconst markdown-regex-line-break - "[^ \n\t][ \t]*\\( \\)\n" - "Regular expression for matching line breaks.") - -(defconst markdown-regex-escape - "\\(\\\\\\)." - "Regular expression for matching escape sequences.") - -(defconst markdown-regex-wiki-link - "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:\\[\\[\\)\\(?3:[^]|]+\\)\\(?:\\(?4:|\\)\\(?5:[^]]+\\)\\)?\\(?6:\\]\\]\\)\\)" - "Regular expression for matching wiki links. -This matches typical bracketed [[WikiLinks]] as well as \\='aliased -wiki links of the form [[PageName|link text]]. -The meanings of the first and second components depend -on the value of `markdown-wiki-link-alias-first'. - -Group 1 matches the entire link. -Group 2 matches the opening square brackets. -Group 3 matches the first component of the wiki link. -Group 4 matches the pipe separator, when present. -Group 5 matches the second component of the wiki link, when present. -Group 6 matches the closing square brackets.") - -(defconst markdown-regex-uri - (concat "\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>; ]+\\)") - "Regular expression for matching inline URIs.") - -;; CommanMark specification says scheme length is 2-32 characters -(defconst markdown-regex-angle-uri - (concat "\\(<\\)\\([a-z][a-z0-9.+-]\\{1,31\\}:[^]\t\n\r<>,;()]+\\)\\(>\\)") - "Regular expression for matching inline URIs in angle brackets.") - -(defconst markdown-regex-email - "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>" - "Regular expression for matching inline email addresses.") - -(defsubst markdown-make-regex-link-generic () - "Make regular expression for matching any recognized link." - (concat "\\(?:" markdown-regex-link-inline - (when markdown-enable-wiki-links - (concat "\\|" markdown-regex-wiki-link)) - "\\|" markdown-regex-link-reference - "\\|" markdown-regex-angle-uri "\\)")) - -(defconst markdown-regex-gfm-checkbox - " \\(\\[[ xX]\\]\\) " - "Regular expression for matching GFM checkboxes. -Group 1 matches the text to become a button.") - -(defconst markdown-regex-blank-line - "^[[:blank:]]*$" - "Regular expression that matches a blank line.") - -(defconst markdown-regex-block-separator - "\n[\n\t\f ]*\n" - "Regular expression for matching block boundaries.") - -(defconst markdown-regex-block-separator-noindent - (concat "\\(\\`\\|\\(" markdown-regex-block-separator "\\)[^\n\t\f ]\\)") - "Regexp for block separators before lines with no indentation.") - -(defconst markdown-regex-math-inline-single - "\\(?:^\\|[^\\]\\)\\(?1:\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\)" - "Regular expression for itex $..$ math mode expressions. -Groups 1 and 3 match the opening and closing dollar signs. -Group 2 matches the mathematical expression contained within.") - -(defconst markdown-regex-math-inline-double - "\\(?:^\\|[^\\]\\)\\(?1:\\$\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\$\\)" - "Regular expression for itex $$..$$ math mode expressions. -Groups 1 and 3 match opening and closing dollar signs. -Group 2 matches the mathematical expression contained within.") - -(defconst markdown-regex-math-display - (rx line-start (* blank) - (group (group (repeat 1 2 "\\")) "[") - (group (*? anything)) - (group (backref 2) "]") - line-end) - "Regular expression for \[..\] or \\[..\\] display math. -Groups 1 and 4 match the opening and closing markup. -Group 3 matches the mathematical expression contained within. -Group 2 matches the opening slashes, and is used internally to -match the closing slashes.") - -(defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line) - "Return regexp matching a tilde code fence at least NUM-TILDES long. -END-OF-LINE is the regexp construct to indicate end of line; $ if -missing." - (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes ",\\}\\)" - (or end-of-line "$"))) - -(defconst markdown-regex-tilde-fence-begin - (markdown-make-tilde-fence-regex - 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$") - "Regular expression for matching tilde-fenced code blocks. -Group 1 matches the opening tildes. -Group 2 matches (optional) opening brace and surrounding whitespace. -Group 3 matches the language identifier (optional). -Group 4 matches the info string (optional). -Group 5 matches the closing brace (optional) and any surrounding whitespace. -Groups need to agree with `markdown-regex-gfm-code-block-open'.") - -(defconst markdown-regex-declarative-metadata - "^[ \t]*\\(?:-[ \t]*\\)?\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$" - "Regular expression for matching declarative metadata statements. -This matches MultiMarkdown metadata as well as YAML and TOML -assignments such as the following: - - variable: value - -or - - variable = value") - -(defconst markdown-regex-pandoc-metadata - "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)" - "Regular expression for matching Pandoc metadata.") - -(defconst markdown-regex-yaml-metadata-border - "\\(-\\{3\\}\\)$" - "Regular expression for matching YAML metadata.") - -(defconst markdown-regex-yaml-pandoc-metadata-end-border - "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$" - "Regular expression for matching YAML metadata end borders.") - -(defsubst markdown-get-yaml-metadata-start-border () - "Return YAML metadata start border depending upon whether Pandoc is used." - (concat - (if markdown-use-pandoc-style-yaml-metadata "^" "\\`") - markdown-regex-yaml-metadata-border)) - -(defsubst markdown-get-yaml-metadata-end-border (_) - "Return YAML metadata end border depending upon whether Pandoc is used." - (if markdown-use-pandoc-style-yaml-metadata - markdown-regex-yaml-pandoc-metadata-end-border - markdown-regex-yaml-metadata-border)) - -(defconst markdown-regex-inline-attributes - "[ \t]*\\(?:{:?\\)[ \t]*\\(?:\\(?:#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"}]*['\"]?\\),?[ \t]*\\)+\\(?:}\\)[ \t]*$" - "Regular expression for matching inline identifiers or attribute lists. -Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.") - -(defconst markdown-regex-leanpub-sections - (concat - "^\\({\\)\\(" - (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak")) - "\\)\\(}\\)[ \t]*\n") - "Regular expression for Leanpub section markers and related syntax.") - -(defconst markdown-regex-sub-superscript - "\\(?:^\\|[^\\~^]\\)\\(?1:\\(?2:[~^]\\)\\(?3:[+-\u2212]?[[:alnum:]]+\\)\\(?4:\\2\\)\\)" - "The regular expression matching a sub- or superscript. -The leading un-numbered group matches the character before the -opening tilde or carat, if any, ensuring that it is not a -backslash escape, carat, or tilde. -Group 1 matches the entire expression, including markup. -Group 2 matches the opening markup--a tilde or carat. -Group 3 matches the text inside the delimiters. -Group 4 matches the closing markup--a tilde or carat.") - -(defconst markdown-regex-include - "^\\(?1:<<\\)\\(?:\\(?2:\\[\\)\\(?3:.*\\)\\(?4:\\]\\)\\)?\\(?:\\(?5:(\\)\\(?6:.*\\)\\(?7:)\\)\\)?\\(?:\\(?8:{\\)\\(?9:.*\\)\\(?10:}\\)\\)?$" - "Regular expression matching common forms of include syntax. -Marked 2, Leanpub, and other processors support some of these forms: - -<<[sections/section1.md] -<<(folder/filename) -<<[Code title](folder/filename) -<<{folder/raw_file.html} - -Group 1 matches the opening two angle brackets. -Groups 2-4 match the opening square bracket, the text inside, -and the closing square bracket, respectively. -Groups 5-7 match the opening parenthesis, the text inside, and -the closing parenthesis. -Groups 8-10 match the opening brace, the text inside, and the brace.") - -(defconst markdown-regex-pandoc-inline-footnote - "\\(?1:\\^\\)\\(?2:\\[\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\]\\)" - "Regular expression for Pandoc inline footnote^[footnote text]. -Group 1 matches the opening caret. -Group 2 matches the opening square bracket. -Group 3 matches the footnote text, without the surrounding markup. -Group 4 matches the closing square bracket.") - -(defconst markdown-regex-html-attr - "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?" - "Regular expression for matching HTML attributes and values. -Group 1 matches the attribute name. -Group 2 matches the following whitespace, equals sign, and value, if any. -Group 3 matches the equals sign, if any. -Group 4 matches single-, double-, or un-quoted attribute values.") - -(defconst markdown-regex-html-tag - (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr - "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)") - "Regular expression for matching HTML tags. -Groups 1 and 9 match the beginning and ending angle brackets and slashes. -Group 2 matches the tag name. -Group 3 matches all attributes and whitespace following the tag name.") - -(defconst markdown-regex-html-entity - "\\(&#?[[:alnum:]]+;\\)" - "Regular expression for matching HTML entities.") - -(defconst markdown-regex-highlighting - "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:==\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:==\\)\\)" -"Regular expression for matching highlighting text. -Group 1 matches the character before the opening equal, if any, -ensuring that it is not a backslash escape. -Group 2 matches the entire expression, including delimiters. -Groups 3 and 5 matches the opening and closing delimiters. -Group 4 matches the text inside the delimiters.") - - -;;; Syntax ==================================================================== - -(defvar markdown--syntax-properties - (list 'markdown-tilde-fence-begin nil - 'markdown-tilde-fence-end nil - 'markdown-fenced-code nil - 'markdown-yaml-metadata-begin nil - 'markdown-yaml-metadata-end nil - 'markdown-yaml-metadata-section nil - 'markdown-gfm-block-begin nil - 'markdown-gfm-block-end nil - 'markdown-gfm-code nil - 'markdown-list-item nil - 'markdown-pre nil - 'markdown-blockquote nil - 'markdown-hr nil - 'markdown-comment nil - 'markdown-heading nil - 'markdown-heading-1-setext nil - 'markdown-heading-2-setext nil - 'markdown-heading-1-atx nil - 'markdown-heading-2-atx nil - 'markdown-heading-3-atx nil - 'markdown-heading-4-atx nil - 'markdown-heading-5-atx nil - 'markdown-heading-6-atx nil - 'markdown-metadata-key nil - 'markdown-metadata-value nil - 'markdown-metadata-markup nil) - "Property list of all Markdown syntactic properties.") - -(defvar markdown-literal-faces - '(markdown-code-face - markdown-inline-code-face - markdown-pre-face - markdown-math-face - markdown-url-face - markdown-plain-url-face - markdown-language-keyword-face - markdown-language-info-face - markdown-metadata-key-face - markdown-metadata-value-face - markdown-html-entity-face - markdown-html-tag-name-face - markdown-html-tag-delimiter-face - markdown-html-attr-name-face - markdown-html-attr-value-face - markdown-reference-face - markdown-footnote-marker-face - markdown-line-break-face - markdown-comment-face) - "A list of markdown-mode faces that contain literal text. -Literal text treats backslashes literally, rather than as an -escape character (see `markdown-match-escape').") - -(defsubst markdown-in-comment-p (&optional pos) - "Return non-nil if POS is in a comment. -If POS is not given, use point instead." - (get-text-property (or pos (point)) 'markdown-comment)) - -(defun markdown--face-p (pos faces) - "Return non-nil if face of POS contain FACES." - (let ((face-prop (get-text-property pos 'face))) - (if (listp face-prop) - (cl-loop for face in face-prop - thereis (memq face faces)) - (memq face-prop faces)))) - -(defsubst markdown--math-block-p (&optional pos) - (when markdown-enable-math - (markdown--face-p (or pos (point)) '(markdown-math-face)))) - -(defun markdown-syntax-propertize-extend-region (start end) - "Extend START to END region to include an entire block of text. -This helps improve syntax analysis for block constructs. -Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made. -Function is called repeatedly until it returns nil. For details, see -`syntax-propertize-extend-region-functions'." - (save-match-data - (save-excursion - (let* ((new-start (progn (goto-char start) - (skip-chars-forward "\n") - (if (re-search-backward "\n\n" nil t) - (min start (match-end 0)) - (point-min)))) - (new-end (progn (goto-char end) - (skip-chars-backward "\n") - (if (re-search-forward "\n\n" nil t) - (max end (match-beginning 0)) - (point-max)))) - (code-match (markdown-code-block-at-pos new-start)) - ;; FIXME: The `code-match' can return bogus values - ;; when text has been inserted/deleted! - (new-start (min (or (and code-match (cl-first code-match)) - (point-max)) - new-start)) - (code-match (and (< end (point-max)) - (markdown-code-block-at-pos end))) - (new-end (max (or (and code-match (cl-second code-match)) 0) - new-end))) - - (unless (and (eq new-start start) (eq new-end end)) - (cons new-start (min new-end (point-max)))))))) - -(defun markdown-font-lock-extend-region-function (start end _) - "Used in `jit-lock-after-change-extend-region-functions'. -Delegates to `markdown-syntax-propertize-extend-region'. START -and END are the previous region to refontify." - (let ((res (markdown-syntax-propertize-extend-region start end))) - (when res - ;; syntax-propertize-function is not called when character at - ;; (point-max) is deleted, but font-lock-extend-region-functions - ;; are called. Force a syntax property update in that case. - (when (= end (point-max)) - ;; This function is called in a buffer modification hook. - ;; `markdown-syntax-propertize' doesn't save the match data, - ;; so we have to do it here. - (save-match-data - (markdown-syntax-propertize (car res) (cdr res)))) - (setq jit-lock-start (car res) - jit-lock-end (cdr res))))) - -(defun markdown--cur-list-item-bounds () - "Return a list describing the list item at point. -Assumes that match data is set for `markdown-regex-list'. See the -documentation for `markdown-cur-list-item-bounds' for the format of -the returned list." - (save-excursion - (let* ((begin (match-beginning 0)) - (indent (length (match-string-no-properties 1))) - (nonlist-indent (- (match-end 3) (match-beginning 0))) - (marker (buffer-substring-no-properties - (match-beginning 2) (match-end 3))) - (checkbox (match-string-no-properties 4)) - (match (butlast (match-data t))) - (end (markdown-cur-list-item-end nonlist-indent))) - (list begin end indent nonlist-indent marker checkbox match)))) - -(defun markdown--append-list-item-bounds (marker indent cur-bounds bounds) - "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS. -Here, MARKER is a string representing the type of list and INDENT -is an integer giving the indentation, in spaces, of the current -block. CUR-BOUNDS is a list of the form returned by -`markdown-cur-list-item-bounds' and BOUNDS is a list of bounds -values for parent list items. When BOUNDS is nil, it means we are -at baseline (not inside of a nested list)." - (let ((prev-indent (or (cl-third (car bounds)) 0))) - (cond - ;; New list item at baseline. - ((and marker (null bounds)) - (list cur-bounds)) - ;; List item with greater indentation (four or more spaces). - ;; Increase list level by consing CUR-BOUNDS onto BOUNDS. - ((and marker (>= indent (+ prev-indent markdown-list-indent-width))) - (cons cur-bounds bounds)) - ;; List item with greater or equal indentation (less than four spaces). - ;; Keep list level the same by replacing the car of BOUNDS. - ((and marker (>= indent prev-indent)) - (cons cur-bounds (cdr bounds))) - ;; Lesser indentation level. - ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser - ;; indentation could move back more than one list level). Note - ;; that this block need not be the beginning of list item. - ((< indent prev-indent) - (while (and (> (length bounds) 1) - (setq prev-indent (cl-third (cadr bounds))) - (< indent (+ prev-indent markdown-list-indent-width))) - (setq bounds (cdr bounds))) - (cons cur-bounds bounds)) - ;; Otherwise, do nothing. - (t bounds)))) - -(defun markdown-syntax-propertize-list-items (start end) - "Propertize list items from START to END. -Stores nested list item information in the `markdown-list-item' -text property to make later syntax analysis easier. The value of -this property is a list with elements of the form (begin . end) -giving the bounds of the current and parent list items." - (save-excursion - (goto-char start) - (let ((prev-list-line -100) - bounds level pre-regexp) - ;; Find a baseline point with zero list indentation - (markdown-search-backward-baseline) - ;; Search for all list items between baseline and END - (while (and (< (point) end) - (re-search-forward markdown-regex-list end 'limit)) - ;; Level of list nesting - (setq level (length bounds)) - ;; Pre blocks need to be indented one level past the list level - (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ level))) - (beginning-of-line) - (cond - ;; Reset at headings, horizontal rules, and top-level blank lines. - ;; Propertize baseline when in range. - ((markdown-new-baseline) - (setq bounds nil)) - ;; Make sure this is not a line from a pre block - ((and (looking-at-p pre-regexp) - ;; too indented line is also treated as list if previous line is list - (>= (- (line-number-at-pos) prev-list-line) 2))) - ;; If not, then update levels and propertize list item when in range. - (t - (let* ((indent (current-indentation)) - (cur-bounds (markdown--cur-list-item-bounds)) - (first (cl-first cur-bounds)) - (last (cl-second cur-bounds)) - (marker (cl-fifth cur-bounds))) - (setq bounds (markdown--append-list-item-bounds - marker indent cur-bounds bounds)) - (when (and (<= start (point)) (<= (point) end)) - (setq prev-list-line (line-number-at-pos first)) - (put-text-property first last 'markdown-list-item bounds))))) - (end-of-line))))) - -(defun markdown-syntax-propertize-pre-blocks (start end) - "Match preformatted text blocks from START to END." - (save-excursion - (goto-char start) - (let (finish) - ;; Use loop for avoiding too many recursive calls - ;; https://github.com/jrblevin/markdown-mode/issues/512 - (while (not finish) - (let ((levels (markdown-calculate-list-levels)) - indent pre-regexp close-regexp open close) - (while (and (< (point) end) (not close)) - ;; Search for a region with sufficient indentation - (if (null levels) - (setq indent 1) - (setq indent (1+ (length levels)))) - (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" indent)) - (setq close-regexp (format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent))) - - (cond - ;; If not at the beginning of a line, move forward - ((not (bolp)) (forward-line)) - ;; Move past blank lines - ((markdown-cur-line-blank-p) (forward-line)) - ;; At headers and horizontal rules, reset levels - ((markdown-new-baseline) (forward-line) (setq levels nil)) - ;; If the current line has sufficient indentation, mark out pre block - ;; The opening should be preceded by a blank line. - ((and (markdown-prev-line-blank) (looking-at pre-regexp)) - (setq open (match-beginning 0)) - (while (and (or (looking-at-p pre-regexp) (markdown-cur-line-blank-p)) - (not (eobp))) - (forward-line)) - (skip-syntax-backward "-") - (forward-line) - (setq close (point))) - ;; If current line has a list marker, update levels, move to end of block - ((looking-at markdown-regex-list) - (setq levels (markdown-update-list-levels - (match-string 2) (current-indentation) levels)) - (markdown-end-of-text-block)) - ;; If this is the end of the indentation level, adjust levels accordingly. - ;; Only match end of indentation level if levels is not the empty list. - ((and (car levels) (looking-at-p close-regexp)) - (setq levels (markdown-update-list-levels - nil (current-indentation) levels)) - (markdown-end-of-text-block)) - (t (markdown-end-of-text-block)))) - - (if (and open close) - ;; Set text property data and continue to search - (put-text-property open close 'markdown-pre (list open close)) - (setq finish t)))) - nil))) - -(defconst markdown-fenced-block-pairs - `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin) - (markdown-make-tilde-fence-regex markdown-tilde-fence-end) - markdown-fenced-code) - ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin) - (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end) - markdown-yaml-metadata-section) - ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin) - (,markdown-regex-gfm-code-block-close markdown-gfm-block-end) - markdown-gfm-code)) - "Mapping of regular expressions to \"fenced-block\" constructs. -These constructs are distinguished by having a distinctive start -and end pattern, both of which take up an entire line of text, -but no special pattern to identify text within the fenced -blocks (unlike blockquotes and indented-code sections). - -Each element within this list takes the form: - - ((START-REGEX-OR-FUN START-PROPERTY) - (END-REGEX-OR-FUN END-PROPERTY) - MIDDLE-PROPERTY) - -Each *-REGEX-OR-FUN element can be a regular expression as a string, or a -function which evaluates to same. Functions for START-REGEX-OR-FUN accept no -arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument -which is the length of the first group of the START-REGEX-OR-FUN match, which -can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to -evaluate these into \"real\" regexps. - -The *-PROPERTY elements are the text properties applied to each part of the -block construct when it is matched using -`markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied -to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and -MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the -`match-data' when the regexp was matched to the text. In the case of -MIDDLE-PROPERTY, the value is a false match data of the form \\='(begin end), with -begin and end set to the edges of the \"middle\" text. This makes fontification -easier.") - -(defun markdown-text-property-at-point (prop) - (get-text-property (point) prop)) - -(defsubst markdown-maybe-funcall-regexp (object &optional arg) - (cond ((functionp object) - (if arg (funcall object arg) (funcall object))) - ((stringp object) object) - (t (error "Object cannot be turned into regex")))) - -(defsubst markdown-get-start-fence-regexp () - "Return regexp to find all \"start\" sections of fenced block constructs. -Which construct is actually contained in the match must be found separately." - (mapconcat - #'identity - (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry))) - markdown-fenced-block-pairs) - "\\|")) - -(defun markdown-get-fenced-block-begin-properties () - (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs)) - -(defun markdown-get-fenced-block-end-properties () - (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs)) - -(defun markdown-get-fenced-block-middle-properties () - (cl-mapcar #'cl-third markdown-fenced-block-pairs)) - -(defun markdown-find-previous-prop (prop &optional lim) - "Find previous place where property PROP is non-nil, up to LIM. -Return a cons of (pos . property). pos is point if point contains -non-nil PROP." - (let ((res - (if (get-text-property (point) prop) (point) - (previous-single-property-change - (point) prop nil (or lim (point-min)))))) - (when (and (not (get-text-property res prop)) - (> res (point-min)) - (get-text-property (1- res) prop)) - (cl-decf res)) - (when (and res (get-text-property res prop)) (cons res prop)))) - -(defun markdown-find-next-prop (prop &optional lim) - "Find next place where property PROP is non-nil, up to LIM. -Return a cons of (POS . PROPERTY) where POS is point if point -contains non-nil PROP." - (let ((res - (if (get-text-property (point) prop) (point) - (next-single-property-change - (point) prop nil (or lim (point-max)))))) - (when (and res (get-text-property res prop)) (cons res prop)))) - -(defun markdown-min-of-seq (map-fn seq) - "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN." - (cl-loop for el in seq - with min = 1.0e+INF ; infinity - with min-el = nil - do (let ((res (funcall map-fn el))) - (when (< res min) - (setq min res) - (setq min-el el))) - finally return min-el)) - -(defun markdown-max-of-seq (map-fn seq) - "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN." - (cl-loop for el in seq - with max = -1.0e+INF ; negative infinity - with max-el = nil - do (let ((res (funcall map-fn el))) - (when (and res (> res max)) - (setq max res) - (setq max-el el))) - finally return max-el)) - -(defun markdown-find-previous-block () - "Find previous block. -Detect whether `markdown-syntax-propertize-fenced-block-constructs' was -unable to propertize the entire block, but was able to propertize the beginning -of the block. If so, return a cons of (pos . property) where the beginning of -the block was propertized." - (let ((start-pt (point)) - (closest-open - (markdown-max-of-seq - #'car - (cl-remove-if - #'null - (cl-mapcar - #'markdown-find-previous-prop - (markdown-get-fenced-block-begin-properties)))))) - (when closest-open - (let* ((length-of-open-match - (let ((match-d - (get-text-property (car closest-open) (cdr closest-open)))) - (- (cl-fourth match-d) (cl-third match-d)))) - (end-regexp - (markdown-maybe-funcall-regexp - (cl-caadr - (cl-find-if - (lambda (entry) (eq (cl-cadar entry) (cdr closest-open))) - markdown-fenced-block-pairs)) - length-of-open-match)) - (end-prop-loc - (save-excursion - (save-match-data - (goto-char (car closest-open)) - (and (re-search-forward end-regexp start-pt t) - (match-beginning 0)))))) - (and (not end-prop-loc) closest-open))))) - -(defun markdown-get-fenced-block-from-start (prop) - "Return limits of an enclosing fenced block from its start, using PROP. -Return value is a list usable as `match-data'." - (catch 'no-rest-of-block - (let* ((correct-entry - (cl-find-if - (lambda (entry) (eq (cl-cadar entry) prop)) - markdown-fenced-block-pairs)) - (begin-of-begin (cl-first (markdown-text-property-at-point prop))) - (middle-prop (cl-third correct-entry)) - (end-prop (cl-cadadr correct-entry)) - (end-of-end - (save-excursion - (goto-char (match-end 0)) ; end of begin - (unless (eobp) (forward-char)) - (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) - (if (not mid-prop-v) ; no middle - (progn - ;; try to find end by advancing one - (let ((end-prop-v - (markdown-text-property-at-point end-prop))) - (if end-prop-v (cl-second end-prop-v) - (throw 'no-rest-of-block nil)))) - (set-match-data mid-prop-v) - (goto-char (match-end 0)) ; end of middle - (beginning-of-line) ; into end - (cl-second (markdown-text-property-at-point end-prop))))))) - (list begin-of-begin end-of-end)))) - -(defun markdown-get-fenced-block-from-middle (prop) - "Return limits of an enclosing fenced block from its middle, using PROP. -Return value is a list usable as `match-data'." - (let* ((correct-entry - (cl-find-if - (lambda (entry) (eq (cl-third entry) prop)) - markdown-fenced-block-pairs)) - (begin-prop (cl-cadar correct-entry)) - (begin-of-begin - (save-excursion - (goto-char (match-beginning 0)) - (unless (bobp) (forward-line -1)) - (beginning-of-line) - (cl-first (markdown-text-property-at-point begin-prop)))) - (end-prop (cl-cadadr correct-entry)) - (end-of-end - (save-excursion - (goto-char (match-end 0)) - (beginning-of-line) - (cl-second (markdown-text-property-at-point end-prop))))) - (list begin-of-begin end-of-end))) - -(defun markdown-get-fenced-block-from-end (prop) - "Return limits of an enclosing fenced block from its end, using PROP. -Return value is a list usable as `match-data'." - (let* ((correct-entry - (cl-find-if - (lambda (entry) (eq (cl-cadadr entry) prop)) - markdown-fenced-block-pairs)) - (end-of-end (cl-second (markdown-text-property-at-point prop))) - (middle-prop (cl-third correct-entry)) - (begin-prop (cl-cadar correct-entry)) - (begin-of-begin - (save-excursion - (goto-char (match-beginning 0)) ; beginning of end - (unless (bobp) (backward-char)) ; into middle - (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) - (if (not mid-prop-v) - (progn - (beginning-of-line) - (cl-first (markdown-text-property-at-point begin-prop))) - (set-match-data mid-prop-v) - (goto-char (match-beginning 0)) ; beginning of middle - (unless (bobp) (forward-line -1)) ; into beginning - (beginning-of-line) - (cl-first (markdown-text-property-at-point begin-prop))))))) - (list begin-of-begin end-of-end))) - -(defun markdown-get-enclosing-fenced-block-construct (&optional pos) - "Get \"fake\" match data for block enclosing POS. -Returns fake match data which encloses the start, middle, and end -of the block construct enclosing POS, if it exists. Used in -`markdown-code-block-at-pos'." - (save-excursion - (when pos (goto-char pos)) - (beginning-of-line) - (car - (cl-remove-if - #'null - (cl-mapcar - (lambda (fun-and-prop) - (cl-destructuring-bind (fun prop) fun-and-prop - (when prop - (save-match-data - (set-match-data (markdown-text-property-at-point prop)) - (funcall fun prop))))) - `((markdown-get-fenced-block-from-start - ,(cl-find-if - #'markdown-text-property-at-point - (markdown-get-fenced-block-begin-properties))) - (markdown-get-fenced-block-from-middle - ,(cl-find-if - #'markdown-text-property-at-point - (markdown-get-fenced-block-middle-properties))) - (markdown-get-fenced-block-from-end - ,(cl-find-if - #'markdown-text-property-at-point - (markdown-get-fenced-block-end-properties))))))))) - -(defun markdown-propertize-end-match (reg end fence-spec middle-begin) - "Get match for REG up to END, if exists, and propertize appropriately. -FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and -MIDDLE-BEGIN is the start of the \"middle\" section of the block." - (when (re-search-forward reg end t) - (let ((close-begin (match-beginning 0)) ; Start of closing line. - (close-end (match-end 0)) ; End of closing line. - (close-data (match-data t))) ; Match data for closing line. - ;; Propertize middle section of fenced block. - (put-text-property middle-begin close-begin - (cl-third fence-spec) - (list middle-begin close-begin)) - ;; If the block is a YAML block, propertize the declarations inside - (when (< middle-begin close-begin) ;; workaround #634 - (markdown-syntax-propertize-yaml-metadata middle-begin close-begin)) - ;; Propertize closing line of fenced block. - (put-text-property close-begin close-end - (cl-cadadr fence-spec) close-data)))) - -(defun markdown--triple-quote-single-line-p (begin) - (save-excursion - (goto-char begin) - (save-match-data - (and (search-forward "```" nil t) - (search-forward "```" (line-end-position) t))))) - -(defun markdown-syntax-propertize-fenced-block-constructs (start end) - "Propertize according to `markdown-fenced-block-pairs' from START to END. -If unable to propertize an entire block (if the start of a block is within START -and END, but the end of the block is not), propertize the start section of a -block, then in a subsequent call propertize both middle and end by finding the -start which was previously propertized." - (let ((start-reg (markdown-get-start-fence-regexp))) - (save-excursion - (goto-char start) - ;; start from previous unclosed block, if exists - (let ((prev-begin-block (markdown-find-previous-block))) - (when prev-begin-block - (let* ((correct-entry - (cl-find-if (lambda (entry) - (eq (cdr prev-begin-block) (cl-cadar entry))) - markdown-fenced-block-pairs)) - (enclosed-text-start (1+ (car prev-begin-block))) - (start-length - (save-excursion - (goto-char (car prev-begin-block)) - (string-match - (markdown-maybe-funcall-regexp - (caar correct-entry)) - (buffer-substring - (line-beginning-position) (line-end-position))) - (- (match-end 1) (match-beginning 1)))) - (end-reg (markdown-maybe-funcall-regexp - (cl-caadr correct-entry) start-length))) - (markdown-propertize-end-match - end-reg end correct-entry enclosed-text-start)))) - ;; find all new blocks within region - (while (re-search-forward start-reg end t) - ;; we assume the opening constructs take up (only) an entire line, - ;; so we re-check the current line - (let* ((block-start (match-beginning 0)) - (cur-line (buffer-substring (line-beginning-position) (line-end-position))) - ;; find entry in `markdown-fenced-block-pairs' corresponding - ;; to regex which was matched - (correct-entry - (cl-find-if - (lambda (fenced-pair) - (string-match-p - (markdown-maybe-funcall-regexp (caar fenced-pair)) - cur-line)) - markdown-fenced-block-pairs)) - (enclosed-text-start - (save-excursion (1+ (line-end-position)))) - (end-reg - (markdown-maybe-funcall-regexp - (cl-caadr correct-entry) - (if (and (match-beginning 1) (match-end 1)) - (- (match-end 1) (match-beginning 1)) - 0))) - (prop (cl-cadar correct-entry))) - (when (or (not (eq prop 'markdown-gfm-block-begin)) - (not (markdown--triple-quote-single-line-p block-start))) - ;; get correct match data - (save-excursion - (beginning-of-line) - (re-search-forward - (markdown-maybe-funcall-regexp (caar correct-entry)) - (line-end-position))) - ;; mark starting, even if ending is outside of region - (put-text-property (match-beginning 0) (match-end 0) prop (match-data t)) - (markdown-propertize-end-match - end-reg end correct-entry enclosed-text-start))))))) - -(defun markdown-syntax-propertize-blockquotes (start end) - "Match blockquotes from START to END." - (save-excursion - (goto-char start) - (while (and (re-search-forward markdown-regex-blockquote end t) - (not (markdown-code-block-at-pos (match-beginning 0)))) - (put-text-property (match-beginning 0) (match-end 0) - 'markdown-blockquote - (match-data t))))) - -(defun markdown-syntax-propertize-hrs (start end) - "Match horizontal rules from START to END." - (save-excursion - (goto-char start) - (while (re-search-forward markdown-regex-hr end t) - (let ((beg (match-beginning 0)) - (end (match-end 0))) - (goto-char beg) - (unless (or (markdown-on-heading-p) - (markdown-code-block-at-point-p)) - (put-text-property beg end 'markdown-hr (match-data t))) - (goto-char end))))) - -(defun markdown-syntax-propertize-yaml-metadata (start end) - "Propertize elements inside YAML metadata blocks from START to END. -Assumes region from START and END is already known to be the interior -region of a YAML metadata block as propertized by -`markdown-syntax-propertize-fenced-block-constructs'." - (save-excursion - (goto-char start) - (cl-loop - while (re-search-forward markdown-regex-declarative-metadata end t) - do (progn - (put-text-property (match-beginning 1) (match-end 1) - 'markdown-metadata-key (match-data t)) - (put-text-property (match-beginning 2) (match-end 2) - 'markdown-metadata-markup (match-data t)) - (put-text-property (match-beginning 3) (match-end 3) - 'markdown-metadata-value (match-data t)))))) - -(defun markdown-syntax-propertize-headings (start end) - "Match headings of type SYMBOL with REGEX from START to END." - (goto-char start) - (while (re-search-forward markdown-regex-header end t) - (unless (markdown-code-block-at-pos (match-beginning 0)) - (put-text-property - (match-beginning 0) (match-end 0) 'markdown-heading - (match-data t)) - (put-text-property - (match-beginning 0) (match-end 0) - (cond ((match-string-no-properties 2) 'markdown-heading-1-setext) - ((match-string-no-properties 3) 'markdown-heading-2-setext) - (t (let ((atx-level (length (markdown-trim-whitespace - (match-string-no-properties 4))))) - (intern (format "markdown-heading-%d-atx" atx-level))))) - (match-data t))))) - -(defun markdown-syntax-propertize-comments (start end) - "Match HTML comments from the START to END." - ;; Implement by loop instead of recursive call for avoiding - ;; exceed max-lisp-eval-depth issue - ;; https://github.com/jrblevin/markdown-mode/issues/536 - (let (finish) - (goto-char start) - (while (not finish) - (let* ((in-comment (nth 4 (syntax-ppss))) - (comment-begin (nth 8 (syntax-ppss)))) - (cond - ;; Comment start - ((and (not in-comment) - (re-search-forward markdown-regex-comment-start end t) - (not (markdown-inline-code-at-point-p)) - (not (markdown-code-block-at-point-p))) - (let ((open-beg (match-beginning 0))) - (put-text-property open-beg (1+ open-beg) - 'syntax-table (string-to-syntax "<")) - (goto-char (min (1+ (match-end 0)) end (point-max))))) - ;; Comment end - ((and in-comment comment-begin - (re-search-forward markdown-regex-comment-end end t)) - (let ((comment-end (match-end 0))) - (put-text-property (1- comment-end) comment-end - 'syntax-table (string-to-syntax ">")) - ;; Remove any other text properties inside the comment - (remove-text-properties comment-begin comment-end - markdown--syntax-properties) - (put-text-property comment-begin comment-end - 'markdown-comment (list comment-begin comment-end)) - (goto-char (min comment-end end (point-max))))) - ;; Nothing found - (t (setq finish t))))) - nil)) - -(defun markdown-syntax-propertize (start end) - "Function used as `syntax-propertize-function'. -START and END delimit region to propertize." - (with-silent-modifications - (save-excursion - (remove-text-properties start end markdown--syntax-properties) - (markdown-syntax-propertize-fenced-block-constructs start end) - (markdown-syntax-propertize-list-items start end) - (markdown-syntax-propertize-pre-blocks start end) - (markdown-syntax-propertize-blockquotes start end) - (markdown-syntax-propertize-headings start end) - (markdown-syntax-propertize-hrs start end) - (markdown-syntax-propertize-comments start end)))) - - -;;; Markup Hiding ============================================================= - -(defconst markdown-markup-properties - '(face markdown-markup-face invisible markdown-markup) - "List of properties and values to apply to markup.") - -(defconst markdown-line-break-properties - '(face markdown-line-break-face invisible markdown-markup) - "List of properties and values to apply to line break markup.") - -(defconst markdown-language-keyword-properties - '(face markdown-language-keyword-face invisible markdown-markup) - "List of properties and values to apply to code block language names.") - -(defconst markdown-language-info-properties - '(face markdown-language-info-face invisible markdown-markup) - "List of properties and values to apply to code block language info strings.") - -(defconst markdown-include-title-properties - '(face markdown-link-title-face invisible markdown-markup) - "List of properties and values to apply to included code titles.") - -(defcustom markdown-hide-markup nil - "Determines whether markup in the buffer will be hidden. -When set to nil, all markup is displayed in the buffer as it -appears in the file. An exception is when `markdown-hide-urls' -is non-nil. -Set this to a non-nil value to turn this feature on by default. -You can interactively toggle the value of this variable with -`markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding], -or from the Markdown > Show & Hide menu. - -Markup hiding works by adding text properties to positions in the -buffer---either the `invisible' property or the `display' property -in cases where alternative glyphs are used (e.g., list bullets). -This does not, however, affect printing or other output. -Functions such as `htmlfontify-buffer' and `ps-print-buffer' will -not honor these text properties. For printing, it would be better -to first convert to HTML or PDF (e.g,. using Pandoc)." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.3")) -(make-variable-buffer-local 'markdown-hide-markup) - -(defun markdown-toggle-markup-hiding (&optional arg) - "Toggle the display or hiding of markup. -With a prefix argument ARG, enable markup hiding if ARG is positive, -and disable it otherwise. -See `markdown-hide-markup' for additional details." - (interactive (list (or current-prefix-arg 'toggle))) - (setq markdown-hide-markup - (if (eq arg 'toggle) - (not markdown-hide-markup) - (> (prefix-numeric-value arg) 0))) - (if markdown-hide-markup - (add-to-invisibility-spec 'markdown-markup) - (remove-from-invisibility-spec 'markdown-markup)) - (when (called-interactively-p 'interactive) - (message "markdown-mode markup hiding %s" (if markdown-hide-markup "enabled" "disabled"))) - (markdown-reload-extensions)) - - -;;; Font Lock ================================================================= - -(require 'font-lock) - -(defgroup markdown-faces nil - "Faces used in Markdown Mode." - :group 'markdown - :group 'faces) - -(defface markdown-italic-face - '((t (:inherit italic))) - "Face for italic text." - :group 'markdown-faces) - -(defface markdown-bold-face - '((t (:inherit bold))) - "Face for bold text." - :group 'markdown-faces) - -(defface markdown-strike-through-face - '((t (:strike-through t))) - "Face for strike-through text." - :group 'markdown-faces) - -(defface markdown-markup-face - '((t (:inherit shadow :slant normal :weight normal))) - "Face for markup elements." - :group 'markdown-faces) - -(defface markdown-header-rule-face - '((t (:inherit markdown-markup-face))) - "Base face for headers rules." - :group 'markdown-faces) - -(defface markdown-header-delimiter-face - '((t (:inherit markdown-markup-face))) - "Base face for headers hash delimiter." - :group 'markdown-faces) - -(defface markdown-list-face - '((t (:inherit markdown-markup-face))) - "Face for list item markers." - :group 'markdown-faces) - -(defface markdown-blockquote-face - '((t (:inherit font-lock-doc-face))) - "Face for blockquote sections." - :group 'markdown-faces) - -(defface markdown-code-face - '((t (:inherit fixed-pitch))) - "Face for inline code, pre blocks, and fenced code blocks. -This may be used, for example, to add a contrasting background to -inline code fragments and code blocks." - :group 'markdown-faces) - -(defface markdown-inline-code-face - '((t (:inherit (markdown-code-face font-lock-constant-face)))) - "Face for inline code." - :group 'markdown-faces) - -(defface markdown-pre-face - '((t (:inherit (markdown-code-face font-lock-constant-face)))) - "Face for preformatted text." - :group 'markdown-faces) - -(defface markdown-table-face - '((t (:inherit (markdown-code-face)))) - "Face for tables." - :group 'markdown-faces) - -(defface markdown-language-keyword-face - '((t (:inherit font-lock-type-face))) - "Face for programming language identifiers." - :group 'markdown-faces) - -(defface markdown-language-info-face - '((t (:inherit font-lock-string-face))) - "Face for programming language info strings." - :group 'markdown-faces) - -(defface markdown-link-face - '((t (:inherit link))) - "Face for links." - :group 'markdown-faces) - -(defface markdown-missing-link-face - '((t (:inherit font-lock-warning-face))) - "Face for missing links." - :group 'markdown-faces) - -(defface markdown-reference-face - '((t (:inherit markdown-markup-face))) - "Face for link references." - :group 'markdown-faces) - -(defface markdown-footnote-marker-face - '((t (:inherit markdown-markup-face))) - "Face for footnote markers." - :group 'markdown-faces) - -(defface markdown-footnote-text-face - '((t (:inherit font-lock-comment-face))) - "Face for footnote text." - :group 'markdown-faces) - -(defface markdown-url-face - '((t (:inherit font-lock-string-face))) - "Face for URLs that are part of markup. -For example, this applies to URLs in inline links: -[link text](http://example.com/)." - :group 'markdown-faces) - -(defface markdown-plain-url-face - '((t (:inherit markdown-link-face))) - "Face for URLs that are also links. -For example, this applies to plain angle bracket URLs: -<http://example.com/>." - :group 'markdown-faces) - -(defface markdown-link-title-face - '((t (:inherit font-lock-comment-face))) - "Face for reference link titles." - :group 'markdown-faces) - -(defface markdown-line-break-face - '((t (:inherit font-lock-constant-face :underline t))) - "Face for hard line breaks." - :group 'markdown-faces) - -(defface markdown-comment-face - '((t (:inherit font-lock-comment-face))) - "Face for HTML comments." - :group 'markdown-faces) - -(defface markdown-math-face - '((t (:inherit font-lock-string-face))) - "Face for LaTeX expressions." - :group 'markdown-faces) - -(defface markdown-metadata-key-face - '((t (:inherit font-lock-variable-name-face))) - "Face for metadata keys." - :group 'markdown-faces) - -(defface markdown-metadata-value-face - '((t (:inherit font-lock-string-face))) - "Face for metadata values." - :group 'markdown-faces) - -(defface markdown-gfm-checkbox-face - '((t (:inherit font-lock-builtin-face))) - "Face for GFM checkboxes." - :group 'markdown-faces) - -(defface markdown-highlight-face - '((t (:inherit highlight))) - "Face for mouse highlighting." - :group 'markdown-faces) - -(defface markdown-hr-face - '((t (:inherit markdown-markup-face))) - "Face for horizontal rules." - :group 'markdown-faces) - -(defface markdown-html-tag-name-face - '((t (:inherit font-lock-type-face))) - "Face for HTML tag names." - :group 'markdown-faces) - -(defface markdown-html-tag-delimiter-face - '((t (:inherit markdown-markup-face))) - "Face for HTML tag delimiters." - :group 'markdown-faces) - -(defface markdown-html-attr-name-face - '((t (:inherit font-lock-variable-name-face))) - "Face for HTML attribute names." - :group 'markdown-faces) - -(defface markdown-html-attr-value-face - '((t (:inherit font-lock-string-face))) - "Face for HTML attribute values." - :group 'markdown-faces) - -(defface markdown-html-entity-face - '((t (:inherit font-lock-variable-name-face))) - "Face for HTML entities." - :group 'markdown-faces) - -(defface markdown-highlighting-face - '((t (:background "yellow" :foreground "black"))) - "Face for highlighting." - :group 'markdown-faces) - -(defcustom markdown-header-scaling nil - "Whether to use variable-height faces for headers. -When non-nil, `markdown-header-face' will inherit from -`variable-pitch' and the scaling values in -`markdown-header-scaling-values' will be applied to -headers of levels one through six respectively." - :type 'boolean - :initialize #'custom-initialize-default - :set (lambda (symbol value) - (set-default symbol value) - (markdown-update-header-faces value)) - :group 'markdown-faces - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-header-scaling-values - '(2.0 1.7 1.4 1.1 1.0 1.0) - "List of scaling values for headers of level one through six. -Used when `markdown-header-scaling' is non-nil." - :type '(repeat float) - :initialize #'custom-initialize-default - :set (lambda (symbol value) - (set-default symbol value) - (markdown-update-header-faces markdown-header-scaling value))) - -(defmacro markdown--dotimes-when-compile (i-n body) - (declare (indent 1) (debug ((symbolp form) form))) - (let ((var (car i-n)) - (n (cadr i-n)) - (code ())) - (dotimes (i (eval n t)) - (push (eval body `((,var . ,i))) code)) - `(progn ,@(nreverse code)))) - -(defface markdown-header-face - `((t (:inherit (,@(when markdown-header-scaling '(variable-pitch)) - font-lock-function-name-face) - :weight bold))) - "Base face for headers.") - -(markdown--dotimes-when-compile (num 6) - (let* ((num1 (1+ num)) - (face-name (intern (format "markdown-header-face-%s" num1)))) - `(defface ,face-name - (,'\` ((t (:inherit markdown-header-face - :height - (,'\, (if markdown-header-scaling - (float (nth ,num markdown-header-scaling-values)) - 1.0)))))) - (format "Face for level %s headers. -You probably don't want to customize this face directly. Instead -you can customize the base face `markdown-header-face' or the -variable-height variable `markdown-header-scaling'." ,num1)))) - -(defun markdown-update-header-faces (&optional scaling scaling-values) - "Update header faces, depending on if header SCALING is desired. -If so, use given list of SCALING-VALUES relative to the baseline -size of `markdown-header-face'." - (dotimes (num 6) - (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num)))) - (scale (cond ((not scaling) 1.0) - (scaling-values (float (nth num scaling-values))) - (t (float (nth num markdown-header-scaling-values)))))) - (unless (get face-name 'saved-face) ; Don't update customized faces - (set-face-attribute face-name nil :height scale))))) - -(defun markdown-syntactic-face (state) - "Return font-lock face for characters with given STATE. -See `font-lock-syntactic-face-function' for details." - (let ((in-comment (nth 4 state))) - (cond - (in-comment 'markdown-comment-face) - (t nil)))) - -(defcustom markdown-list-item-bullets - '("●" "◎" "○" "◆" "◇" "►" "•") - "List of bullets to use for unordered lists. -It can contain any number of symbols, which will be repeated. -Depending on your font, some reasonable choices are: -♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ❀ ◆ ◖ ▶ ► • ★ ▸." - :group 'markdown - :type '(repeat (string :tag "Bullet character")) - :package-version '(markdown-mode . "2.3")) - -(defun markdown--footnote-marker-properties () - "Return a font-lock facespec expression for footnote marker text." - `(face markdown-footnote-marker-face - ,@(when markdown-hide-markup - `(display ,markdown-footnote-display)))) - -(defun markdown--pandoc-inline-footnote-properties () - "Return a font-lock facespec expression for Pandoc inline footnote text." - `(face markdown-footnote-text-face - ,@(when markdown-hide-markup - `(display ,markdown-footnote-display)))) - -(defvar markdown-mode-font-lock-keywords - `((markdown-match-yaml-metadata-begin . ((1 'markdown-markup-face))) - (markdown-match-yaml-metadata-end . ((1 'markdown-markup-face))) - (markdown-match-yaml-metadata-key . ((1 'markdown-metadata-key-face) - (2 'markdown-markup-face) - (3 'markdown-metadata-value-face))) - (markdown-match-gfm-open-code-blocks . ((1 markdown-markup-properties) - (2 markdown-markup-properties nil t) - (3 markdown-language-keyword-properties nil t) - (4 markdown-language-info-properties nil t) - (5 markdown-markup-properties nil t))) - (markdown-match-gfm-close-code-blocks . ((0 markdown-markup-properties))) - (markdown-fontify-gfm-code-blocks) - (markdown-fontify-tables) - (markdown-match-fenced-start-code-block . ((1 markdown-markup-properties) - (2 markdown-markup-properties nil t) - (3 markdown-language-keyword-properties nil t) - (4 markdown-language-info-properties nil t) - (5 markdown-markup-properties nil t))) - (markdown-match-fenced-end-code-block . ((0 markdown-markup-properties))) - (markdown-fontify-fenced-code-blocks) - (markdown-match-pre-blocks . ((0 'markdown-pre-face))) - (markdown-fontify-headings) - (markdown-match-declarative-metadata . ((1 'markdown-metadata-key-face) - (2 'markdown-markup-face) - (3 'markdown-metadata-value-face))) - (markdown-match-pandoc-metadata . ((1 'markdown-markup-face) - (2 'markdown-markup-face) - (3 'markdown-metadata-value-face))) - (markdown-fontify-hrs) - (markdown-match-code . ((1 markdown-markup-properties prepend) - (2 'markdown-inline-code-face prepend) - (3 markdown-markup-properties prepend))) - (,markdown-regex-kbd . ((1 markdown-markup-properties) - (2 'markdown-inline-code-face) - (3 markdown-markup-properties))) - (markdown-fontify-angle-uris) - (,markdown-regex-email . 'markdown-plain-url-face) - (markdown-match-html-tag . ((1 'markdown-html-tag-delimiter-face t) - (2 'markdown-html-tag-name-face t) - (3 'markdown-html-tag-delimiter-face t) - ;; Anchored matcher for HTML tag attributes - (,markdown-regex-html-attr - ;; Before searching, move past tag - ;; name; set limit at tag close. - (progn - (goto-char (match-end 2)) (match-end 3)) - nil - . ((1 'markdown-html-attr-name-face) - (3 'markdown-html-tag-delimiter-face nil t) - (4 'markdown-html-attr-value-face nil t))))) - (,markdown-regex-html-entity . 'markdown-html-entity-face) - (markdown-fontify-list-items) - (,markdown-regex-footnote . ((1 markdown-markup-properties) ; [^ - (2 (markdown--footnote-marker-properties)) ; label - (3 markdown-markup-properties))) ; ] - (,markdown-regex-pandoc-inline-footnote . ((1 markdown-markup-properties) ; ^ - (2 markdown-markup-properties) ; [ - (3 (markdown--pandoc-inline-footnote-properties)) ; text - (4 markdown-markup-properties))) ; ] - (markdown-match-includes . ((1 markdown-markup-properties) - (2 markdown-markup-properties nil t) - (3 markdown-include-title-properties nil t) - (4 markdown-markup-properties nil t) - (5 markdown-markup-properties) - (6 'markdown-url-face) - (7 markdown-markup-properties))) - (markdown-fontify-inline-links) - (markdown-fontify-reference-links) - (,markdown-regex-reference-definition . ((1 'markdown-markup-face) ; [ - (2 'markdown-reference-face) ; label - (3 'markdown-markup-face) ; ] - (4 'markdown-markup-face) ; : - (5 'markdown-url-face) ; url - (6 'markdown-link-title-face))) ; "title" (optional) - (markdown-fontify-plain-uris) - ;; Math mode $..$ - (markdown-match-math-single . ((1 'markdown-markup-face prepend) - (2 'markdown-math-face append) - (3 'markdown-markup-face prepend))) - ;; Math mode $$..$$ - (markdown-match-math-double . ((1 'markdown-markup-face prepend) - (2 'markdown-math-face append) - (3 'markdown-markup-face prepend))) - ;; Math mode \[..\] and \\[..\\] - (markdown-match-math-display . ((1 'markdown-markup-face prepend) - (3 'markdown-math-face append) - (4 'markdown-markup-face prepend))) - (markdown-match-bold . ((1 markdown-markup-properties prepend) - (2 'markdown-bold-face append) - (3 markdown-markup-properties prepend))) - (markdown-match-italic . ((1 markdown-markup-properties prepend) - (2 'markdown-italic-face append) - (3 markdown-markup-properties prepend))) - (,markdown-regex-strike-through . ((3 markdown-markup-properties) - (4 'markdown-strike-through-face) - (5 markdown-markup-properties))) - (markdown--match-highlighting . ((3 markdown-markup-properties) - (4 'markdown-highlighting-face) - (5 markdown-markup-properties))) - (,markdown-regex-line-break . (1 markdown-line-break-properties prepend)) - (markdown-match-escape . ((1 markdown-markup-properties prepend))) - (markdown-fontify-sub-superscripts) - (markdown-match-inline-attributes . ((0 markdown-markup-properties prepend))) - (markdown-match-leanpub-sections . ((0 markdown-markup-properties))) - (markdown-fontify-blockquotes) - (markdown-match-wiki-link . ((0 'markdown-link-face prepend)))) - "Syntax highlighting for Markdown files.") - -;; Footnotes -(defvar-local markdown-footnote-counter 0 - "Counter for footnote numbers.") - -(defconst markdown-footnote-chars - "[[:alnum:]-]" - "Regular expression matching any character for a footnote identifier.") - -(defconst markdown-regex-footnote-definition - (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)") - "Regular expression matching a footnote definition, capturing the label.") - - -;;; Compatibility ============================================================= - -(defun markdown--pandoc-reference-p () - (let ((bounds (bounds-of-thing-at-point 'word))) - (when (and bounds (char-before (car bounds))) - (= (char-before (car bounds)) ?@)))) - -(defun markdown-flyspell-check-word-p () - "Return t if `flyspell' should check word just before point. -Used for `flyspell-generic-check-word-predicate'." - (save-excursion - (goto-char (1- (point))) - ;; https://github.com/jrblevin/markdown-mode/issues/560 - ;; enable spell check YAML meta data - (if (or (and (markdown-code-block-at-point-p) - (not (markdown-text-property-at-point 'markdown-yaml-metadata-section))) - (markdown-inline-code-at-point-p) - (markdown-in-comment-p) - (markdown--face-p (point) '(markdown-reference-face - markdown-markup-face - markdown-plain-url-face - markdown-inline-code-face - markdown-url-face)) - (markdown--pandoc-reference-p)) - (prog1 nil - ;; If flyspell overlay is put, then remove it - (let ((bounds (bounds-of-thing-at-point 'word))) - (when bounds - (cl-loop for ov in (overlays-in (car bounds) (cdr bounds)) - when (overlay-get ov 'flyspell-overlay) - do - (delete-overlay ov))))) - t))) - - -;;; Markdown Parsing Functions ================================================ - -(defun markdown-cur-line-blank-p () - "Return t if the current line is blank and nil otherwise." - (save-excursion - (beginning-of-line) - (looking-at-p markdown-regex-blank-line))) - -(defun markdown-prev-line-blank () - "Return t if the previous line is blank and nil otherwise. -If we are at the first line, then consider the previous line to be blank." - (or (= (line-beginning-position) (point-min)) - (save-excursion - (forward-line -1) - (looking-at markdown-regex-blank-line)))) - -(defun markdown-prev-line-blank-p () - "Like `markdown-prev-line-blank', but preserve `match-data'." - (save-match-data (markdown-prev-line-blank))) - -(defun markdown-next-line-blank-p () - "Return t if the next line is blank and nil otherwise. -If we are at the last line, then consider the next line to be blank." - (or (= (line-end-position) (point-max)) - (save-excursion - (forward-line 1) - (markdown-cur-line-blank-p)))) - -(defun markdown-prev-line-indent () - "Return the number of leading whitespace characters in the previous line. -Return 0 if the current line is the first line in the buffer." - (save-excursion - (if (= (line-beginning-position) (point-min)) - 0 - (forward-line -1) - (current-indentation)))) - -(defun markdown-next-line-indent () - "Return the number of leading whitespace characters in the next line. -Return 0 if line is the last line in the buffer." - (save-excursion - (if (= (line-end-position) (point-max)) - 0 - (forward-line 1) - (current-indentation)))) - -(defun markdown-new-baseline () - "Determine if the current line begins a new baseline level. -Assume point is positioned at beginning of line." - (or (looking-at markdown-regex-header) - (looking-at markdown-regex-hr) - (and (= (current-indentation) 0) - (not (looking-at markdown-regex-list)) - (markdown-prev-line-blank)))) - -(defun markdown-search-backward-baseline () - "Search backward baseline point with no indentation and not a list item." - (end-of-line) - (let (stop) - (while (not (or stop (bobp))) - (re-search-backward markdown-regex-block-separator-noindent nil t) - (when (match-end 2) - (goto-char (match-end 2)) - (cond - ((markdown-new-baseline) - (setq stop t)) - ((looking-at-p markdown-regex-list) - (setq stop nil)) - (t (setq stop t))))))) - -(defun markdown-update-list-levels (marker indent levels) - "Update list levels given list MARKER, block INDENT, and current LEVELS. -Here, MARKER is a string representing the type of list, INDENT is an integer -giving the indentation, in spaces, of the current block, and LEVELS is a -list of the indentation levels of parent list items. When LEVELS is nil, -it means we are at baseline (not inside of a nested list)." - (cond - ;; New list item at baseline. - ((and marker (null levels)) - (setq levels (list indent))) - ;; List item with greater indentation (four or more spaces). - ;; Increase list level. - ((and marker (>= indent (+ (car levels) markdown-list-indent-width))) - (setq levels (cons indent levels))) - ;; List item with greater or equal indentation (less than four spaces). - ;; Do not increase list level. - ((and marker (>= indent (car levels))) - levels) - ;; Lesser indentation level. - ;; Pop appropriate number of elements off LEVELS list (e.g., lesser - ;; indentation could move back more than one list level). Note - ;; that this block need not be the beginning of list item. - ((< indent (car levels)) - (while (and (> (length levels) 1) - (< indent (+ (cadr levels) markdown-list-indent-width))) - (setq levels (cdr levels))) - levels) - ;; Otherwise, do nothing. - (t levels))) - -(defun markdown-calculate-list-levels () - "Calculate list levels at point. -Return a list of the form (n1 n2 n3 ...) where n1 is the -indentation of the deepest nested list item in the branch of -the list at the point, n2 is the indentation of the parent -list item, and so on. The depth of the list item is therefore -the length of the returned list. If the point is not at or -immediately after a list item, return nil." - (save-excursion - (let ((first (point)) levels indent pre-regexp) - ;; Find a baseline point with zero list indentation - (markdown-search-backward-baseline) - ;; Search for all list items between baseline and LOC - (while (and (< (point) first) - (re-search-forward markdown-regex-list first t)) - (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels)))) - (beginning-of-line) - (cond - ;; Make sure this is not a header or hr - ((markdown-new-baseline) (setq levels nil)) - ;; Make sure this is not a line from a pre block - ((looking-at-p pre-regexp)) - ;; If not, then update levels - (t - (setq indent (current-indentation)) - (setq levels (markdown-update-list-levels (match-string 2) - indent levels)))) - (end-of-line)) - levels))) - -(defun markdown-prev-list-item (level) - "Search backward from point for a list item with indentation LEVEL. -Set point to the beginning of the item, and return point, or nil -upon failure." - (let (bounds indent prev) - (setq prev (point)) - (forward-line -1) - (setq indent (current-indentation)) - (while - (cond - ;; List item - ((and (looking-at-p markdown-regex-list) - (setq bounds (markdown-cur-list-item-bounds))) - (cond - ;; Stop and return point at item of equal indentation - ((= (nth 3 bounds) level) - (setq prev (point)) - nil) - ;; Stop and return nil at item with lesser indentation - ((< (nth 3 bounds) level) - (setq prev nil) - nil) - ;; Stop at beginning of buffer - ((bobp) (setq prev nil)) - ;; Continue at item with greater indentation - ((> (nth 3 bounds) level) t))) - ;; Stop at beginning of buffer - ((bobp) (setq prev nil)) - ;; Continue if current line is blank - ((markdown-cur-line-blank-p) t) - ;; Continue while indentation is the same or greater - ((>= indent level) t) - ;; Stop if current indentation is less than list item - ;; and the next is blank - ((and (< indent level) - (markdown-next-line-blank-p)) - (setq prev nil)) - ;; Stop at a header - ((looking-at-p markdown-regex-header) (setq prev nil)) - ;; Stop at a horizontal rule - ((looking-at-p markdown-regex-hr) (setq prev nil)) - ;; Otherwise, continue. - (t t)) - (forward-line -1) - (setq indent (current-indentation))) - prev)) - -(defun markdown-next-list-item (level) - "Search forward from point for the next list item with indentation LEVEL. -Set point to the beginning of the item, and return point, or nil -upon failure." - (let (bounds indent next) - (setq next (point)) - (if (looking-at markdown-regex-header-setext) - (goto-char (match-end 0))) - (forward-line) - (setq indent (current-indentation)) - (while - (cond - ;; Stop at end of the buffer. - ((eobp) nil) - ;; Continue if the current line is blank - ((markdown-cur-line-blank-p) t) - ;; List item - ((and (looking-at-p markdown-regex-list) - (setq bounds (markdown-cur-list-item-bounds))) - (cond - ;; Continue at item with greater indentation - ((> (nth 3 bounds) level) t) - ;; Stop and return point at item of equal indentation - ((= (nth 3 bounds) level) - (setq next (point)) - nil) - ;; Stop and return nil at item with lesser indentation - ((< (nth 3 bounds) level) - (setq next nil) - nil))) - ;; Continue while indentation is the same or greater - ((>= indent level) t) - ;; Stop if current indentation is less than list item - ;; and the previous line was blank. - ((and (< indent level) - (markdown-prev-line-blank-p)) - (setq next nil)) - ;; Stop at a header - ((looking-at-p markdown-regex-header) (setq next nil)) - ;; Stop at a horizontal rule - ((looking-at-p markdown-regex-hr) (setq next nil)) - ;; Otherwise, continue. - (t t)) - (forward-line) - (setq indent (current-indentation))) - next)) - -(defun markdown-cur-list-item-end (level) - "Move to end of list item with pre-marker indentation LEVEL. -Return the point at the end when a list item was found at the -original point. If the point is not in a list item, do nothing." - (let (indent) - (forward-line) - (setq indent (current-indentation)) - (while - (cond - ;; Stop at end of the buffer. - ((eobp) nil) - ;; Continue while indentation is the same or greater - ((>= indent level) t) - ;; Continue if the current line is blank - ((looking-at markdown-regex-blank-line) t) - ;; Stop if current indentation is less than list item - ;; and the previous line was blank. - ((and (< indent level) - (markdown-prev-line-blank)) - nil) - ;; Stop at a new list items of the same or lesser - ;; indentation, headings, and horizontal rules. - ((looking-at (concat "\\(?:" markdown-regex-list - "\\|" markdown-regex-header - "\\|" markdown-regex-hr "\\)")) - nil) - ;; Otherwise, continue. - (t t)) - (forward-line) - (setq indent (current-indentation))) - ;; Don't skip over whitespace for empty list items (marker and - ;; whitespace only), just move to end of whitespace. - (if (save-excursion - (beginning-of-line) - (looking-at (concat markdown-regex-list "[ \t]*$"))) - (goto-char (match-end 3)) - (skip-chars-backward " \t\n")) - (end-of-line) - (point))) - -(defun markdown-cur-list-item-bounds () - "Return bounds for list item at point. -Return a list of the following form: - - (begin end indent nonlist-indent marker checkbox match) - -The named components are: - - - begin: Position of beginning of list item, including leading indentation. - - end: Position of the end of the list item, including list item text. - - indent: Number of characters of indentation before list marker (an integer). - - nonlist-indent: Number characters of indentation, list - marker, and whitespace following list marker (an integer). - - marker: String containing the list marker and following whitespace - (e.g., \"- \" or \"* \"). - - checkbox: String containing the GFM checkbox portion, if any, - including any trailing whitespace before the text - begins (e.g., \"[x] \"). - - match: match data for markdown-regex-list - -As an example, for the following unordered list item - - - item - -the returned list would be - - (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6)) - -If the point is not inside a list item, return nil." - (car (get-text-property (line-beginning-position) 'markdown-list-item))) - -(defun markdown-list-item-at-point-p () - "Return t if there is a list item at the point and nil otherwise." - (save-match-data (markdown-cur-list-item-bounds))) - -(defun markdown-prev-list-item-bounds () - "Return bounds of previous item in the same list of any level. -The return value has the same form as that of -`markdown-cur-list-item-bounds'." - (save-excursion - (let ((cur-bounds (markdown-cur-list-item-bounds)) - (beginning-of-list (save-excursion (markdown-beginning-of-list))) - stop) - (when cur-bounds - (goto-char (nth 0 cur-bounds)) - (while (and (not stop) (not (bobp)) - (re-search-backward markdown-regex-list - beginning-of-list t)) - (unless (or (looking-at markdown-regex-hr) - (markdown-code-block-at-point-p)) - (setq stop (point)))) - (markdown-cur-list-item-bounds))))) - -(defun markdown-next-list-item-bounds () - "Return bounds of next item in the same list of any level. -The return value has the same form as that of -`markdown-cur-list-item-bounds'." - (save-excursion - (let ((cur-bounds (markdown-cur-list-item-bounds)) - (end-of-list (save-excursion (markdown-end-of-list))) - stop) - (when cur-bounds - (goto-char (nth 0 cur-bounds)) - (end-of-line) - (while (and (not stop) (not (eobp)) - (re-search-forward markdown-regex-list - end-of-list t)) - (unless (or (looking-at markdown-regex-hr) - (markdown-code-block-at-point-p)) - (setq stop (point)))) - (when stop - (markdown-cur-list-item-bounds)))))) - -(defun markdown-beginning-of-list () - "Move point to beginning of list at point, if any." - (interactive) - (let ((orig-point (point)) - (list-begin (save-excursion - (markdown-search-backward-baseline) - ;; Stop at next list item, regardless of the indentation. - (markdown-next-list-item (point-max)) - (when (looking-at markdown-regex-list) - (point))))) - (when (and list-begin (<= list-begin orig-point)) - (goto-char list-begin)))) - -(defun markdown-end-of-list () - "Move point to end of list at point, if any." - (interactive) - (let ((start (point)) - (end (save-excursion - (when (markdown-beginning-of-list) - ;; Items can't have nonlist-indent <= 1, so this - ;; moves past all list items. - (markdown-next-list-item 1) - (skip-syntax-backward "-") - (unless (eobp) (forward-char 1)) - (point))))) - (when (and end (>= end start)) - (goto-char end)))) - -(defun markdown-up-list () - "Move point to beginning of parent list item." - (interactive) - (let ((cur-bounds (markdown-cur-list-item-bounds))) - (when cur-bounds - (markdown-prev-list-item (1- (nth 3 cur-bounds))) - (let ((up-bounds (markdown-cur-list-item-bounds))) - (when (and up-bounds (< (nth 3 up-bounds) (nth 3 cur-bounds))) - (point)))))) - -(defun markdown-bounds-of-thing-at-point (thing) - "Call `bounds-of-thing-at-point' for THING with slight modifications. -Does not include trailing newlines when THING is \\='line. Handles the -end of buffer case by setting both endpoints equal to the value of -`point-max', since an empty region will trigger empty markup insertion. -Return bounds of form (beg . end) if THING is found, or nil otherwise." - (let* ((bounds (bounds-of-thing-at-point thing)) - (a (car bounds)) - (b (cdr bounds))) - (when bounds - (when (eq thing 'line) - (cond ((and (eobp) (markdown-cur-line-blank-p)) - (setq a b)) - ((char-equal (char-before b) ?\^J) - (setq b (1- b))))) - (cons a b)))) - -(defun markdown-reference-definition (reference) - "Find out whether Markdown REFERENCE is defined. -REFERENCE should not include the square brackets. -When REFERENCE is defined, return a list of the form (text start end) -containing the definition text itself followed by the start and end -locations of the text. Otherwise, return nil. -Leave match data for `markdown-regex-reference-definition' -intact additional processing." - (let ((reference (downcase reference))) - (save-excursion - (goto-char (point-min)) - (catch 'found - (while (re-search-forward markdown-regex-reference-definition nil t) - (when (string= reference (downcase (match-string-no-properties 2))) - (throw 'found - (list (match-string-no-properties 5) - (match-beginning 5) (match-end 5))))))))) - -(defun markdown-get-defined-references () - "Return all defined reference labels and their line numbers. -They does not include square brackets)." - (save-excursion - (goto-char (point-min)) - (let (refs) - (while (re-search-forward markdown-regex-reference-definition nil t) - (let ((target (match-string-no-properties 2))) - (cl-pushnew - (cons (downcase target) - (markdown-line-number-at-pos (match-beginning 2))) - refs :test #'equal :key #'car))) - (reverse refs)))) - -(defun markdown-get-used-uris () - "Return a list of all used URIs in the buffer." - (save-excursion - (goto-char (point-min)) - (let (uris) - (while (re-search-forward - (concat "\\(?:" markdown-regex-link-inline - "\\|" markdown-regex-angle-uri - "\\|" markdown-regex-uri - "\\|" markdown-regex-email - "\\)") - nil t) - (unless (or (markdown-inline-code-at-point-p) - (markdown-code-block-at-point-p)) - (cl-pushnew (or (match-string-no-properties 6) - (match-string-no-properties 10) - (match-string-no-properties 12) - (match-string-no-properties 13)) - uris :test #'equal))) - (reverse uris)))) - -(defun markdown-inline-code-at-pos (pos &optional from) - "Return non-nil if there is an inline code fragment at POS starting at FROM. -Uses the beginning of the block if FROM is nil. -Return nil otherwise. Set match data according to -`markdown-match-code' upon success. -This function searches the block for a code fragment that -contains the point using `markdown-match-code'. We do this -because `thing-at-point-looking-at' does not work reliably with -`markdown-regex-code'. - -The match data is set as follows: -Group 1 matches the opening backquotes. -Group 2 matches the code fragment itself, without backquotes. -Group 3 matches the closing backquotes." - (save-excursion - (goto-char pos) - (let ((old-point (point)) - (end-of-block (progn (markdown-end-of-text-block) (point))) - found) - (if from - (goto-char from) - (markdown-beginning-of-text-block)) - (while (and (markdown-match-code end-of-block) - (setq found t) - (< (match-end 0) old-point))) - (let ((match-group (if (eq (char-after (match-beginning 0)) ?`) 0 1))) - (and found ; matched something - (<= (match-beginning match-group) old-point) ; match contains old-point - (> (match-end 0) old-point)))))) - -(defun markdown-inline-code-at-pos-p (pos) - "Return non-nil if there is an inline code fragment at POS. -Like `markdown-inline-code-at-pos`, but preserves match data." - (save-match-data (markdown-inline-code-at-pos pos))) - -(defun markdown-inline-code-at-point () - "Return non-nil if the point is at an inline code fragment. -See `markdown-inline-code-at-pos' for details." - (markdown-inline-code-at-pos (point))) - -(defun markdown-inline-code-at-point-p (&optional pos) - "Return non-nil if there is inline code at the POS. -This is a predicate function counterpart to -`markdown-inline-code-at-point' which does not modify the match -data. See `markdown-code-block-at-point-p' for code blocks." - (save-match-data (markdown-inline-code-at-pos (or pos (point))))) - -(defun markdown-code-block-at-pos (pos) - "Return match data list if there is a code block at POS. -Uses text properties at the beginning of the line position. -This includes pre blocks, tilde-fenced code blocks, and GFM -quoted code blocks. Return nil otherwise." - (let ((bol (save-excursion (goto-char pos) (line-beginning-position)))) - (or (get-text-property bol 'markdown-pre) - (let* ((bounds (markdown-get-enclosing-fenced-block-construct pos)) - (second (cl-second bounds))) - (if second - ;; chunks are right open - (when (< pos second) - bounds) - bounds))))) - -;; Function was renamed to emphasize that it does not modify match-data. -(defalias 'markdown-code-block-at-point 'markdown-code-block-at-point-p) - -(defun markdown-code-block-at-point-p (&optional pos) - "Return non-nil if there is a code block at the POS. -This includes pre blocks, tilde-fenced code blocks, and GFM -quoted code blocks. This function does not modify the match -data. See `markdown-inline-code-at-point-p' for inline code." - (save-match-data (markdown-code-block-at-pos (or pos (point))))) - -(defun markdown-heading-at-point (&optional pos) - "Return non-nil if there is a heading at the POS. -Set match data for `markdown-regex-header'." - (let ((match-data (get-text-property (or pos (point)) 'markdown-heading))) - (when match-data - (set-match-data match-data) - t))) - -(defun markdown-pipe-at-bol-p () - "Return non-nil if the line begins with a pipe symbol. -This may be useful for tables and Pandoc's line_blocks extension." - (char-equal (char-after (line-beginning-position)) ?|)) - - -;;; Markdown Font Lock Matching Functions ===================================== - -(defun markdown-range-property-any (begin end prop prop-values) - "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES. -Also returns t if PROP is a list containing one of the PROP-VALUES. -Return nil otherwise." - (let (props) - (catch 'found - (dolist (loc (number-sequence begin end)) - (when (setq props (get-text-property loc prop)) - (cond ((listp props) - ;; props is a list, check for membership - (dolist (val prop-values) - (when (memq val props) (throw 'found loc)))) - (t - ;; props is a scalar, check for equality - (dolist (val prop-values) - (when (eq val props) (throw 'found loc)))))))))) - -(defun markdown-range-properties-exist (begin end props) - (cl-loop - for loc in (number-sequence begin end) - with result = nil - while (not - (setq result - (cl-some (lambda (prop) (get-text-property loc prop)) props))) - finally return result)) - -(defun markdown-match-inline-generic (regex last &optional faceless) - "Match inline REGEX from the point to LAST. -When FACELESS is non-nil, do not return matches where faces have been applied." - (when (re-search-forward regex last t) - (let ((bounds (markdown-code-block-at-pos (match-beginning 1))) - (face (and faceless (text-property-not-all - (match-beginning 0) (match-end 0) 'face nil)))) - (cond - ;; In code block: move past it and recursively search again - (bounds - (when (< (goto-char (cl-second bounds)) last) - (markdown-match-inline-generic regex last faceless))) - ;; When faces are found in the match range, skip over the match and - ;; recursively search again. - (face - (when (< (goto-char (match-end 0)) last) - (markdown-match-inline-generic regex last faceless))) - ;; Keep match data and return t when in bounds. - (t - (<= (match-end 0) last)))))) - -(defun markdown-match-code (last) - "Match inline code fragments from point to LAST." - (unless (bobp) - (backward-char 1)) - (when (markdown-search-until-condition - (lambda () - (and - ;; Advance point in case of failure, but without exceeding last. - (goto-char (min (1+ (match-beginning 1)) last)) - (not (markdown-in-comment-p (match-beginning 1))) - (not (markdown-in-comment-p (match-end 1))) - (not (markdown-code-block-at-pos (match-beginning 1))))) - markdown-regex-code last t) - (set-match-data (list (match-beginning 1) (match-end 1) - (match-beginning 2) (match-end 2) - (match-beginning 3) (match-end 3) - (match-beginning 4) (match-end 4))) - (goto-char (min (1+ (match-end 0)) last (point-max))) - t)) - -(defun markdown--gfm-markup-underscore-p (begin end) - (let ((is-underscore (eql (char-after begin) ?_))) - (if (not is-underscore) - t - (save-excursion - (save-match-data - (goto-char begin) - (and (looking-back "\\(?:^\\|[[:blank:][:punct:]]\\)" (1- begin)) - (progn - (goto-char end) - (looking-at-p "\\(?:[[:blank:][:punct:]]\\|$\\)")))))))) - -(defun markdown-match-bold (last) - "Match inline bold from the point to LAST." - (let (done - retval - last-inline-code) - (while (not done) - (if (markdown-match-inline-generic markdown-regex-bold last) - (let ((is-gfm (derived-mode-p 'gfm-mode)) - (begin (match-beginning 2)) - (end (match-end 2))) - (if (or - (and last-inline-code - (>= begin (car last-inline-code)) - (< begin (cdr last-inline-code))) - (save-match-data - (when (markdown-inline-code-at-pos begin (cdr last-inline-code)) - (setq last-inline-code `(,(match-beginning 0) . ,(match-end 0))))) - (markdown-inline-code-at-pos-p end) - (markdown-in-comment-p) - (markdown-range-property-any - begin begin 'face '(markdown-url-face - markdown-plain-url-face)) - (markdown-range-property-any - begin end 'face '(markdown-hr-face - markdown-math-face)) - (and is-gfm (not (markdown--gfm-markup-underscore-p begin end)))) - (progn (goto-char (min (1+ begin) last)) - (unless (< (point) last) - (setq - done t))) - (set-match-data (list (match-beginning 2) (match-end 2) - (match-beginning 3) (match-end 3) - (match-beginning 4) (match-end 4) - (match-beginning 5) (match-end 5))) - (setq done t - retval t))) - (setq done t))) - retval)) - -(defun markdown-match-italic (last) - "Match inline italics from the point to LAST." - (let* ((is-gfm (derived-mode-p 'gfm-mode)) - (regex (if is-gfm - markdown-regex-gfm-italic - markdown-regex-italic))) - (let (done - retval - last-inline-code) - (while (not done) - (if (and (markdown-match-inline-generic regex last) - (not (markdown--face-p - (match-beginning 1) - '(markdown-html-attr-name-face markdown-html-attr-value-face)))) - (let ((begin (match-beginning 1)) - (end (match-end 1)) - (close-end (match-end 4))) - (if (or (eql (char-before begin) (char-after begin)) - (and last-inline-code - (>= begin (car last-inline-code)) - (< begin (cdr last-inline-code))) - (save-match-data - (when (markdown-inline-code-at-pos begin (cdr last-inline-code)) - (setq last-inline-code `(,(match-beginning 0) . ,(match-end 0))))) - - (markdown-inline-code-at-pos-p (1- end)) - (markdown-in-comment-p) - (markdown-range-property-any - begin begin 'face '(markdown-url-face - markdown-plain-url-face - markdown-markup-face)) - (markdown-range-property-any - begin end 'face '(markdown-bold-face - markdown-list-face - markdown-hr-face - markdown-math-face)) - (and is-gfm - (or (char-equal (char-after begin) (char-after (1+ begin))) ;; check bold case - (not (markdown--gfm-markup-underscore-p begin close-end))))) - (progn (goto-char (min (1+ begin) last)) - (unless (< (point) last) - (setq - done t))) - (set-match-data (list (match-beginning 1) (match-end 1) - (match-beginning 2) (match-end 2) - (match-beginning 3) (match-end 3) - (match-beginning 4) (match-end 4))) - (setq done t - retval t))) - (setq done t))) - retval))) - -(defun markdown--match-highlighting (last) - (when markdown-enable-highlighting-syntax - (re-search-forward markdown-regex-highlighting last t))) - -(defun markdown-match-escape (last) - "Match escape characters (backslashes) from point to LAST. -Backlashes only count as escape characters outside of literal -regions (e.g. code blocks). See `markdown-literal-faces'." - (catch 'found - (while (search-forward-regexp markdown-regex-escape last t) - (let* ((face (get-text-property (match-beginning 1) 'face)) - (face-list (if (listp face) face (list face)))) - ;; Ignore any backslashes with a literal face. - (unless (cl-intersection face-list markdown-literal-faces) - (throw 'found t)))))) - -(defun markdown-match-math-generic (regex last) - "Match REGEX from point to LAST. -REGEX is either `markdown-regex-math-inline-single' for matching -$..$ or `markdown-regex-math-inline-double' for matching $$..$$." - (when (markdown-match-inline-generic regex last) - (let ((begin (match-beginning 1)) (end (match-end 1))) - (prog1 - (if (or (markdown-range-property-any - begin end 'face - '(markdown-inline-code-face markdown-bold-face)) - (markdown-range-properties-exist - begin end - (markdown-get-fenced-block-middle-properties))) - (markdown-match-math-generic regex last) - t) - (goto-char (1+ (match-end 0))))))) - -(defun markdown-match-list-items (last) - "Match list items from point to LAST." - (let* ((first (point)) - (pos first) - (prop 'markdown-list-item) - (bounds (car (get-text-property pos prop)))) - (while - (and (or (null (setq bounds (car (get-text-property pos prop)))) - (< (cl-first bounds) pos)) - (< (point) last) - (setq pos (next-single-property-change pos prop nil last)) - (goto-char pos))) - (when bounds - (set-match-data (cl-seventh bounds)) - ;; Step at least one character beyond point. Otherwise - ;; `font-lock-fontify-keywords-region' infloops. - (goto-char (min (1+ (max (line-end-position) first)) - (point-max))) - t))) - -(defun markdown-match-math-single (last) - "Match single quoted $..$ math from point to LAST." - (when markdown-enable-math - (when (and (char-equal (char-after) ?$) - (not (bolp)) - (not (char-equal (char-before) ?\\)) - (not (char-equal (char-before) ?$))) - (forward-char -1)) - (markdown-match-math-generic markdown-regex-math-inline-single last))) - -(defun markdown-match-math-double (last) - "Match double quoted $$..$$ math from point to LAST." - (when markdown-enable-math - (when (and (< (1+ (point)) (point-max)) - (char-equal (char-after) ?$) - (char-equal (char-after (1+ (point))) ?$) - (not (bolp)) - (not (char-equal (char-before) ?\\)) - (not (char-equal (char-before) ?$))) - (forward-char -1)) - (markdown-match-math-generic markdown-regex-math-inline-double last))) - -(defun markdown-match-math-display (last) - "Match bracketed display math \[..\] and \\[..\\] from point to LAST." - (when markdown-enable-math - (markdown-match-math-generic markdown-regex-math-display last))) - -(defun markdown-match-propertized-text (property last) - "Match text with PROPERTY from point to LAST. -Restore match data previously stored in PROPERTY." - (let ((saved (get-text-property (point) property)) - pos) - (unless saved - (setq pos (next-single-property-change (point) property nil last)) - (unless (= pos last) - (setq saved (get-text-property pos property)))) - (when saved - (set-match-data saved) - ;; Step at least one character beyond point. Otherwise - ;; `font-lock-fontify-keywords-region' infloops. - (goto-char (min (1+ (max (match-end 0) (point))) - (point-max))) - saved))) - -(defun markdown-match-pre-blocks (last) - "Match preformatted blocks from point to LAST. -Use data stored in \\='markdown-pre text property during syntax -analysis." - (markdown-match-propertized-text 'markdown-pre last)) - -(defun markdown-match-gfm-code-blocks (last) - "Match GFM quoted code blocks from point to LAST. -Use data stored in \\='markdown-gfm-code text property during syntax -analysis." - (markdown-match-propertized-text 'markdown-gfm-code last)) - -(defun markdown-match-gfm-open-code-blocks (last) - (markdown-match-propertized-text 'markdown-gfm-block-begin last)) - -(defun markdown-match-gfm-close-code-blocks (last) - (markdown-match-propertized-text 'markdown-gfm-block-end last)) - -(defun markdown-match-fenced-code-blocks (last) - "Match fenced code blocks from the point to LAST." - (markdown-match-propertized-text 'markdown-fenced-code last)) - -(defun markdown-match-fenced-start-code-block (last) - (markdown-match-propertized-text 'markdown-tilde-fence-begin last)) - -(defun markdown-match-fenced-end-code-block (last) - (markdown-match-propertized-text 'markdown-tilde-fence-end last)) - -(defun markdown-match-blockquotes (last) - "Match blockquotes from point to LAST. -Use data stored in \\='markdown-blockquote text property during syntax -analysis." - (markdown-match-propertized-text 'markdown-blockquote last)) - -(defun markdown-match-hr (last) - "Match horizontal rules comments from the point to LAST." - (markdown-match-propertized-text 'markdown-hr last)) - -(defun markdown-match-comments (last) - "Match HTML comments from the point to LAST." - (when (and (skip-syntax-forward "^<" last)) - (let ((beg (point))) - (when (and (skip-syntax-forward "^>" last) (< (point) last)) - (forward-char) - (set-match-data (list beg (point))) - t)))) - -(defun markdown-match-generic-links (last ref) - "Match inline links from point to LAST. -When REF is non-nil, match reference links instead of standard -links with URLs. -This function should only be used during font-lock, as it -determines syntax based on the presence of faces for previously -processed elements." - ;; Search for the next potential link (not in a code block). - (let ((prohibited-faces '(markdown-pre-face - markdown-code-face - markdown-inline-code-face - markdown-comment-face)) - found) - (while - (and (not found) (< (point) last) - (progn - ;; Clear match data to test for a match after functions returns. - (set-match-data nil) - ;; Preliminary regular expression search so we can return - ;; quickly upon failure. This doesn't handle malformed links - ;; or nested square brackets well, so if it passes we back up - ;; continue with a more precise search. - (re-search-forward - (if ref - markdown-regex-link-reference - markdown-regex-link-inline) - last 'limit))) - ;; Keep searching if this is in a code block, inline code, or a - ;; comment, or if it is include syntax. The link text portion - ;; (group 3) may contain inline code or comments, but the - ;; markup, URL, and title should not be part of such elements. - (if (or (markdown-range-property-any - (match-beginning 0) (match-end 2) 'face prohibited-faces) - (markdown-range-property-any - (match-beginning 4) (match-end 0) 'face prohibited-faces) - (and (char-equal (char-after (line-beginning-position)) ?<) - (char-equal (char-after (1+ (line-beginning-position))) ?<))) - (set-match-data nil) - (setq found t)))) - ;; Match opening exclamation point (optional) and left bracket. - (when (match-beginning 2) - (let* ((bang (match-beginning 1)) - (first-begin (match-beginning 2)) - ;; Find end of block to prevent matching across blocks. - (end-of-block (save-excursion - (progn - (goto-char (match-beginning 2)) - (markdown-end-of-text-block) - (point)))) - ;; Move over balanced expressions to closing right bracket. - ;; Catch unbalanced expression errors and return nil. - (first-end (condition-case nil - (and (goto-char first-begin) - (scan-sexps (point) 1)) - (error nil))) - ;; Continue with point at CONT-POINT upon failure. - (cont-point (min (1+ first-begin) last)) - second-begin second-end url-begin url-end - title-begin title-end) - ;; When bracket found, in range, and followed by a left paren/bracket... - (when (and first-end (< first-end end-of-block) (goto-char first-end) - (char-equal (char-after (point)) (if ref ?\[ ?\())) - ;; Scan across balanced expressions for closing parenthesis/bracket. - (setq second-begin (point) - second-end (condition-case nil - (scan-sexps (point) 1) - (error nil))) - ;; Check that closing parenthesis/bracket is in range. - (if (and second-end (<= second-end end-of-block) (<= second-end last)) - (progn - ;; Search for (optional) title inside closing parenthesis - (when (and (not ref) (search-forward "\"" second-end t)) - (setq title-begin (1- (point)) - title-end (and (goto-char second-end) - (search-backward "\"" (1+ title-begin) t)) - title-end (and title-end (1+ title-end)))) - ;; Store URL/reference range - (setq url-begin (1+ second-begin) - url-end (1- (or title-begin second-end))) - ;; Set match data, move point beyond link, and return - (set-match-data - (list (or bang first-begin) second-end ; 0 - all - bang (and bang (1+ bang)) ; 1 - bang - first-begin (1+ first-begin) ; 2 - markup - (1+ first-begin) (1- first-end) ; 3 - link text - (1- first-end) first-end ; 4 - markup - second-begin (1+ second-begin) ; 5 - markup - url-begin url-end ; 6 - url/reference - title-begin title-end ; 7 - title - (1- second-end) second-end)) ; 8 - markup - ;; Nullify cont-point and leave point at end and - (setq cont-point nil) - (goto-char second-end)) - ;; If no closing parenthesis in range, update continuation point - (setq cont-point (min end-of-block second-begin)))) - (cond - ;; On failure, continue searching at cont-point - ((and cont-point (< cont-point last)) - (goto-char cont-point) - (markdown-match-generic-links last ref)) - ;; No more text, return nil - ((and cont-point (= cont-point last)) - nil) - ;; Return t if a match occurred - (t t))))) - -(defun markdown-match-angle-uris (last) - "Match angle bracket URIs from point to LAST." - (when (markdown-match-inline-generic markdown-regex-angle-uri last) - (goto-char (1+ (match-end 0))))) - -(defun markdown-match-plain-uris (last) - "Match plain URIs from point to LAST." - (when (markdown-match-inline-generic markdown-regex-uri last t) - (goto-char (1+ (match-end 0))))) - -(defvar markdown-conditional-search-function #'re-search-forward - "Conditional search function used in `markdown-search-until-condition'. -Made into a variable to allow for dynamic let-binding.") - -(defun markdown-search-until-condition (condition &rest args) - (let (ret) - (while (and (not ret) (apply markdown-conditional-search-function args)) - (setq ret (funcall condition))) - ret)) - -(defun markdown-metadata-line-p (pos regexp) - (save-excursion - (or (= (line-number-at-pos pos) 1) - (progn - (forward-line -1) - ;; skip multi-line metadata - (while (and (looking-at-p "^\\s-+[[:alpha:]]") - (> (line-number-at-pos (point)) 1)) - (forward-line -1)) - (looking-at-p regexp))))) - -(defun markdown-match-generic-metadata (regexp last) - "Match metadata declarations specified by REGEXP from point to LAST. -These declarations must appear inside a metadata block that begins at -the beginning of the buffer and ends with a blank line (or the end of -the buffer)." - (let* ((first (point)) - (end-re "\n[ \t]*\n\\|\n\\'\\|\\'") - (block-begin (goto-char 1)) - (block-end (re-search-forward end-re nil t))) - (if (and block-end (> first block-end)) - ;; Don't match declarations if there is no metadata block or if - ;; the point is beyond the block. Move point to point-max to - ;; prevent additional searches and return return nil since nothing - ;; was found. - (progn (goto-char (point-max)) nil) - ;; If a block was found that begins before LAST and ends after - ;; point, search for declarations inside it. If the starting is - ;; before the beginning of the block, start there. Otherwise, - ;; move back to FIRST. - (goto-char (if (< first block-begin) block-begin first)) - (if (and (re-search-forward regexp (min last block-end) t) - (markdown-metadata-line-p (point) regexp)) - ;; If a metadata declaration is found, set match-data and return t. - (let ((key-beginning (match-beginning 1)) - (key-end (match-end 1)) - (markup-begin (match-beginning 2)) - (markup-end (match-end 2)) - (value-beginning (match-beginning 3))) - (set-match-data (list key-beginning (point) ; complete metadata - key-beginning key-end ; key - markup-begin markup-end ; markup - value-beginning (point))) ; value - t) - ;; Otherwise, move the point to last and return nil - (goto-char last) - nil)))) - -(defun markdown-match-declarative-metadata (last) - "Match declarative metadata from the point to LAST." - (markdown-match-generic-metadata markdown-regex-declarative-metadata last)) - -(defun markdown-match-pandoc-metadata (last) - "Match Pandoc metadata from the point to LAST." - (markdown-match-generic-metadata markdown-regex-pandoc-metadata last)) - -(defun markdown-match-yaml-metadata-begin (last) - (markdown-match-propertized-text 'markdown-yaml-metadata-begin last)) - -(defun markdown-match-yaml-metadata-end (last) - (markdown-match-propertized-text 'markdown-yaml-metadata-end last)) - -(defun markdown-match-yaml-metadata-key (last) - (markdown-match-propertized-text 'markdown-metadata-key last)) - -(defun markdown-match-wiki-link (last) - "Match wiki links from point to LAST." - (when (and markdown-enable-wiki-links - (not markdown-wiki-link-fontify-missing) - (markdown-match-inline-generic markdown-regex-wiki-link last)) - (let ((begin (match-beginning 1)) (end (match-end 1))) - (if (or (markdown-in-comment-p begin) - (markdown-in-comment-p end) - (markdown-inline-code-at-pos-p begin) - (markdown-inline-code-at-pos-p end) - (markdown-code-block-at-pos begin)) - (progn (goto-char (min (1+ begin) last)) - (when (< (point) last) - (markdown-match-wiki-link last))) - (set-match-data (list begin end)) - t)))) - -(defun markdown-match-inline-attributes (last) - "Match inline attributes from point to LAST." - ;; #428 re-search-forward markdown-regex-inline-attributes is very slow. - ;; So use simple regex for re-search-forward and use markdown-regex-inline-attributes - ;; against matched string. - (when (markdown-match-inline-generic "[ \t]*\\({\\)\\([^\n]*\\)}[ \t]*$" last) - (if (not (string-match-p markdown-regex-inline-attributes (match-string 0))) - (markdown-match-inline-attributes last) - (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) - (markdown-inline-code-at-pos-p (match-end 0)) - (markdown-in-comment-p)) - t)))) - -(defun markdown-match-leanpub-sections (last) - "Match Leanpub section markers from point to LAST." - (when (markdown-match-inline-generic markdown-regex-leanpub-sections last) - (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) - (markdown-inline-code-at-pos-p (match-end 0)) - (markdown-in-comment-p)) - t))) - -(defun markdown-match-includes (last) - "Match include statements from point to LAST. -Sets match data for the following seven groups: -Group 1: opening two angle brackets -Group 2: opening title delimiter (optional) -Group 3: title text (optional) -Group 4: closing title delimiter (optional) -Group 5: opening filename delimiter -Group 6: filename -Group 7: closing filename delimiter" - (when (markdown-match-inline-generic markdown-regex-include last) - (let ((valid (not (or (markdown-in-comment-p (match-beginning 0)) - (markdown-in-comment-p (match-end 0)) - (markdown-code-block-at-pos (match-beginning 0)))))) - (cond - ;; Parentheses and maybe square brackets, but no curly braces: - ;; match optional title in square brackets and file in parentheses. - ((and valid (match-beginning 5) - (not (match-beginning 8))) - (set-match-data (list (match-beginning 1) (match-end 7) - (match-beginning 1) (match-end 1) - (match-beginning 2) (match-end 2) - (match-beginning 3) (match-end 3) - (match-beginning 4) (match-end 4) - (match-beginning 5) (match-end 5) - (match-beginning 6) (match-end 6) - (match-beginning 7) (match-end 7)))) - ;; Only square brackets present: match file in square brackets. - ((and valid (match-beginning 2) - (not (match-beginning 5)) - (not (match-beginning 7))) - (set-match-data (list (match-beginning 1) (match-end 4) - (match-beginning 1) (match-end 1) - nil nil - nil nil - nil nil - (match-beginning 2) (match-end 2) - (match-beginning 3) (match-end 3) - (match-beginning 4) (match-end 4)))) - ;; Only curly braces present: match file in curly braces. - ((and valid (match-beginning 8) - (not (match-beginning 2)) - (not (match-beginning 5))) - (set-match-data (list (match-beginning 1) (match-end 10) - (match-beginning 1) (match-end 1) - nil nil - nil nil - nil nil - (match-beginning 8) (match-end 8) - (match-beginning 9) (match-end 9) - (match-beginning 10) (match-end 10)))) - (t - ;; Not a valid match, move to next line and search again. - (forward-line) - (when (< (point) last) - (setq valid (markdown-match-includes last))))) - valid))) - -(defun markdown-match-html-tag (last) - "Match HTML tags from point to LAST." - (when (and markdown-enable-html - (markdown-match-inline-generic markdown-regex-html-tag last t)) - (set-match-data (list (match-beginning 0) (match-end 0) - (match-beginning 1) (match-end 1) - (match-beginning 2) (match-end 2) - (match-beginning 9) (match-end 9))) - t)) - - -;;; Markdown Font Fontification Functions ===================================== - -(defvar markdown--first-displayable-cache (make-hash-table :test #'equal)) - -(defun markdown--first-displayable (seq) - "Return the first displayable character or string in SEQ. -SEQ may be an atom or a sequence." - (let ((c (gethash seq markdown--first-displayable-cache t))) - (if (not (eq c t)) - c - (puthash seq - (let ((seq (if (listp seq) seq (list seq)))) - (cond ((stringp (car seq)) - (cl-find-if - (lambda (str) - (and (mapcar #'char-displayable-p (string-to-list str)))) - seq)) - ((characterp (car seq)) - (cl-find-if #'char-displayable-p seq)))) - markdown--first-displayable-cache)))) - -(defun markdown--marginalize-string (level) - "Generate atx markup string of given LEVEL for left margin." - (let ((margin-left-space-count - (- markdown-marginalize-headers-margin-width level))) - (concat (make-string margin-left-space-count ? ) - (make-string level ?#)))) - -(defun markdown-marginalize-update-current () - "Update the window configuration to create a left margin." - (if window-system - (let* ((header-delimiter-font-width - (window-font-width nil 'markdown-header-delimiter-face)) - (margin-pixel-width (* markdown-marginalize-headers-margin-width - header-delimiter-font-width)) - (margin-char-width (/ margin-pixel-width (default-font-width)))) - (set-window-margins nil margin-char-width)) - ;; As a fallback, simply set margin based on character count. - (set-window-margins nil (1+ markdown-marginalize-headers-margin-width)))) - -(defun markdown-fontify-headings (last) - "Add text properties to headings from point to LAST." - (when (markdown-match-propertized-text 'markdown-heading last) - (let* ((level (markdown-outline-level)) - (heading-face - (intern (format "markdown-header-face-%d" level))) - (heading-props `(face ,heading-face)) - (left-markup-props - `(face markdown-header-delimiter-face - ,@(cond - (markdown-hide-markup - `(display "")) - (markdown-marginalize-headers - `(display ((margin left-margin) - ,(markdown--marginalize-string level))))))) - (right-markup-props - `(face markdown-header-delimiter-face - ,@(when markdown-hide-markup `(display "")))) - (rule-props `(face markdown-header-rule-face - ,@(when markdown-hide-markup `(display ""))))) - (if (match-end 1) - ;; Setext heading - (progn (add-text-properties - (match-beginning 1) (match-end 1) heading-props) - (if (= level 1) - (add-text-properties - (match-beginning 2) (match-end 2) rule-props) - (add-text-properties - (match-beginning 3) (match-end 3) rule-props))) - ;; atx heading - (let ((fontified-start - (if (or markdown-hide-markup (not markdown-fontify-whole-heading-line)) - (match-beginning 5) - (match-beginning 0))) - (fontified-end - (if markdown-fontify-whole-heading-line - (min (point-max) (1+ (match-end 0))) - (match-end 5)))) - (add-text-properties - (match-beginning 4) (match-end 4) left-markup-props) - - ;; If closing tag is present - (if (match-end 6) - (progn - (add-text-properties fontified-start fontified-end heading-props) - (when (or markdown-hide-markup (not markdown-fontify-whole-heading-line)) - (add-text-properties (match-beginning 6) (match-end 6) right-markup-props))) - ;; If closing tag is not present - (add-text-properties fontified-start fontified-end heading-props))))) - t)) - -(defun markdown-fontify-tables (last) - (when (re-search-forward "|" last t) - (when (markdown-table-at-point-p) - (font-lock-append-text-property - (line-beginning-position) (min (1+ (line-end-position)) (point-max)) - 'face 'markdown-table-face)) - (forward-line 1) - t)) - -(defun markdown-fontify-blockquotes (last) - "Apply font-lock properties to blockquotes from point to LAST." - (when (markdown-match-blockquotes last) - (let ((display-string - (markdown--first-displayable markdown-blockquote-display-char))) - (add-text-properties - (match-beginning 1) (match-end 1) - (if markdown-hide-markup - `(face markdown-blockquote-face display ,display-string) - `(face markdown-markup-face))) - (font-lock-append-text-property - (match-beginning 0) (match-end 0) 'face 'markdown-blockquote-face) - t))) - -(defun markdown-fontify-list-items (last) - "Apply font-lock properties to list markers from point to LAST." - (when (markdown-match-list-items last) - (when (not (markdown-code-block-at-point-p (match-beginning 2))) - (let* ((indent (length (match-string-no-properties 1))) - (level (/ indent markdown-list-indent-width)) ;; level = 0, 1, 2, ... - (bullet (nth (mod level (length markdown-list-item-bullets)) - markdown-list-item-bullets))) - (add-text-properties - (match-beginning 2) (match-end 2) '(face markdown-list-face)) - (when markdown-hide-markup - (cond - ;; Unordered lists - ((string-match-p "[\\*\\+-]" (match-string 2)) - (add-text-properties - (match-beginning 2) (match-end 2) `(display ,bullet))) - ;; Definition lists - ((string-equal ":" (match-string 2)) - (let ((display-string - (char-to-string (markdown--first-displayable - markdown-definition-display-char)))) - (add-text-properties (match-beginning 2) (match-end 2) - `(display ,display-string)))))))) - t)) - -(defun markdown--fontify-hrs-view-mode (hr-char) - (if (and hr-char (display-supports-face-attributes-p '(:extend t))) - (add-text-properties - (match-beginning 0) (match-end 0) - `(face - (:inherit markdown-hr-face :underline t :extend t) - font-lock-multiline t - display "\n")) - (let ((hr-len (and hr-char (/ (1- (window-body-width)) (char-width hr-char))))) - (add-text-properties - (match-beginning 0) (match-end 0) - `(face - markdown-hr-face font-lock-multiline t - display ,(make-string hr-len hr-char)))))) - -(defun markdown-fontify-hrs (last) - "Add text properties to horizontal rules from point to LAST." - (when (markdown-match-hr last) - (let ((hr-char (markdown--first-displayable markdown-hr-display-char))) - (if (and markdown-hide-markup hr-char) - (markdown--fontify-hrs-view-mode hr-char) - (add-text-properties - (match-beginning 0) (match-end 0) - `(face markdown-hr-face font-lock-multiline t))) - t))) - -(defun markdown-fontify-sub-superscripts (last) - "Apply text properties to sub- and superscripts from point to LAST." - (when (markdown-search-until-condition - (lambda () (and (not (markdown-code-block-at-point-p)) - (not (markdown-inline-code-at-point-p)) - (not (markdown-in-comment-p)) - (not (markdown--math-block-p)))) - markdown-regex-sub-superscript last t) - (let* ((subscript-p (string= (match-string 2) "~")) - (props - (if subscript-p - (car markdown-sub-superscript-display) - (cdr markdown-sub-superscript-display))) - (mp (list 'face 'markdown-markup-face - 'invisible 'markdown-markup))) - (when markdown-hide-markup - (put-text-property (match-beginning 3) (match-end 3) - 'display props)) - (add-text-properties (match-beginning 2) (match-end 2) mp) - (add-text-properties (match-beginning 4) (match-end 4) mp) - t))) - - -;;; Syntax Table ============================================================== - -(defvar markdown-mode-syntax-table - (let ((tab (make-syntax-table text-mode-syntax-table))) - (modify-syntax-entry ?\" "." tab) - tab) - "Syntax table for `markdown-mode'.") - - -;;; Element Insertion ========================================================= - -(defun markdown-ensure-blank-line-before () - "If previous line is not already blank, insert a blank line before point." - (unless (bolp) (insert "\n")) - (unless (or (bobp) (looking-back "\n\\s-*\n" nil)) (insert "\n"))) - -(defun markdown-ensure-blank-line-after () - "If following line is not already blank, insert a blank line after point. -Return the point where it was originally." - (save-excursion - (unless (eolp) (insert "\n")) - (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n")))) - -(defun markdown-wrap-or-insert (s1 s2 &optional thing beg end) - "Insert the strings S1 and S2, wrapping around region or THING. -If a region is specified by the optional BEG and END arguments, -wrap the strings S1 and S2 around that region. -If there is an active region, wrap the strings S1 and S2 around -the region. If there is not an active region but the point is at -THING, wrap that thing (which defaults to word). Otherwise, just -insert S1 and S2 and place the point in between. Return the -bounds of the entire wrapped string, or nil if nothing was wrapped -and S1 and S2 were only inserted." - (let (a b bounds new-point) - (cond - ;; Given region - ((and beg end) - (setq a beg - b end - new-point (+ (point) (length s1)))) - ;; Active region - ((use-region-p) - (setq a (region-beginning) - b (region-end) - new-point (+ (point) (length s1)))) - ;; Thing (word) at point - ((setq bounds (markdown-bounds-of-thing-at-point (or thing 'word))) - (setq a (car bounds) - b (cdr bounds) - new-point (+ (point) (length s1)))) - ;; No active region and no word - (t - (setq a (point) - b (point)))) - (goto-char b) - (insert s2) - (goto-char a) - (insert s1) - (when new-point (goto-char new-point)) - (if (= a b) - nil - (setq b (+ b (length s1) (length s2))) - (cons a b)))) - -(defun markdown-point-after-unwrap (cur prefix suffix) - "Return desired position of point after an unwrapping operation. -CUR gives the position of the point before the operation. -Additionally, two cons cells must be provided. PREFIX gives the -bounds of the prefix string and SUFFIX gives the bounds of the -suffix string." - (cond ((< cur (cdr prefix)) (car prefix)) - ((< cur (car suffix)) (- cur (- (cdr prefix) (car prefix)))) - ((<= cur (cdr suffix)) - (- cur (+ (- (cdr prefix) (car prefix)) - (- cur (car suffix))))) - (t cur))) - -(defun markdown-unwrap-thing-at-point (regexp all text) - "Remove prefix and suffix of thing at point and reposition the point. -When the thing at point matches REGEXP, replace the subexpression -ALL with the string in subexpression TEXT. Reposition the point -in an appropriate location accounting for the removal of prefix -and suffix strings. Return new bounds of string from group TEXT. -When REGEXP is nil, assumes match data is already set." - (when (or (null regexp) - (thing-at-point-looking-at regexp)) - (let ((cur (point)) - (prefix (cons (match-beginning all) (match-beginning text))) - (suffix (cons (match-end text) (match-end all))) - (bounds (cons (match-beginning text) (match-end text)))) - ;; Replace the thing at point - (replace-match (match-string text) t t nil all) - ;; Reposition the point - (goto-char (markdown-point-after-unwrap cur prefix suffix)) - ;; Adjust bounds - (setq bounds (cons (car prefix) - (- (cdr bounds) (- (cdr prefix) (car prefix)))))))) - -(defun markdown-unwrap-things-in-region (beg end regexp all text) - "Remove prefix and suffix of all things in region from BEG to END. -When a thing in the region matches REGEXP, replace the -subexpression ALL with the string in subexpression TEXT. -Return a cons cell containing updated bounds for the region." - (save-excursion - (goto-char beg) - (let ((removed 0) len-all len-text) - (while (re-search-forward regexp (- end removed) t) - (setq len-all (length (match-string-no-properties all))) - (setq len-text (length (match-string-no-properties text))) - (setq removed (+ removed (- len-all len-text))) - (replace-match (match-string text) t t nil all)) - (cons beg (- end removed))))) - -(defun markdown-insert-hr (arg) - "Insert or replace a horizontal rule. -By default, use the first element of `markdown-hr-strings'. When -ARG is non-nil, as when given a prefix, select a different -element as follows. When prefixed with \\[universal-argument], -use the last element of `markdown-hr-strings' instead. When -prefixed with an integer from 1 to the length of -`markdown-hr-strings', use the element in that position instead." - (interactive "*P") - (when (thing-at-point-looking-at markdown-regex-hr) - (delete-region (match-beginning 0) (match-end 0))) - (markdown-ensure-blank-line-before) - (cond ((equal arg '(4)) - (insert (car (reverse markdown-hr-strings)))) - ((and (integerp arg) (> arg 0) - (<= arg (length markdown-hr-strings))) - (insert (nth (1- arg) markdown-hr-strings))) - (t - (insert (car markdown-hr-strings)))) - (markdown-ensure-blank-line-after)) - -(defun markdown--insert-common (start-delim end-delim regex start-group end-group face - &optional skip-space) - (if (use-region-p) - ;; Active region - (let* ((bounds (markdown-unwrap-things-in-region - (region-beginning) (region-end) - regex start-group end-group)) - (beg (car bounds)) - (end (cdr bounds))) - (when (and beg skip-space) - (save-excursion - (goto-char beg) - (skip-chars-forward " \t") - (setq beg (point)))) - (when (and end skip-space) - (save-excursion - (goto-char end) - (skip-chars-backward " \t") - (setq end (point)))) - (markdown-wrap-or-insert start-delim end-delim nil beg end)) - (if (markdown--face-p (point) (list face)) - (save-excursion - (while (and (markdown--face-p (point) (list face)) (not (bobp))) - (forward-char -1)) - (forward-char (- (1- (length start-delim)))) ;; for delimiter - (unless (bolp) - (forward-char -1)) - (when (looking-at regex) - (markdown-unwrap-thing-at-point nil start-group end-group))) - (if (thing-at-point-looking-at regex) - (markdown-unwrap-thing-at-point nil start-group end-group) - (markdown-wrap-or-insert start-delim end-delim 'word nil nil))))) - -(defun markdown-insert-bold () - "Insert markup to make a region or word bold. -If there is an active region, make the region bold. If the point -is at a non-bold word, make the word bold. If the point is at a -bold word or phrase, remove the bold markup. Otherwise, simply -insert bold delimiters and place the point in between them." - (interactive) - (let ((delim (if markdown-bold-underscore "__" "**"))) - (markdown--insert-common delim delim markdown-regex-bold 2 4 'markdown-bold-face t))) - -(defun markdown-insert-italic () - "Insert markup to make a region or word italic. -If there is an active region, make the region italic. If the point -is at a non-italic word, make the word italic. If the point is at an -italic word or phrase, remove the italic markup. Otherwise, simply -insert italic delimiters and place the point in between them." - (interactive) - (let ((delim (if markdown-italic-underscore "_" "*"))) - (markdown--insert-common delim delim markdown-regex-italic 1 3 'markdown-italic-face t))) - -(defun markdown-insert-strike-through () - "Insert markup to make a region or word strikethrough. -If there is an active region, make the region strikethrough. If the point -is at a non-bold word, make the word strikethrough. If the point is at a -strikethrough word or phrase, remove the strikethrough markup. Otherwise, -simply insert bold delimiters and place the point in between them." - (interactive) - (markdown--insert-common - "~~" "~~" markdown-regex-strike-through 2 4 'markdown-strike-through-face t)) - -(defun markdown-insert-code () - "Insert markup to make a region or word an inline code fragment. -If there is an active region, make the region an inline code -fragment. If the point is at a word, make the word an inline -code fragment. Otherwise, simply insert code delimiters and -place the point in between them." - (interactive) - (if (use-region-p) - ;; Active region - (let ((bounds (markdown-unwrap-things-in-region - (region-beginning) (region-end) - markdown-regex-code 1 3))) - (markdown-wrap-or-insert "`" "`" nil (car bounds) (cdr bounds))) - ;; Code markup removal, code markup for word, or empty markup insertion - (if (markdown-inline-code-at-point) - (markdown-unwrap-thing-at-point nil 0 2) - (markdown-wrap-or-insert "`" "`" 'word nil nil)))) - -(defun markdown-insert-kbd () - "Insert markup to wrap region or word in <kbd> tags. -If there is an active region, use the region. If the point is at -a word, use the word. Otherwise, simply insert <kbd> tags and -place the point in between them." - (interactive) - (if (use-region-p) - ;; Active region - (let ((bounds (markdown-unwrap-things-in-region - (region-beginning) (region-end) - markdown-regex-kbd 0 2))) - (markdown-wrap-or-insert "<kbd>" "</kbd>" nil (car bounds) (cdr bounds))) - ;; Markup removal, markup for word, or empty markup insertion - (if (thing-at-point-looking-at markdown-regex-kbd) - (markdown-unwrap-thing-at-point nil 0 2) - (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil)))) - -(defun markdown-insert-inline-link (text url &optional title) - "Insert an inline link with TEXT pointing to URL. -Optionally, the user can provide a TITLE." - (let ((cur (point))) - (setq title (and title (concat " \"" title "\""))) - (insert (concat "[" text "](" url title ")")) - (cond ((not text) (goto-char (+ 1 cur))) - ((not url) (goto-char (+ 3 (length text) cur)))))) - -(defun markdown-insert-inline-image (text url &optional title) - "Insert an inline link with alt TEXT pointing to URL. -Optionally, also provide a TITLE." - (let ((cur (point))) - (setq title (and title (concat " \"" title "\""))) - (insert (concat "![" text "](" url title ")")) - (cond ((not text) (goto-char (+ 2 cur))) - ((not url) (goto-char (+ 4 (length text) cur)))))) - -(defun markdown-insert-reference-link (text label &optional url title) - "Insert a reference link and, optionally, a reference definition. -The link TEXT will be inserted followed by the optional LABEL. -If a URL is given, also insert a definition for the reference -LABEL according to `markdown-reference-location'. If a TITLE is -given, it will be added to the end of the reference definition -and will be used to populate the title attribute when converted -to XHTML. If URL is nil, insert only the link portion (for -example, when a reference label is already defined)." - (insert (concat "[" text "][" label "]")) - (when url - (markdown-insert-reference-definition - (if (string-equal label "") text label) - url title))) - -(defun markdown-insert-reference-image (text label &optional url title) - "Insert a reference image and, optionally, a reference definition. -The alt TEXT will be inserted followed by the optional LABEL. -If a URL is given, also insert a definition for the reference -LABEL according to `markdown-reference-location'. If a TITLE is -given, it will be added to the end of the reference definition -and will be used to populate the title attribute when converted -to XHTML. If URL is nil, insert only the link portion (for -example, when a reference label is already defined)." - (insert (concat "![" text "][" label "]")) - (when url - (markdown-insert-reference-definition - (if (string-equal label "") text label) - url title))) - -(defun markdown-insert-reference-definition (label &optional url title) - "Add definition for reference LABEL with URL and TITLE. -LABEL is a Markdown reference label without square brackets. -URL and TITLE are optional. When given, the TITLE will -be used to populate the title attribute when converted to XHTML." - ;; END specifies where to leave the point upon return - (let ((end (point))) - (cl-case markdown-reference-location - (end (goto-char (point-max))) - (immediately (markdown-end-of-text-block)) - (subtree (markdown-end-of-subtree)) - (header (markdown-end-of-defun))) - ;; Skip backwards over local variables. This logic is similar to the one - ;; used in ‘hack-local-variables’. - (when (and enable-local-variables (eobp)) - (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move) - (when (let ((case-fold-search t)) - (search-forward "Local Variables:" nil :move)) - (beginning-of-line 0) - (when (eq (char-before) ?\n) (backward-char)))) - (unless (or (markdown-cur-line-blank-p) - (thing-at-point-looking-at markdown-regex-reference-definition)) - (insert "\n")) - (insert "\n[" label "]: ") - (if url - (insert url) - ;; When no URL is given, leave point at END following the colon - (setq end (point))) - (when (> (length title) 0) - (insert " \"" title "\"")) - (unless (looking-at-p "\n") - (insert "\n")) - (goto-char end) - (when url - (message - (markdown--substitute-command-keys - "Reference [%s] was defined, press \\[markdown-do] to jump there") - label)))) - -(defcustom markdown-link-make-text-function nil - "Function that automatically generates a link text for a URL. - -If non-nil, this function will be called by -`markdown--insert-link-or-image' and the result will be the -default link text. The function should receive exactly one -argument that corresponds to the link URL." - :group 'markdown - :type 'function - :package-version '(markdown-mode . "2.5")) - -(defcustom markdown-disable-tooltip-prompt nil - "Disable prompt for tooltip when inserting a link or image. - -If non-nil, `markdown-insert-link' and `markdown-insert-link' -will not prompt the user to insert a tooltip text for the given -link or image." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.5")) - -(defun markdown--insert-link-or-image (image) - "Interactively insert new or update an existing link or image. -When IMAGE is non-nil, insert an image. Otherwise, insert a link. -This is an internal function called by -`markdown-insert-link' and `markdown-insert-image'." - (cl-multiple-value-bind (begin end text uri ref title) - (if (use-region-p) - ;; Use region as either link text or URL as appropriate. - (let ((region (buffer-substring-no-properties - (region-beginning) (region-end)))) - (if (string-match markdown-regex-uri region) - ;; Region contains a URL; use it as such. - (list (region-beginning) (region-end) - nil (match-string 0 region) nil nil) - ;; Region doesn't contain a URL, so use it as text. - (list (region-beginning) (region-end) - region nil nil nil))) - ;; Extract and use properties of existing link, if any. - (markdown-link-at-pos (point))) - (let* ((ref (when ref (concat "[" ref "]"))) - (defined-refs (mapcar #'car (markdown-get-defined-references))) - (defined-ref-cands (mapcar (lambda (ref) (concat "[" ref "]")) defined-refs)) - (used-uris (markdown-get-used-uris)) - (uri-or-ref (completing-read - "URL or [reference]: " - (append defined-ref-cands used-uris) - nil nil (or uri ref))) - (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref) - (match-string 1 uri-or-ref)) - ((string-equal "" uri-or-ref) - ""))) - (uri (unless ref uri-or-ref)) - (text-prompt (if image - "Alt text: " - (if ref - "Link text: " - "Link text (blank for plain URL): "))) - (text (or text (and markdown-link-make-text-function uri - (funcall markdown-link-make-text-function uri)))) - (text (completing-read text-prompt defined-refs nil nil text)) - (text (if (= (length text) 0) nil text)) - (plainp (and uri (not text))) - (implicitp (string-equal ref "")) - (ref (if implicitp text ref)) - (definedp (and ref (markdown-reference-definition ref))) - (ref-url (unless (or uri definedp) - (completing-read "Reference URL: " used-uris))) - (title (unless (or plainp definedp markdown-disable-tooltip-prompt) - (read-string "Title (tooltip text, optional): " title))) - (title (if (= (length title) 0) nil title))) - (when (and image implicitp) - (user-error "Reference required: implicit image references are invalid")) - (when (and begin end) - (delete-region begin end)) - (cond - ((and (not image) uri text) - (markdown-insert-inline-link text uri title)) - ((and image uri text) - (markdown-insert-inline-image text uri title)) - ((and ref text) - (if image - (markdown-insert-reference-image text (unless implicitp ref) nil title) - (markdown-insert-reference-link text (unless implicitp ref) nil title)) - (unless definedp - (markdown-insert-reference-definition ref ref-url title))) - ((and (not image) uri) - (markdown-insert-uri uri)))))) - -(defun markdown-insert-link () - "Insert new or update an existing link, with interactive prompt. -If the point is at an existing link or URL, update the link text, -URL, reference label, and/or title. Otherwise, insert a new link. -The type of link inserted (inline, reference, or plain URL) -depends on which values are provided: - -* If a URL and TEXT are given, insert an inline link: [TEXT](URL). -* If [REF] and TEXT are given, insert a reference link: [TEXT][REF]. -* If only TEXT is given, insert an implicit reference link: [TEXT][]. -* If only a URL is given, insert a plain link: <URL>. - -In other words, to create an implicit reference link, leave the -URL prompt empty and to create a plain URL link, leave the link -text empty. - -If there is an active region, use the text as the default URL, if -it seems to be a URL, or link text value otherwise. - -If a given reference is not defined, this function will -additionally prompt for the URL and optional title. In this case, -the reference definition is placed at the location determined by -`markdown-reference-location'. In addition, it is possible to -have the `markdown-link-make-text-function' function, if non-nil, -define the default link text before prompting the user for it. - -If `markdown-disable-tooltip-prompt' is non-nil, the user will -not be prompted to add or modify a tooltip text. - -Through updating the link, this function can be used to convert a -link of one type (inline, reference, or plain) to another type by -selectively adding or removing information via the prompts." - (interactive) - (markdown--insert-link-or-image nil)) - -(defun markdown-insert-image () - "Insert new or update an existing image, with interactive prompt. -If the point is at an existing image, update the alt text, URL, -reference label, and/or title. Otherwise, insert a new image. -The type of image inserted (inline or reference) depends on which -values are provided: - -* If a URL and ALT-TEXT are given, insert an inline image: - ![ALT-TEXT](URL). -* If [REF] and ALT-TEXT are given, insert a reference image: - ![ALT-TEXT][REF]. - -If there is an active region, use the text as the default URL, if -it seems to be a URL, or alt text value otherwise. - -If a given reference is not defined, this function will -additionally prompt for the URL and optional title. In this case, -the reference definition is placed at the location determined by -`markdown-reference-location'. - -Through updating the image, this function can be used to convert an -image of one type (inline or reference) to another type by -selectively adding or removing information via the prompts." - (interactive) - (markdown--insert-link-or-image t)) - -(defun markdown-insert-uri (&optional uri) - "Insert markup for an inline URI. -If there is an active region, use it as the URI. If the point is -at a URI, wrap it with angle brackets. If the point is at an -inline URI, remove the angle brackets. Otherwise, simply insert -angle brackets place the point between them." - (interactive) - (if (use-region-p) - ;; Active region - (let ((bounds (markdown-unwrap-things-in-region - (region-beginning) (region-end) - markdown-regex-angle-uri 0 2))) - (markdown-wrap-or-insert "<" ">" nil (car bounds) (cdr bounds))) - ;; Markup removal, URI at point, new URI, or empty markup insertion - (if (thing-at-point-looking-at markdown-regex-angle-uri) - (markdown-unwrap-thing-at-point nil 0 2) - (if uri - (insert "<" uri ">") - (markdown-wrap-or-insert "<" ">" 'url nil nil))))) - -(defun markdown-insert-wiki-link () - "Insert a wiki link of the form [[WikiLink]]. -If there is an active region, use the region as the link text. -If the point is at a word, use the word as the link text. If -there is no active region and the point is not at word, simply -insert link markup." - (interactive) - (if (use-region-p) - ;; Active region - (markdown-wrap-or-insert "[[" "]]" nil (region-beginning) (region-end)) - ;; Markup removal, wiki link at at point, or empty markup insertion - (if (thing-at-point-looking-at markdown-regex-wiki-link) - (if (or markdown-wiki-link-alias-first - (null (match-string 5))) - (markdown-unwrap-thing-at-point nil 1 3) - (markdown-unwrap-thing-at-point nil 1 5)) - (markdown-wrap-or-insert "[[" "]]")))) - -(defun markdown-remove-header () - "Remove header markup if point is at a header. -Return bounds of remaining header text if a header was removed -and nil otherwise." - (interactive "*") - (or (markdown-unwrap-thing-at-point markdown-regex-header-atx 0 2) - (markdown-unwrap-thing-at-point markdown-regex-header-setext 0 1))) - -(defun markdown-insert-header (&optional level text setext) - "Insert or replace header markup. -The level of the header is specified by LEVEL and header text is -given by TEXT. LEVEL must be an integer from 1 and 6, and the -default value is 1. -When TEXT is nil, the header text is obtained as follows. -If there is an active region, it is used as the header text. -Otherwise, the current line will be used as the header text. -If there is not an active region and the point is at a header, -remove the header markup and replace with level N header. -Otherwise, insert empty header markup and place the point in -between. -The style of the header will be atx (hash marks) unless -SETEXT is non-nil, in which case a setext-style (underlined) -header will be inserted." - (interactive "p\nsHeader text: ") - (setq level (min (max (or level 1) 1) (if setext 2 6))) - ;; Determine header text if not given - (when (null text) - (if (use-region-p) - ;; Active region - (setq text (delete-and-extract-region (region-beginning) (region-end))) - ;; No active region - (markdown-remove-header) - (setq text (delete-and-extract-region - (line-beginning-position) (line-end-position))) - (when (and setext (string-match-p "^[ \t]*$" text)) - (setq text (read-string "Header text: ")))) - (setq text (markdown-compress-whitespace-string text))) - ;; Insertion with given text - (markdown-ensure-blank-line-before) - (let (hdr) - (cond (setext - (setq hdr (make-string (string-width text) (if (= level 2) ?- ?=))) - (insert text "\n" hdr)) - (t - (setq hdr (make-string level ?#)) - (insert hdr " " text) - (when (null markdown-asymmetric-header) (insert " " hdr))))) - (markdown-ensure-blank-line-after) - ;; Leave point at end of text - (cond (setext - (backward-char (1+ (string-width text)))) - ((null markdown-asymmetric-header) - (backward-char (1+ level))))) - -(defun markdown-insert-header-dwim (&optional arg setext) - "Insert or replace header markup. -The level and type of the header are determined automatically by -the type and level of the previous header, unless a prefix -argument is given via ARG. -With a numeric prefix valued 1 to 6, insert a header of the given -level, with the type being determined automatically (note that -only level 1 or 2 setext headers are possible). - -With a \\[universal-argument] prefix (i.e., when ARG is (4)), -promote the heading by one level. -With two \\[universal-argument] prefixes (i.e., when ARG is (16)), -demote the heading by one level. -When SETEXT is non-nil, prefer setext-style headers when -possible (levels one and two). - -When there is an active region, use it for the header text. When -the point is at an existing header, change the type and level -according to the rules above. -Otherwise, if the line is not empty, create a header using the -text on the current line as the header text. -Finally, if the point is on a blank line, insert empty header -markup (atx) or prompt for text (setext). -See `markdown-insert-header' for more details about how the -header text is determined." - (interactive "*P") - (let (level) - (save-excursion - (when (or (thing-at-point-looking-at markdown-regex-header) - (re-search-backward markdown-regex-header nil t)) - ;; level of current or previous header - (setq level (markdown-outline-level)) - ;; match group 1 indicates a setext header - (setq setext (match-end 1)))) - ;; check prefix argument - (cond - ((and (equal arg '(4)) level (> level 1)) ;; C-u - (cl-decf level)) - ((and (equal arg '(16)) level (< level 6)) ;; C-u C-u - (cl-incf level)) - (arg ;; numeric prefix - (setq level (prefix-numeric-value arg)))) - ;; setext headers must be level one or two - (and level (setq setext (and setext (<= level 2)))) - ;; insert the heading - (markdown-insert-header level nil setext))) - -(defun markdown-insert-header-setext-dwim (&optional arg) - "Insert or replace header markup, with preference for setext. -See `markdown-insert-header-dwim' for details, including how ARG is handled." - (interactive "*P") - (markdown-insert-header-dwim arg t)) - -(defun markdown-insert-header-atx-1 () - "Insert a first level atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 1 nil nil)) - -(defun markdown-insert-header-atx-2 () - "Insert a level two atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 2 nil nil)) - -(defun markdown-insert-header-atx-3 () - "Insert a level three atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 3 nil nil)) - -(defun markdown-insert-header-atx-4 () - "Insert a level four atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 4 nil nil)) - -(defun markdown-insert-header-atx-5 () - "Insert a level five atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 5 nil nil)) - -(defun markdown-insert-header-atx-6 () - "Insert a sixth level atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 6 nil nil)) - -(defun markdown-insert-header-setext-1 () - "Insert a setext-style (underlined) first-level header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 1 nil t)) - -(defun markdown-insert-header-setext-2 () - "Insert a setext-style (underlined) second-level header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 2 nil t)) - -(defun markdown-blockquote-indentation (loc) - "Return string containing necessary indentation for a blockquote at LOC. -Also see `markdown-pre-indentation'." - (save-excursion - (goto-char loc) - (let* ((list-level (length (markdown-calculate-list-levels))) - (indent "")) - (dotimes (_ list-level indent) - (setq indent (concat indent " ")))))) - -(defun markdown-insert-blockquote () - "Start a blockquote section (or blockquote the region). -If Transient Mark mode is on and a region is active, it is used as -the blockquote text." - (interactive) - (if (use-region-p) - (markdown-blockquote-region (region-beginning) (region-end)) - (markdown-ensure-blank-line-before) - (insert (markdown-blockquote-indentation (point)) "> ") - (markdown-ensure-blank-line-after))) - -(defun markdown-block-region (beg end prefix) - "Format the region using a block prefix. -Arguments BEG and END specify the beginning and end of the -region. The characters PREFIX will appear at the beginning -of each line." - (save-excursion - (let* ((end-marker (make-marker)) - (beg-marker (make-marker)) - (prefix-without-trailing-whitespace - (replace-regexp-in-string (rx (+ blank) eos) "" prefix))) - ;; Ensure blank line after and remove extra whitespace - (goto-char end) - (skip-syntax-backward "-") - (set-marker end-marker (point)) - (delete-horizontal-space) - (markdown-ensure-blank-line-after) - ;; Ensure blank line before and remove extra whitespace - (goto-char beg) - (skip-syntax-forward "-") - (delete-horizontal-space) - (markdown-ensure-blank-line-before) - (set-marker beg-marker (point)) - ;; Insert PREFIX before each line - (goto-char beg-marker) - (while (and (< (line-beginning-position) end-marker) - (not (eobp))) - ;; Don’t insert trailing whitespace. - (insert (if (eolp) prefix-without-trailing-whitespace prefix)) - (forward-line))))) - -(defun markdown-blockquote-region (beg end) - "Blockquote the region. -Arguments BEG and END specify the beginning and end of the region." - (interactive "*r") - (markdown-block-region - beg end (concat (markdown-blockquote-indentation - (max (point-min) (1- beg))) "> "))) - -(defun markdown-pre-indentation (loc) - "Return string containing necessary whitespace for a pre block at LOC. -Also see `markdown-blockquote-indentation'." - (save-excursion - (goto-char loc) - (let* ((list-level (length (markdown-calculate-list-levels))) - indent) - (dotimes (_ (1+ list-level) indent) - (setq indent (concat indent " ")))))) - -(defun markdown-insert-pre () - "Start a preformatted section (or apply to the region). -If Transient Mark mode is on and a region is active, it is marked -as preformatted text." - (interactive) - (if (use-region-p) - (markdown-pre-region (region-beginning) (region-end)) - (markdown-ensure-blank-line-before) - (insert (markdown-pre-indentation (point))) - (markdown-ensure-blank-line-after))) - -(defun markdown-pre-region (beg end) - "Format the region as preformatted text. -Arguments BEG and END specify the beginning and end of the region." - (interactive "*r") - (let ((indent (markdown-pre-indentation (max (point-min) (1- beg))))) - (markdown-block-region beg end indent))) - -(defun markdown-electric-backquote (arg) - "Insert a backquote. -The numeric prefix argument ARG says how many times to repeat the insertion. -Call `markdown-insert-gfm-code-block' interactively -if three backquotes inserted at the beginning of line." - (interactive "*P") - (self-insert-command (prefix-numeric-value arg)) - (when (and markdown-gfm-use-electric-backquote (looking-back "^```" nil)) - (replace-match "") - (call-interactively #'markdown-insert-gfm-code-block))) - -(defconst markdown-gfm-recognized-languages - ;; To reproduce/update, evaluate the let-form in - ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp, - ;; but with appropriate use of a keyboard macro, indenting and filling it - ;; properly is pretty fast. - '("1C-Enterprise" "2-Dimensional-Array" "4D" "ABAP" "ABAP-CDS" "ABNF" - "AGS-Script" "AIDL" "AL" "AMPL" "ANTLR" "API-Blueprint" "APL" "ASL" - "ASN.1" "ASP.NET" "ATS" "ActionScript" "Ada" "Adblock-Filter-List" - "Adobe-Font-Metrics" "Agda" "Alloy" "Alpine-Abuild" "Altium-Designer" - "AngelScript" "Ant-Build-System" "Antlers" "ApacheConf" "Apex" - "Apollo-Guidance-Computer" "AppleScript" "Arc" "AsciiDoc" "AspectJ" - "Assembly" "Astro" "Asymptote" "Augeas" "AutoHotkey" "AutoIt" - "Avro-IDL" "Awk" "BASIC" "Ballerina" "Batchfile" "Beef" "Befunge" - "Berry" "BibTeX" "Bicep" "Bikeshed" "Bison" "BitBake" "Blade" - "BlitzBasic" "BlitzMax" "Bluespec" "Bluespec-BH" "Boo" "Boogie" - "Brainfuck" "BrighterScript" "Brightscript" "Browserslist" "C" "C#" - "C++" "C-ObjDump" "C2hs-Haskell" "CAP-CDS" "CIL" "CLIPS" "CMake" - "COBOL" "CODEOWNERS" "COLLADA" "CSON" "CSS" "CSV" "CUE" "CWeb" - "Cabal-Config" "Cadence" "Cairo" "CameLIGO" "Cap'n-Proto" "CartoCSS" - "Ceylon" "Chapel" "Charity" "Checksums" "ChucK" "Circom" "Cirru" - "Clarion" "Clarity" "Classic-ASP" "Clean" "Click" "Clojure" - "Closure-Templates" "Cloud-Firestore-Security-Rules" "CoNLL-U" - "CodeQL" "CoffeeScript" "ColdFusion" "ColdFusion-CFC" "Common-Lisp" - "Common-Workflow-Language" "Component-Pascal" "Cool" "Coq" - "Cpp-ObjDump" "Creole" "Crystal" "Csound" "Csound-Document" - "Csound-Score" "Cuda" "Cue-Sheet" "Curry" "Cycript" "Cypher" "Cython" - "D" "D-ObjDump" "D2" "DIGITAL-Command-Language" "DM" "DNS-Zone" - "DTrace" "Dafny" "Darcs-Patch" "Dart" "DataWeave" - "Debian-Package-Control-File" "DenizenScript" "Dhall" "Diff" - "DirectX-3D-File" "Dockerfile" "Dogescript" "Dotenv" "Dylan" "E" - "E-mail" "EBNF" "ECL" "ECLiPSe" "EJS" "EQ" "Eagle" "Earthly" - "Easybuild" "Ecere-Projects" "Ecmarkup" "Edge" "EdgeQL" - "EditorConfig" "Edje-Data-Collection" "Eiffel" "Elixir" "Elm" - "Elvish" "Elvish-Transcript" "Emacs-Lisp" "EmberScript" "Erlang" - "Euphoria" "F#" "F*" "FIGlet-Font" "FLUX" "Factor" "Fancy" "Fantom" - "Faust" "Fennel" "Filebench-WML" "Filterscript" "Fluent" "Formatted" - "Forth" "Fortran" "Fortran-Free-Form" "FreeBasic" "FreeMarker" - "Frege" "Futhark" "G-code" "GAML" "GAMS" "GAP" - "GCC-Machine-Description" "GDB" "GDScript" "GEDCOM" "GLSL" "GN" "GSC" - "Game-Maker-Language" "Gemfile.lock" "Gemini" "Genero-4gl" - "Genero-per" "Genie" "Genshi" "Gentoo-Ebuild" "Gentoo-Eclass" - "Gerber-Image" "Gettext-Catalog" "Gherkin" "Git-Attributes" - "Git-Config" "Git-Revision-List" "Gleam" "Glimmer-JS" "Glimmer-TS" - "Glyph" "Glyph-Bitmap-Distribution-Format" "Gnuplot" "Go" - "Go-Checksums" "Go-Module" "Go-Workspace" "Godot-Resource" "Golo" - "Gosu" "Grace" "Gradle" "Gradle-Kotlin-DSL" "Grammatical-Framework" - "Graph-Modeling-Language" "GraphQL" "Graphviz-(DOT)" "Groovy" - "Groovy-Server-Pages" "HAProxy" "HCL" "HLSL" "HOCON" "HTML" - "HTML+ECR" "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTML+Razor" "HTTP" - "HXML" "Hack" "Haml" "Handlebars" "Harbour" "Haskell" "Haxe" "HiveQL" - "HolyC" "Hosts-File" "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI" "IRC-log" - "Idris" "Ignore-List" "ImageJ-Macro" "Imba" "Inform-7" "Ink" - "Inno-Setup" "Io" "Ioke" "Isabelle" "Isabelle-ROOT" "J" - "JAR-Manifest" "JCL" "JFlex" "JSON" "JSON-with-Comments" "JSON5" - "JSONLD" "JSONiq" "Janet" "Jasmin" "Java" "Java-Properties" - "Java-Server-Pages" "JavaScript" "JavaScript+ERB" "Jest-Snapshot" - "JetBrains-MPS" "Jinja" "Jison" "Jison-Lex" "Jolie" "Jsonnet" "Julia" - "Jupyter-Notebook" "Just" "KRL" "Kaitai-Struct" "KakouneScript" - "KerboScript" "KiCad-Layout" "KiCad-Legacy-Layout" "KiCad-Schematic" - "Kickstart" "Kit" "Kotlin" "Kusto" "LFE" "LLVM" "LOLCODE" "LSL" - "LTspice-Symbol" "LabVIEW" "Lark" "Lasso" "Latte" "Lean" "Lean-4" - "Less" "Lex" "LigoLANG" "LilyPond" "Limbo" "Linker-Script" - "Linux-Kernel-Module" "Liquid" "Literate-Agda" - "Literate-CoffeeScript" "Literate-Haskell" "LiveScript" "Logos" - "Logtalk" "LookML" "LoomScript" "Lua" "M" "M4" "M4Sugar" "MATLAB" - "MAXScript" "MDX" "MLIR" "MQL4" "MQL5" "MTML" "MUF" "Macaulay2" - "Makefile" "Mako" "Markdown" "Marko" "Mask" "Mathematica" "Maven-POM" - "Max" "Mercury" "Mermaid" "Meson" "Metal" - "Microsoft-Developer-Studio-Project" - "Microsoft-Visual-Studio-Solution" "MiniD" "MiniYAML" "Mint" "Mirah" - "Modelica" "Modula-2" "Modula-3" "Module-Management-System" "Mojo" - "Monkey" "Monkey-C" "Moocode" "MoonScript" "Motoko" - "Motorola-68K-Assembly" "Move" "Muse" "Mustache" "Myghty" "NASL" - "NCL" "NEON" "NL" "NPM-Config" "NSIS" "NWScript" "Nasal" "Nearley" - "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo" "NewLisp" "Nextflow" - "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "Nunjucks" "Nushell" - "OASv2-json" "OASv2-yaml" "OASv3-json" "OASv3-yaml" "OCaml" "Oberon" - "ObjDump" "Object-Data-Instance-Notation" "ObjectScript" - "Objective-C" "Objective-C++" "Objective-J" "Odin" "Omgrofl" "Opa" - "Opal" "Open-Policy-Agent" "OpenAPI-Specification-v2" - "OpenAPI-Specification-v3" "OpenCL" "OpenEdge-ABL" "OpenQASM" - "OpenRC-runscript" "OpenSCAD" "OpenStep-Property-List" - "OpenType-Feature-File" "Option-List" "Org" "Ox" "Oxygene" "Oz" "P4" - "PDDL" "PEG.js" "PHP" "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pact" "Pan" - "Papyrus" "Parrot" "Parrot-Assembly" "Parrot-Internal-Representation" - "Pascal" "Pawn" "Pep8" "Perl" "Pic" "Pickle" "PicoLisp" "PigLatin" - "Pike" "Pip-Requirements" "PlantUML" "Pod" "Pod-6" "PogoScript" - "Polar" "Pony" "Portugol" "PostCSS" "PostScript" "PowerBuilder" - "PowerShell" "Praat" "Prisma" "Processing" "Procfile" "Proguard" - "Prolog" "Promela" "Propeller-Spin" "Protocol-Buffer" - "Protocol-Buffer-Text-Format" "Public-Key" "Pug" "Puppet" "Pure-Data" - "PureBasic" "PureScript" "Pyret" "Python" "Python-console" - "Python-traceback" "Q#" "QML" "QMake" "Qt-Script" "Quake" "R" "RAML" - "RBS" "RDoc" "REALbasic" "REXX" "RMarkdown" "RPC" "RPGLE" "RPM-Spec" - "RUNOFF" "Racket" "Ragel" "Raku" "Rascal" "Raw-token-data" "ReScript" - "Readline-Config" "Reason" "ReasonLIGO" "Rebol" "Record-Jar" "Red" - "Redcode" "Redirect-Rules" "Regular-Expression" "Ren'Py" - "RenderScript" "Rez" "Rich-Text-Format" "Ring" "Riot" - "RobotFramework" "Roc" "Roff" "Roff-Manpage" "Rouge" - "RouterOS-Script" "Ruby" "Rust" "SAS" "SCSS" "SELinux-Policy" "SMT" - "SPARQL" "SQF" "SQL" "SQLPL" "SRecode-Template" "SSH-Config" "STAR" - "STL" "STON" "SVG" "SWIG" "Sage" "SaltStack" "Sass" "Scala" "Scaml" - "Scenic" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" - "ShellCheck-Config" "ShellSession" "Shen" "Sieve" - "Simple-File-Verification" "Singularity" "Slash" "Slice" "Slim" - "Slint" "SmPL" "Smali" "Smalltalk" "Smarty" "Smithy" "Snakemake" - "Solidity" "Soong" "SourcePawn" "Spline-Font-Database" "Squirrel" - "Stan" "Standard-ML" "Starlark" "Stata" "StringTemplate" "Stylus" - "SubRip-Text" "SugarSS" "SuperCollider" "Svelte" "Sway" "Sweave" - "Swift" "SystemVerilog" "TI-Program" "TL-Verilog" "TLA" "TOML" "TSQL" - "TSV" "TSX" "TXL" "Talon" "Tcl" "Tcsh" "TeX" "Tea" "Terra" - "Terraform-Template" "Texinfo" "Text" "TextGrid" - "TextMate-Properties" "Textile" "Thrift" "Toit" "Turing" "Turtle" - "Twig" "Type-Language" "TypeScript" "Typst" "Unified-Parallel-C" - "Unity3D-Asset" "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "V" - "VBA" "VBScript" "VCL" "VHDL" "Vala" "Valve-Data-Format" - "Velocity-Template-Language" "Verilog" "Vim-Help-File" "Vim-Script" - "Vim-Snippet" "Visual-Basic-.NET" "Visual-Basic-6.0" "Volt" "Vue" - "Vyper" "WDL" "WGSL" "Wavefront-Material" "Wavefront-Object" - "Web-Ontology-Language" "WebAssembly" "WebAssembly-Interface-Type" - "WebIDL" "WebVTT" "Wget-Config" "Whiley" "Wikitext" - "Win32-Message-File" "Windows-Registry-Entries" "Witcher-Script" - "Wollok" "World-of-Warcraft-Addon-Data" "Wren" "X-BitMap" - "X-Font-Directory-Index" "X-PixMap" "X10" "XC" "XCompose" "XML" - "XML-Property-List" "XPages" "XProc" "XQuery" "XS" "XSLT" "Xojo" - "Xonsh" "Xtend" "YAML" "YANG" "YARA" "YASnippet" "Yacc" "Yul" "ZAP" - "ZIL" "Zeek" "ZenScript" "Zephir" "Zig" "Zimpl" "cURL-Config" - "desktop" "dircolors" "eC" "edn" "fish" "hoon" "jq" "kvlang" - "mIRC-Script" "mcfunction" "mupad" "nanorc" "nesC" "ooc" "q" - "reStructuredText" "robots.txt" "sed" "wisp" "xBase") - "Language specifiers recognized by GitHub's syntax highlighting features.") - -(defvar-local markdown-gfm-used-languages nil - "Language names used in GFM code blocks.") - -(defun markdown-trim-whitespace (str) - (replace-regexp-in-string - "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str)) - -(defun markdown-clean-language-string (str) - (replace-regexp-in-string - "{\\.?\\|}" "" (markdown-trim-whitespace str))) - -(defun markdown-validate-language-string (widget) - (let ((str (widget-value widget))) - (unless (string= str (markdown-clean-language-string str)) - (widget-put widget :error (format "Invalid language spec: '%s'" str)) - widget))) - -(defun markdown-gfm-get-corpus () - "Create corpus of recognized GFM code block languages for the given buffer." - (let ((given-corpus (append markdown-gfm-additional-languages - markdown-gfm-recognized-languages))) - (append - markdown-gfm-used-languages - (if markdown-gfm-downcase-languages (cl-mapcar #'downcase given-corpus) - given-corpus)))) - -(defun markdown-gfm-add-used-language (lang) - "Clean LANG and add to list of used languages." - (setq markdown-gfm-used-languages - (cons lang (remove lang markdown-gfm-used-languages)))) - -(defcustom markdown-spaces-after-code-fence 1 - "Number of space characters to insert after a code fence. -\\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an -opening code fence and an info string." - :group 'markdown - :type 'integer - :safe #'natnump - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-code-block-braces nil - "When non-nil, automatically insert braces for GFM code blocks." - :group 'markdown - :type 'boolean) - -(defun markdown-insert-gfm-code-block (&optional lang edit) - "Insert GFM code block for language LANG. -If LANG is nil, the language will be queried from user. If a -region is active, wrap this region with the markup instead. If -the region boundaries are not on empty lines, these are added -automatically in order to have the correct markup. When EDIT is -non-nil (e.g., when \\[universal-argument] is given), edit the -code block in an indirect buffer after insertion." - (interactive - (list (let ((completion-ignore-case nil)) - (condition-case nil - (markdown-clean-language-string - (completing-read - "Programming language: " - (markdown-gfm-get-corpus) - nil 'confirm (car markdown-gfm-used-languages) - 'markdown-gfm-language-history)) - (quit ""))) - current-prefix-arg)) - (unless (string= lang "") (markdown-gfm-add-used-language lang)) - (when (and (> (length lang) 0) - (not markdown-code-block-braces)) - (setq lang (concat (make-string markdown-spaces-after-code-fence ?\s) - lang))) - (let ((gfm-open-brace (if markdown-code-block-braces "{" "")) - (gfm-close-brace (if markdown-code-block-braces "}" ""))) - (if (use-region-p) - (let* ((b (region-beginning)) (e (region-end)) end - (indent (progn (goto-char b) (current-indentation)))) - (goto-char e) - ;; if we're on a blank line, don't newline, otherwise the ``` - ;; should go on its own line - (unless (looking-back "\n" nil) - (newline)) - (indent-to indent) - (insert "```") - (markdown-ensure-blank-line-after) - (setq end (point)) - (goto-char b) - ;; if we're on a blank line, insert the quotes here, otherwise - ;; add a new line first - (unless (looking-at-p "\n") - (newline) - (forward-line -1)) - (markdown-ensure-blank-line-before) - (indent-to indent) - (insert "```" gfm-open-brace lang gfm-close-brace) - (markdown-syntax-propertize-fenced-block-constructs (line-beginning-position) end)) - (let ((indent (current-indentation)) - start-bol) - (delete-horizontal-space :backward-only) - (markdown-ensure-blank-line-before) - (indent-to indent) - (setq start-bol (line-beginning-position)) - (insert "```" gfm-open-brace lang gfm-close-brace "\n") - (indent-to indent) - (unless edit (insert ?\n)) - (indent-to indent) - (insert "```") - (markdown-ensure-blank-line-after) - (markdown-syntax-propertize-fenced-block-constructs start-bol (point))) - (end-of-line 0) - (when edit (markdown-edit-code-block))))) - -(defun markdown-code-block-lang (&optional pos-prop) - "Return the language name for a GFM or tilde fenced code block. -The beginning of the block may be described by POS-PROP, -a cons of (pos . prop) giving the position and property -at the beginning of the block." - (or pos-prop - (setq pos-prop - (markdown-max-of-seq - #'car - (cl-remove-if - #'null - (cl-mapcar - #'markdown-find-previous-prop - (markdown-get-fenced-block-begin-properties)))))) - (when pos-prop - (goto-char (car pos-prop)) - (set-match-data (get-text-property (point) (cdr pos-prop))) - ;; Note: Hard-coded group number assumes tilde - ;; and GFM fenced code regexp groups agree. - (let ((begin (match-beginning 3)) - (end (match-end 3))) - (when (and begin end) - ;; Fix language strings beginning with periods, like ".ruby". - (when (eq (char-after begin) ?.) - (setq begin (1+ begin))) - (buffer-substring-no-properties begin end))))) - -(defun markdown-gfm-parse-buffer-for-languages (&optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (save-excursion - (goto-char (point-min)) - (cl-loop - with prop = 'markdown-gfm-block-begin - for pos-prop = (markdown-find-next-prop prop) - while pos-prop - for lang = (markdown-code-block-lang pos-prop) - do (progn (when lang (markdown-gfm-add-used-language lang)) - (goto-char (next-single-property-change (point) prop))))))) - -(defun markdown-insert-foldable-block () - "Insert details disclosure element to make content foldable. -If a region is active, wrap this region with the disclosure -element. More details here https://developer.mozilla.org/en-US/docs/Web/HTML/Element/details." - (interactive) - (let ((details-open-tag "<details>") - (details-close-tag "</details>") - (summary-open-tag "<summary>") - (summary-close-tag " </summary>")) - (if (use-region-p) - (let* ((b (region-beginning)) - (e (region-end)) - (indent (progn (goto-char b) (current-indentation)))) - (goto-char e) - ;; if we're on a blank line, don't newline, otherwise the tags - ;; should go on its own line - (unless (looking-back "\n" nil) - (newline)) - (indent-to indent) - (insert details-close-tag) - (markdown-ensure-blank-line-after) - (goto-char b) - ;; if we're on a blank line, insert the quotes here, otherwise - ;; add a new line first - (unless (looking-at-p "\n") - (newline) - (forward-line -1)) - (markdown-ensure-blank-line-before) - (indent-to indent) - (insert details-open-tag "\n") - (insert summary-open-tag summary-close-tag) - (search-backward summary-close-tag)) - (let ((indent (current-indentation))) - (delete-horizontal-space :backward-only) - (markdown-ensure-blank-line-before) - (indent-to indent) - (insert details-open-tag "\n") - (insert summary-open-tag summary-close-tag "\n") - (insert details-close-tag) - (indent-to indent) - (markdown-ensure-blank-line-after) - (search-backward summary-close-tag))))) - - -;;; Footnotes ================================================================= - -(defun markdown-footnote-counter-inc () - "Increment `markdown-footnote-counter' and return the new value." - (when (= markdown-footnote-counter 0) ; hasn't been updated in this buffer yet. - (save-excursion - (goto-char (point-min)) - (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars "*?\\)\\]:") - (point-max) t) - (let ((fn (string-to-number (match-string 1)))) - (when (> fn markdown-footnote-counter) - (setq markdown-footnote-counter fn)))))) - (cl-incf markdown-footnote-counter)) - -(defun markdown-insert-footnote () - "Insert footnote with a new number and move point to footnote definition." - (interactive) - (let ((fn (markdown-footnote-counter-inc))) - (insert (format "[^%d]" fn)) - (push-mark (point) t) - (markdown-footnote-text-find-new-location) - (markdown-ensure-blank-line-before) - (unless (markdown-cur-line-blank-p) - (insert "\n")) - (insert (format "[^%d]: " fn)) - (markdown-ensure-blank-line-after))) - -(defun markdown-footnote-text-find-new-location () - "Position the point at the proper location for a new footnote text." - (cond - ((eq markdown-footnote-location 'end) (goto-char (point-max))) - ((eq markdown-footnote-location 'immediately) (markdown-end-of-text-block)) - ((eq markdown-footnote-location 'subtree) (markdown-end-of-subtree)) - ((eq markdown-footnote-location 'header) (markdown-end-of-defun)))) - -(defun markdown-footnote-kill () - "Kill the footnote at point. -The footnote text is killed (and added to the kill ring), the -footnote marker is deleted. Point has to be either at the -footnote marker or in the footnote text." - (interactive) - (let ((marker-pos nil) - (skip-deleting-marker nil) - (starting-footnote-text-positions - (markdown-footnote-text-positions))) - (when starting-footnote-text-positions - ;; We're starting in footnote text, so mark our return position and jump - ;; to the marker if possible. - (let ((marker-pos (markdown-footnote-find-marker - (cl-first starting-footnote-text-positions)))) - (if marker-pos - (goto-char (1- marker-pos)) - ;; If there isn't a marker, we still want to kill the text. - (setq skip-deleting-marker t)))) - ;; Either we didn't start in the text, or we started in the text and jumped - ;; to the marker. We want to assume we're at the marker now and error if - ;; we're not. - (unless skip-deleting-marker - (let ((marker (markdown-footnote-delete-marker))) - (unless marker - (error "Not at a footnote")) - ;; Even if we knew the text position before, it changed when we deleted - ;; the label. - (setq marker-pos (cl-second marker)) - (let ((new-text-pos (markdown-footnote-find-text (cl-first marker)))) - (unless new-text-pos - (error "No text for footnote `%s'" (cl-first marker))) - (goto-char new-text-pos)))) - (let ((pos (markdown-footnote-kill-text))) - (goto-char (if starting-footnote-text-positions - pos - marker-pos))))) - -(defun markdown-footnote-delete-marker () - "Delete a footnote marker at point. -Returns a list (ID START) containing the footnote ID and the -start position of the marker before deletion. If no footnote -marker was deleted, this function returns NIL." - (let ((marker (markdown-footnote-marker-positions))) - (when marker - (delete-region (cl-second marker) (cl-third marker)) - (butlast marker)))) - -(defun markdown-footnote-kill-text () - "Kill footnote text at point. -Returns the start position of the footnote text before deletion, -or NIL if point was not inside a footnote text. - -The killed text is placed in the kill ring (without the footnote -number)." - (let ((fn (markdown-footnote-text-positions))) - (when fn - (let ((text (delete-and-extract-region (cl-second fn) (cl-third fn)))) - (string-match (concat "\\[\\" (cl-first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text) - (kill-new (match-string 1 text)) - (when (and (markdown-cur-line-blank-p) - (markdown-prev-line-blank-p) - (not (bobp))) - (delete-region (1- (point)) (point))) - (cl-second fn))))) - -(defun markdown-footnote-goto-text () - "Jump to the text of the footnote at point." - (interactive) - (let ((fn (car (markdown-footnote-marker-positions)))) - (unless fn - (user-error "Not at a footnote marker")) - (let ((new-pos (markdown-footnote-find-text fn))) - (unless new-pos - (error "No definition found for footnote `%s'" fn)) - (goto-char new-pos)))) - -(defun markdown-footnote-return () - "Return from a footnote to its footnote number in the main text." - (interactive) - (let ((fn (save-excursion - (car (markdown-footnote-text-positions))))) - (unless fn - (user-error "Not in a footnote")) - (let ((new-pos (markdown-footnote-find-marker fn))) - (unless new-pos - (error "Footnote marker `%s' not found" fn)) - (goto-char new-pos)))) - -(defun markdown-footnote-find-marker (id) - "Find the location of the footnote marker with ID. -The actual buffer position returned is the position directly -following the marker's closing bracket. If no marker is found, -NIL is returned." - (save-excursion - (goto-char (point-min)) - (when (re-search-forward (concat "\\[" id "\\]\\([^:]\\|\\'\\)") nil t) - (skip-chars-backward "^]") - (point)))) - -(defun markdown-footnote-find-text (id) - "Find the location of the text of footnote ID. -The actual buffer position returned is the position of the first -character of the text, after the footnote's identifier. If no -footnote text is found, NIL is returned." - (save-excursion - (goto-char (point-min)) - (when (re-search-forward (concat "^ \\{0,3\\}\\[" id "\\]:") nil t) - (skip-chars-forward " \t") - (point)))) - -(defun markdown-footnote-marker-positions () - "Return the position and ID of the footnote marker point is on. -The return value is a list (ID START END). If point is not on a -footnote, NIL is returned." - ;; first make sure we're at a footnote marker - (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars "*\\]?") (line-beginning-position)) - (looking-at-p (concat "\\[?\\^" markdown-footnote-chars "*?\\]"))) - (save-excursion - ;; move point between [ and ^: - (if (looking-at-p "\\[") - (forward-char 1) - (skip-chars-backward "^[")) - (looking-at (concat "\\(\\^" markdown-footnote-chars "*?\\)\\]")) - (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1)))))) - -(defun markdown-footnote-text-positions () - "Return the start and end positions of the footnote text point is in. -The exact return value is a list of three elements: (ID START END). -The start position is the position of the opening bracket -of the footnote id. The end position is directly after the -newline that ends the footnote. If point is not in a footnote, -NIL is returned instead." - (save-excursion - (let (result) - (move-beginning-of-line 1) - ;; Try to find the label. If we haven't found the label and we're at a blank - ;; or indented line, back up if possible. - (while (and - (not (and (looking-at markdown-regex-footnote-definition) - (setq result (list (match-string 1) (point))))) - (and (not (bobp)) - (or (markdown-cur-line-blank-p) - (>= (current-indentation) 4)))) - (forward-line -1)) - (when result - ;; Advance if there is a next line that is either blank or indented. - ;; (Need to check if we're on the last line, because - ;; markdown-next-line-blank-p returns true for last line in buffer.) - (while (and (/= (line-end-position) (point-max)) - (or (markdown-next-line-blank-p) - (>= (markdown-next-line-indent) 4))) - (forward-line)) - ;; Move back while the current line is blank. - (while (markdown-cur-line-blank-p) - (forward-line -1)) - ;; Advance to capture this line and a single trailing newline (if there - ;; is one). - (forward-line) - (append result (list (point))))))) - -(defun markdown-get-defined-footnotes () - "Return a list of all defined footnotes. -Result is an alist of pairs (MARKER . LINE), where MARKER is the -footnote marker, a string, and LINE is the line number containing -the footnote definition. - -For example, suppose the following footnotes are defined at positions -448 and 475: - -\[^1]: First footnote here. -\[^marker]: Second footnote. - -Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))" - (save-excursion - (goto-char (point-min)) - (let (footnotes) - (while (markdown-search-until-condition - (lambda () (and (not (markdown-code-block-at-point-p)) - (not (markdown-inline-code-at-point-p)) - (not (markdown-in-comment-p)))) - markdown-regex-footnote-definition nil t) - (let ((marker (match-string-no-properties 1)) - (pos (match-beginning 0))) - (unless (zerop (length marker)) - (cl-pushnew (cons marker pos) footnotes :test #'equal)))) - (reverse footnotes)))) - - -;;; Element Removal =========================================================== - -(defun markdown-kill-thing-at-point () - "Kill thing at point and add important text, without markup, to kill ring. -Possible things to kill include (roughly in order of precedence): -inline code, headers, horizontal rules, links (add link text to -kill ring), images (add alt text to kill ring), angle uri, email -addresses, bold, italics, reference definition (add URI to kill -ring), footnote markers and text (kill both marker and text, add -text to kill ring), and list items." - (interactive "*") - (let (val) - (cond - ;; Inline code - ((markdown-inline-code-at-point) - (kill-new (match-string 2)) - (delete-region (match-beginning 0) (match-end 0))) - ;; ATX header - ((thing-at-point-looking-at markdown-regex-header-atx) - (kill-new (match-string 2)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Setext header - ((thing-at-point-looking-at markdown-regex-header-setext) - (kill-new (match-string 1)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Horizontal rule - ((thing-at-point-looking-at markdown-regex-hr) - (kill-new (match-string 0)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Inline link or image (add link or alt text to kill ring) - ((thing-at-point-looking-at markdown-regex-link-inline) - (kill-new (match-string 3)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Reference link or image (add link or alt text to kill ring) - ((thing-at-point-looking-at markdown-regex-link-reference) - (kill-new (match-string 3)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Angle URI (add URL to kill ring) - ((thing-at-point-looking-at markdown-regex-angle-uri) - (kill-new (match-string 2)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Email address in angle brackets (add email address to kill ring) - ((thing-at-point-looking-at markdown-regex-email) - (kill-new (match-string 1)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Wiki link (add alias text to kill ring) - ((and markdown-enable-wiki-links - (thing-at-point-looking-at markdown-regex-wiki-link)) - (kill-new (markdown-wiki-link-alias)) - (delete-region (match-beginning 1) (match-end 1))) - ;; Bold - ((thing-at-point-looking-at markdown-regex-bold) - (kill-new (match-string 4)) - (delete-region (match-beginning 2) (match-end 2))) - ;; Italics - ((thing-at-point-looking-at markdown-regex-italic) - (kill-new (match-string 3)) - (delete-region (match-beginning 1) (match-end 1))) - ;; Strikethrough - ((thing-at-point-looking-at markdown-regex-strike-through) - (kill-new (match-string 4)) - (delete-region (match-beginning 2) (match-end 2))) - ;; Footnote marker (add footnote text to kill ring) - ((thing-at-point-looking-at markdown-regex-footnote) - (markdown-footnote-kill)) - ;; Footnote text (add footnote text to kill ring) - ((setq val (markdown-footnote-text-positions)) - (markdown-footnote-kill)) - ;; Reference definition (add URL to kill ring) - ((thing-at-point-looking-at markdown-regex-reference-definition) - (kill-new (match-string 5)) - (delete-region (match-beginning 0) (match-end 0))) - ;; List item - ((setq val (markdown-cur-list-item-bounds)) - (kill-new (delete-and-extract-region (cl-first val) (cl-second val)))) - (t - (user-error "Nothing found at point to kill"))))) - -(defun markdown-kill-outline () - "Kill visible heading and add it to `kill-ring'." - (interactive) - (save-excursion - (markdown-outline-previous) - (kill-region (point) (progn (markdown-outline-next) (point))))) - -(defun markdown-kill-block () - "Kill visible code block, list item, or blockquote and add it to `kill-ring'." - (interactive) - (save-excursion - (markdown-backward-block) - (kill-region (point) (progn (markdown-forward-block) (point))))) - - -;;; Indentation =============================================================== - -(defun markdown-indent-find-next-position (cur-pos positions) - "Return the position after the index of CUR-POS in POSITIONS. -Positions are calculated by `markdown-calc-indents'." - (while (and positions - (not (equal cur-pos (car positions)))) - (setq positions (cdr positions))) - (or (cadr positions) 0)) - -(defun markdown-outdent-find-next-position (cur-pos positions) - "Return the maximal element that precedes CUR-POS from POSITIONS. -Positions are calculated by `markdown-calc-indents'." - (let ((result 0)) - (dolist (i positions) - (when (< i cur-pos) - (setq result (max result i)))) - result)) - -(defun markdown-indent-line () - "Indent the current line using some heuristics. -If the _previous_ command was either `markdown-enter-key' or -`markdown-cycle', then we should cycle to the next -reasonable indentation position. Otherwise, we could have been -called directly by `markdown-enter-key', by an initial call of -`markdown-cycle', or indirectly by `auto-fill-mode'. In -these cases, indent to the default position. -Positions are calculated by `markdown-calc-indents'." - (interactive) - (let ((positions (markdown-calc-indents)) - (point-pos (current-column)) - (_ (back-to-indentation)) - (cur-pos (current-column))) - (if (not (equal this-command 'markdown-cycle)) - (indent-line-to (car positions)) - (setq positions (sort (delete-dups positions) '<)) - (let* ((next-pos (markdown-indent-find-next-position cur-pos positions)) - (new-point-pos (max (+ point-pos (- next-pos cur-pos)) 0))) - (indent-line-to next-pos) - (move-to-column new-point-pos))))) - -(defun markdown-calc-indents () - "Return a list of indentation columns to cycle through. -The first element in the returned list should be considered the -default indentation level. This function does not worry about -duplicate positions, which are handled up by calling functions." - (let (pos prev-line-pos positions) - - ;; Indentation of previous line - (setq prev-line-pos (markdown-prev-line-indent)) - (setq positions (cons prev-line-pos positions)) - - ;; Indentation of previous non-list-marker text - (when (setq pos (save-excursion - (forward-line -1) - (when (looking-at markdown-regex-list) - (- (match-end 3) (match-beginning 0))))) - (setq positions (cons pos positions))) - - ;; Indentation required for a pre block in current context - (setq pos (length (markdown-pre-indentation (point)))) - (setq positions (cons pos positions)) - - ;; Indentation of the previous line + tab-width - (if prev-line-pos - (setq positions (cons (+ prev-line-pos tab-width) positions)) - (setq positions (cons tab-width positions))) - - ;; Indentation of the previous line - tab-width - (if (and prev-line-pos (> prev-line-pos tab-width)) - (setq positions (cons (- prev-line-pos tab-width) positions))) - - ;; Indentation of all preceding list markers (when in a list) - (when (setq pos (markdown-calculate-list-levels)) - (setq positions (append pos positions))) - - ;; First column - (setq positions (cons 0 positions)) - - ;; Return reversed list - (reverse positions))) - -(defun markdown-enter-key () ;FIXME: Partly obsoleted by electric-indent - "Handle RET depending on the context. -If the point is at a table, move to the next row. Otherwise, -indent according to value of `markdown-indent-on-enter'. -When it is nil, simply call `newline'. Otherwise, indent the next line -following RET using `markdown-indent-line'. Furthermore, when it -is set to \\='indent-and-new-item and the point is in a list item, -start a new item with the same indentation. If the point is in an -empty list item, remove it (so that pressing RET twice when in a -list simply adds a blank line)." - (interactive) - (cond - ;; Table - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-next-row)) - ;; Indent non-table text - (markdown-indent-on-enter - (let (bounds) - (if (and (memq markdown-indent-on-enter '(indent-and-new-item)) - (setq bounds (markdown-cur-list-item-bounds))) - (let ((beg (cl-first bounds)) - (end (cl-second bounds)) - (nonlist-indent (cl-fourth bounds)) - (checkbox (cl-sixth bounds))) - ;; Point is in a list item - (if (= (- end beg) (+ nonlist-indent (length checkbox))) - ;; Delete blank list - (progn - (delete-region beg end) - (newline) - (markdown-indent-line)) - (call-interactively #'markdown-insert-list-item))) - ;; Point is not in a list - (newline) - (markdown-indent-line)))) - ;; Insert a raw newline - (t (newline)))) - -(defun markdown-outdent-or-delete (arg) - "Handle BACKSPACE by cycling through indentation points. -When BACKSPACE is pressed, if there is only whitespace -before the current point, then outdent the line one level. -Otherwise, do normal delete by repeating -`backward-delete-char-untabify' ARG times." - (interactive "*p") - (if (use-region-p) - (backward-delete-char-untabify arg) - (let ((cur-pos (current-column)) - (start-of-indention (save-excursion - (back-to-indentation) - (current-column))) - (positions (markdown-calc-indents))) - (if (and (> cur-pos 0) (= cur-pos start-of-indention)) - (indent-line-to (markdown-outdent-find-next-position cur-pos positions)) - (backward-delete-char-untabify arg))))) - -(defun markdown-find-leftmost-column (beg end) - "Find the leftmost column in the region from BEG to END." - (let ((mincol 1000)) - (save-excursion - (goto-char beg) - (while (< (point) end) - (back-to-indentation) - (unless (looking-at-p "[ \t]*$") - (setq mincol (min mincol (current-column)))) - (forward-line 1) - )) - mincol)) - -(defun markdown-indent-region (beg end arg) - "Indent the region from BEG to END using some heuristics. -When ARG is non-nil, outdent the region instead. -See `markdown-indent-line' and `markdown-indent-line'." - (interactive "*r\nP") - (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<)) - (leftmostcol (markdown-find-leftmost-column beg end)) - (next-pos (if arg - (markdown-outdent-find-next-position leftmostcol positions) - (markdown-indent-find-next-position leftmostcol positions)))) - (indent-rigidly beg end (- next-pos leftmostcol)) - (setq deactivate-mark nil))) - -(defun markdown-outdent-region (beg end) - "Call `markdown-indent-region' on region from BEG to END with prefix." - (interactive "*r") - (markdown-indent-region beg end t)) - -(defun markdown--indent-region (start end) - (let ((deactivate-mark nil)) - (save-excursion - (goto-char end) - (setq end (point-marker)) - (goto-char start) - (when (bolp) - (forward-line 1)) - (while (< (point) end) - (unless (or (markdown-code-block-at-point-p) (and (bolp) (eolp))) - (indent-according-to-mode)) - (forward-line 1)) - (move-marker end nil)))) - - -;;; Markup Completion ========================================================= - -(defconst markdown-complete-alist - '((markdown-regex-header-atx . markdown-complete-atx) - (markdown-regex-header-setext . markdown-complete-setext) - (markdown-regex-hr . markdown-complete-hr)) - "Association list of form (regexp . function) for markup completion.") - -(defun markdown-incomplete-atx-p () - "Return t if ATX header markup is incomplete and nil otherwise. -Assumes match data is available for `markdown-regex-header-atx'. -Checks that the number of trailing hash marks equals the number of leading -hash marks, that there is only a single space before and after the text, -and that there is no extraneous whitespace in the text." - (or - ;; Number of starting and ending hash marks differs - (not (= (length (match-string 1)) (length (match-string 3)))) - ;; When the header text is not empty... - (and (> (length (match-string 2)) 0) - ;; ...if there are extra leading, trailing, or interior spaces - (or (not (= (match-beginning 2) (1+ (match-end 1)))) - (not (= (match-beginning 3) (1+ (match-end 2)))) - (string-match-p "[ \t\n]\\{2\\}" (match-string 2)))) - ;; When the header text is empty... - (and (= (length (match-string 2)) 0) - ;; ...if there are too many or too few spaces - (not (= (match-beginning 3) (+ (match-end 1) 2)))))) - -(defun markdown-complete-atx () - "Complete and normalize ATX headers. -Add or remove hash marks to the end of the header to match the -beginning. Ensure that there is only a single space between hash -marks and header text. Removes extraneous whitespace from header text. -Assumes match data is available for `markdown-regex-header-atx'. -Return nil if markup was complete and non-nil if markup was completed." - (when (markdown-incomplete-atx-p) - (let* ((new-marker (make-marker)) - (new-marker (set-marker new-marker (match-end 2)))) - ;; Hash marks and spacing at end - (goto-char (match-end 2)) - (delete-region (match-end 2) (match-end 3)) - (insert " " (match-string 1)) - ;; Remove extraneous whitespace from title - (replace-match (markdown-compress-whitespace-string (match-string 2)) - t t nil 2) - ;; Spacing at beginning - (goto-char (match-end 1)) - (delete-region (match-end 1) (match-beginning 2)) - (insert " ") - ;; Leave point at end of text - (goto-char new-marker)))) - -(defun markdown-incomplete-setext-p () - "Return t if setext header markup is incomplete and nil otherwise. -Assumes match data is available for `markdown-regex-header-setext'. -Checks that length of underline matches text and that there is no -extraneous whitespace in the text." - (or (not (= (length (match-string 1)) (length (match-string 2)))) - (string-match-p "[ \t\n]\\{2\\}" (match-string 1)))) - -(defun markdown-complete-setext () - "Complete and normalize setext headers. -Add or remove underline characters to match length of header -text. Removes extraneous whitespace from header text. Assumes -match data is available for `markdown-regex-header-setext'. -Return nil if markup was complete and non-nil if markup was completed." - (when (markdown-incomplete-setext-p) - (let* ((text (markdown-compress-whitespace-string (match-string 1))) - (char (char-after (match-beginning 2))) - (level (if (char-equal char ?-) 2 1))) - (goto-char (match-beginning 0)) - (delete-region (match-beginning 0) (match-end 0)) - (markdown-insert-header level text t) - t))) - -(defun markdown-incomplete-hr-p () - "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise. -Assumes match data is available for `markdown-regex-hr'." - (not (member (match-string 0) markdown-hr-strings))) - -(defun markdown-complete-hr () - "Complete horizontal rules. -If horizontal rule string is a member of `markdown-hr-strings', -do nothing. Otherwise, replace with the car of -`markdown-hr-strings'. -Assumes match data is available for `markdown-regex-hr'. -Return nil if markup was complete and non-nil if markup was completed." - (when (markdown-incomplete-hr-p) - (replace-match (car markdown-hr-strings)) - t)) - -(defun markdown-complete () - "Complete markup of object near point or in region when active. -Handle all objects in `markdown-complete-alist', in order. -See `markdown-complete-at-point' and `markdown-complete-region'." - (interactive "*") - (if (use-region-p) - (markdown-complete-region (region-beginning) (region-end)) - (markdown-complete-at-point))) - -(defun markdown-complete-at-point () - "Complete markup of object near point. -Handle all elements of `markdown-complete-alist' in order." - (interactive "*") - (let ((list markdown-complete-alist) found changed) - (while list - (let ((regexp (eval (caar list) t)) ;FIXME: Why `eval'? - (function (cdar list))) - (setq list (cdr list)) - (when (thing-at-point-looking-at regexp) - (setq found t) - (setq changed (funcall function)) - (setq list nil)))) - (if found - (or changed (user-error "Markup at point is complete")) - (user-error "Nothing to complete at point")))) - -(defun markdown-complete-region (beg end) - "Complete markup of objects in region from BEG to END. -Handle all objects in `markdown-complete-alist', in order. Each -match is checked to ensure that a previous regexp does not also -match." - (interactive "*r") - (let ((end-marker (set-marker (make-marker) end)) - previous) - (dolist (element markdown-complete-alist) - (let ((regexp (eval (car element) t)) ;FIXME: Why `eval'? - (function (cdr element))) - (goto-char beg) - (while (re-search-forward regexp end-marker 'limit) - (when (match-string 0) - ;; Make sure this is not a match for any of the preceding regexps. - ;; This prevents mistaking an HR for a Setext subheading. - (let (match) - (save-match-data - (dolist (prev-regexp previous) - (or match (setq match (looking-back prev-regexp nil))))) - (unless match - (save-excursion (funcall function)))))) - (cl-pushnew regexp previous :test #'equal))) - previous)) - -(defun markdown-complete-buffer () - "Complete markup for all objects in the current buffer." - (interactive "*") - (markdown-complete-region (point-min) (point-max))) - - -;;; Markup Cycling ============================================================ - -(defun markdown-cycle-atx (arg &optional remove) - "Cycle ATX header markup. -Promote header (decrease level) when ARG is 1 and demote -header (increase level) if arg is -1. When REMOVE is non-nil, -remove the header when the level reaches zero and stop cycling -when it reaches six. Otherwise, perform a proper cycling through -levels one through six. Assumes match data is available for -`markdown-regex-header-atx'." - (let* ((old-level (length (match-string 1))) - (new-level (+ old-level arg)) - (text (match-string 2))) - (when (not remove) - (setq new-level (% new-level 6)) - (setq new-level (cond ((= new-level 0) 6) - ((< new-level 0) (+ new-level 6)) - (t new-level)))) - (cond - ((= new-level 0) - (markdown-unwrap-thing-at-point nil 0 2)) - ((<= new-level 6) - (goto-char (match-beginning 0)) - (delete-region (match-beginning 0) (match-end 0)) - (markdown-insert-header new-level text nil))))) - -(defun markdown-cycle-setext (arg &optional remove) - "Cycle setext header markup. -Promote header (increase level) when ARG is 1 and demote -header (decrease level or remove) if arg is -1. When demoting a -level-two setext header, replace with a level-three atx header. -When REMOVE is non-nil, remove the header when the level reaches -zero. Otherwise, cycle back to a level six atx header. Assumes -match data is available for `markdown-regex-header-setext'." - (let* ((char (char-after (match-beginning 2))) - (old-level (if (char-equal char ?=) 1 2)) - (new-level (+ old-level arg))) - (when (and (not remove) (= new-level 0)) - (setq new-level 6)) - (cond - ((= new-level 0) - (markdown-unwrap-thing-at-point nil 0 1)) - ((<= new-level 2) - (markdown-insert-header new-level nil t)) - ((<= new-level 6) - (markdown-insert-header new-level nil nil))))) - -(defun markdown-cycle-hr (arg &optional remove) - "Cycle string used for horizontal rule from `markdown-hr-strings'. -When ARG is 1, cycle forward (demote), and when ARG is -1, cycle -backwards (promote). When REMOVE is non-nil, remove the hr instead -of cycling when the end of the list is reached. -Assumes match data is available for `markdown-regex-hr'." - (let* ((strings (if (= arg -1) - (reverse markdown-hr-strings) - markdown-hr-strings)) - (tail (member (match-string 0) strings)) - (new (or (cadr tail) - (if remove - (if (= arg 1) - "" - (car tail)) - (car strings))))) - (replace-match new))) - -(defun markdown-cycle-bold () - "Cycle bold markup between underscores and asterisks. -Assumes match data is available for `markdown-regex-bold'." - (save-excursion - (let* ((old-delim (match-string 3)) - (new-delim (if (string-equal old-delim "**") "__" "**"))) - (replace-match new-delim t t nil 3) - (replace-match new-delim t t nil 5)))) - -(defun markdown-cycle-italic () - "Cycle italic markup between underscores and asterisks. -Assumes match data is available for `markdown-regex-italic'." - (save-excursion - (let* ((old-delim (match-string 2)) - (new-delim (if (string-equal old-delim "*") "_" "*"))) - (replace-match new-delim t t nil 2) - (replace-match new-delim t t nil 4)))) - - -;;; Keymap ==================================================================== - -(defun markdown--style-map-prompt () - "Return a formatted prompt for Markdown markup insertion." - (when markdown-enable-prefix-prompts - (concat - "Markdown: " - (propertize "bold" 'face 'markdown-bold-face) ", " - (propertize "italic" 'face 'markdown-italic-face) ", " - (propertize "code" 'face 'markdown-inline-code-face) ", " - (propertize "C = GFM code" 'face 'markdown-code-face) ", " - (propertize "pre" 'face 'markdown-pre-face) ", " - (propertize "footnote" 'face 'markdown-footnote-text-face) ", " - (propertize "F = foldable" 'face 'markdown-bold-face) ", " - (propertize "q = blockquote" 'face 'markdown-blockquote-face) ", " - (propertize "h & 1-6 = heading" 'face 'markdown-header-face) ", " - (propertize "- = hr" 'face 'markdown-hr-face) ", " - "C-h = more"))) - -(defun markdown--command-map-prompt () - "Return prompt for Markdown buffer-wide commands." - (when markdown-enable-prefix-prompts - (concat - "Command: " - (propertize "m" 'face 'markdown-bold-face) "arkdown, " - (propertize "p" 'face 'markdown-bold-face) "review, " - (propertize "o" 'face 'markdown-bold-face) "pen, " - (propertize "e" 'face 'markdown-bold-face) "xport, " - "export & pre" (propertize "v" 'face 'markdown-bold-face) "iew, " - (propertize "c" 'face 'markdown-bold-face) "heck refs, " - (propertize "u" 'face 'markdown-bold-face) "nused refs, " - "C-h = more"))) - -(defvar markdown-mode-style-map - (let ((map (make-keymap (markdown--style-map-prompt)))) - (define-key map (kbd "1") 'markdown-insert-header-atx-1) - (define-key map (kbd "2") 'markdown-insert-header-atx-2) - (define-key map (kbd "3") 'markdown-insert-header-atx-3) - (define-key map (kbd "4") 'markdown-insert-header-atx-4) - (define-key map (kbd "5") 'markdown-insert-header-atx-5) - (define-key map (kbd "6") 'markdown-insert-header-atx-6) - (define-key map (kbd "!") 'markdown-insert-header-setext-1) - (define-key map (kbd "@") 'markdown-insert-header-setext-2) - (define-key map (kbd "b") 'markdown-insert-bold) - (define-key map (kbd "c") 'markdown-insert-code) - (define-key map (kbd "C") 'markdown-insert-gfm-code-block) - (define-key map (kbd "f") 'markdown-insert-footnote) - (define-key map (kbd "F") 'markdown-insert-foldable-block) - (define-key map (kbd "h") 'markdown-insert-header-dwim) - (define-key map (kbd "H") 'markdown-insert-header-setext-dwim) - (define-key map (kbd "i") 'markdown-insert-italic) - (define-key map (kbd "k") 'markdown-insert-kbd) - (define-key map (kbd "l") 'markdown-insert-link) - (define-key map (kbd "p") 'markdown-insert-pre) - (define-key map (kbd "P") 'markdown-pre-region) - (define-key map (kbd "q") 'markdown-insert-blockquote) - (define-key map (kbd "s") 'markdown-insert-strike-through) - (define-key map (kbd "t") 'markdown-insert-table) - (define-key map (kbd "Q") 'markdown-blockquote-region) - (define-key map (kbd "w") 'markdown-insert-wiki-link) - (define-key map (kbd "-") 'markdown-insert-hr) - (define-key map (kbd "[") 'markdown-insert-gfm-checkbox) - ;; Deprecated keys that may be removed in a future version - (define-key map (kbd "e") 'markdown-insert-italic) - map) - "Keymap for Markdown text styling commands.") - -(defvar markdown-mode-command-map - (let ((map (make-keymap (markdown--command-map-prompt)))) - (define-key map (kbd "m") 'markdown-other-window) - (define-key map (kbd "p") 'markdown-preview) - (define-key map (kbd "e") 'markdown-export) - (define-key map (kbd "v") 'markdown-export-and-preview) - (define-key map (kbd "o") 'markdown-open) - (define-key map (kbd "l") 'markdown-live-preview-mode) - (define-key map (kbd "w") 'markdown-kill-ring-save) - (define-key map (kbd "c") 'markdown-check-refs) - (define-key map (kbd "u") 'markdown-unused-refs) - (define-key map (kbd "n") 'markdown-cleanup-list-numbers) - (define-key map (kbd "]") 'markdown-complete-buffer) - (define-key map (kbd "^") 'markdown-table-sort-lines) - (define-key map (kbd "|") 'markdown-table-convert-region) - (define-key map (kbd "t") 'markdown-table-transpose) - map) - "Keymap for Markdown buffer-wide commands.") - -(defvar markdown-mode-map - (let ((map (make-keymap))) - ;; Markup insertion & removal - (define-key map (kbd "C-c C-s") markdown-mode-style-map) - (define-key map (kbd "C-c C-l") 'markdown-insert-link) - (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point) - ;; Promotion, demotion, and cycling - (define-key map (kbd "C-c C--") 'markdown-promote) - (define-key map (kbd "C-c C-=") 'markdown-demote) - (define-key map (kbd "C-c C-]") 'markdown-complete) - ;; Following and doing things - (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point) - (define-key map (kbd "C-c C-d") 'markdown-do) - (define-key map (kbd "C-c '") 'markdown-edit-code-block) - ;; Indentation - (define-key map (kbd "RET") 'markdown-enter-key) - (define-key map (kbd "DEL") 'markdown-outdent-or-delete) - (define-key map (kbd "C-c >") 'markdown-indent-region) - (define-key map (kbd "C-c <") 'markdown-outdent-region) - ;; Visibility cycling - (define-key map (kbd "TAB") 'markdown-cycle) - ;; S-iso-lefttab and S-tab should both be mapped to `backtab' by - ;; (local-)function-key-map. - ;;(define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab) - ;;(define-key map (kbd "<S-tab>") 'markdown-shifttab) - (define-key map (kbd "<backtab>") 'markdown-shifttab) - ;; Heading and list navigation - (define-key map (kbd "C-c C-n") 'markdown-outline-next) - (define-key map (kbd "C-c C-p") 'markdown-outline-previous) - (define-key map (kbd "C-c C-f") 'markdown-outline-next-same-level) - (define-key map (kbd "C-c C-b") 'markdown-outline-previous-same-level) - (define-key map (kbd "C-c C-u") 'markdown-outline-up) - ;; Buffer-wide commands - (define-key map (kbd "C-c C-c") markdown-mode-command-map) - ;; Subtree, list, and table editing - (define-key map (kbd "C-c <up>") 'markdown-move-up) - (define-key map (kbd "C-c <down>") 'markdown-move-down) - (define-key map (kbd "C-c <left>") 'markdown-promote) - (define-key map (kbd "C-c <right>") 'markdown-demote) - (define-key map (kbd "C-c S-<up>") 'markdown-table-delete-row) - (define-key map (kbd "C-c S-<down>") 'markdown-table-insert-row) - (define-key map (kbd "C-c S-<left>") 'markdown-table-delete-column) - (define-key map (kbd "C-c S-<right>") 'markdown-table-insert-column) - (define-key map (kbd "C-c C-M-h") 'markdown-mark-subtree) - (define-key map (kbd "C-x n s") 'markdown-narrow-to-subtree) - (define-key map (kbd "M-RET") 'markdown-insert-list-item) - (define-key map (kbd "C-c C-j") 'markdown-insert-list-item) - ;; Lines - (define-key map [remap move-beginning-of-line] 'markdown-beginning-of-line) - (define-key map [remap move-end-of-line] 'markdown-end-of-line) - ;; Paragraphs (Markdown context aware) - (define-key map [remap backward-paragraph] 'markdown-backward-paragraph) - (define-key map [remap forward-paragraph] 'markdown-forward-paragraph) - (define-key map [remap mark-paragraph] 'markdown-mark-paragraph) - ;; Blocks (one or more paragraphs) - (define-key map (kbd "C-M-{") 'markdown-backward-block) - (define-key map (kbd "C-M-}") 'markdown-forward-block) - (define-key map (kbd "C-c M-h") 'markdown-mark-block) - (define-key map (kbd "C-x n b") 'markdown-narrow-to-block) - ;; Pages (top-level sections) - (define-key map [remap backward-page] 'markdown-backward-page) - (define-key map [remap forward-page] 'markdown-forward-page) - (define-key map [remap mark-page] 'markdown-mark-page) - (define-key map [remap narrow-to-page] 'markdown-narrow-to-page) - ;; Link Movement - (define-key map (kbd "M-n") 'markdown-next-link) - (define-key map (kbd "M-p") 'markdown-previous-link) - ;; Toggling functionality - (define-key map (kbd "C-c C-x C-e") 'markdown-toggle-math) - (define-key map (kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively) - (define-key map (kbd "C-c C-x C-i") 'markdown-toggle-inline-images) - (define-key map (kbd "C-c C-x C-l") 'markdown-toggle-url-hiding) - (define-key map (kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding) - ;; Alternative keys (in case of problems with the arrow keys) - (define-key map (kbd "C-c C-x u") 'markdown-move-up) - (define-key map (kbd "C-c C-x d") 'markdown-move-down) - (define-key map (kbd "C-c C-x l") 'markdown-promote) - (define-key map (kbd "C-c C-x r") 'markdown-demote) - ;; Deprecated keys that may be removed in a future version - (define-key map (kbd "C-c C-a L") 'markdown-insert-link) ;; C-c C-l - (define-key map (kbd "C-c C-a l") 'markdown-insert-link) ;; C-c C-l - (define-key map (kbd "C-c C-a r") 'markdown-insert-link) ;; C-c C-l - (define-key map (kbd "C-c C-a u") 'markdown-insert-uri) ;; C-c C-l - (define-key map (kbd "C-c C-a f") 'markdown-insert-footnote) - (define-key map (kbd "C-c C-a w") 'markdown-insert-wiki-link) - (define-key map (kbd "C-c C-t 1") 'markdown-insert-header-atx-1) - (define-key map (kbd "C-c C-t 2") 'markdown-insert-header-atx-2) - (define-key map (kbd "C-c C-t 3") 'markdown-insert-header-atx-3) - (define-key map (kbd "C-c C-t 4") 'markdown-insert-header-atx-4) - (define-key map (kbd "C-c C-t 5") 'markdown-insert-header-atx-5) - (define-key map (kbd "C-c C-t 6") 'markdown-insert-header-atx-6) - (define-key map (kbd "C-c C-t !") 'markdown-insert-header-setext-1) - (define-key map (kbd "C-c C-t @") 'markdown-insert-header-setext-2) - (define-key map (kbd "C-c C-t h") 'markdown-insert-header-dwim) - (define-key map (kbd "C-c C-t H") 'markdown-insert-header-setext-dwim) - (define-key map (kbd "C-c C-t s") 'markdown-insert-header-setext-2) - (define-key map (kbd "C-c C-t t") 'markdown-insert-header-setext-1) - (define-key map (kbd "C-c C-i") 'markdown-insert-image) - (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) ;; C-c C-j - (define-key map (kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox) ;; C-c C-d - (define-key map (kbd "C-c -") 'markdown-insert-hr) - map) - "Keymap for Markdown major mode.") - -(defvar markdown-mode-mouse-map - (when markdown-mouse-follow-link - (let ((map (make-sparse-keymap))) - (define-key map [follow-link] 'mouse-face) - (define-key map [mouse-2] #'markdown-follow-thing-at-point) - map)) - "Keymap for following links with mouse.") - -(defvar gfm-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map markdown-mode-map) - (define-key map (kbd "C-c C-s d") 'markdown-insert-strike-through) - (define-key map "`" 'markdown-electric-backquote) - map) - "Keymap for `gfm-mode'. -See also `markdown-mode-map'.") - - -;;; Menu ====================================================================== - -(easy-menu-define markdown-mode-menu markdown-mode-map - "Menu for Markdown mode." - '("Markdown" - "---" - ("Movement" - ["Jump" markdown-do] - ["Follow Link" markdown-follow-thing-at-point] - ["Next Link" markdown-next-link] - ["Previous Link" markdown-previous-link] - "---" - ["Next Heading or List Item" markdown-outline-next] - ["Previous Heading or List Item" markdown-outline-previous] - ["Next at Same Level" markdown-outline-next-same-level] - ["Previous at Same Level" markdown-outline-previous-same-level] - ["Up to Parent" markdown-outline-up] - "---" - ["Forward Paragraph" markdown-forward-paragraph] - ["Backward Paragraph" markdown-backward-paragraph] - ["Forward Block" markdown-forward-block] - ["Backward Block" markdown-backward-block]) - ("Show & Hide" - ["Cycle Heading Visibility" markdown-cycle - :enable (markdown-on-heading-p)] - ["Cycle Heading Visibility (Global)" markdown-shifttab] - "---" - ["Narrow to Region" narrow-to-region] - ["Narrow to Block" markdown-narrow-to-block] - ["Narrow to Section" narrow-to-defun] - ["Narrow to Subtree" markdown-narrow-to-subtree] - ["Widen" widen (buffer-narrowed-p)] - "---" - ["Toggle Markup Hiding" markdown-toggle-markup-hiding - :keys "C-c C-x C-m" - :style radio - :selected markdown-hide-markup]) - "---" - ("Headings & Structure" - ["Automatic Heading" markdown-insert-header-dwim - :keys "C-c C-s h"] - ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim - :keys "C-c C-s H"] - ("Specific Heading (atx)" - ["First Level atx" markdown-insert-header-atx-1 - :keys "C-c C-s 1"] - ["Second Level atx" markdown-insert-header-atx-2 - :keys "C-c C-s 2"] - ["Third Level atx" markdown-insert-header-atx-3 - :keys "C-c C-s 3"] - ["Fourth Level atx" markdown-insert-header-atx-4 - :keys "C-c C-s 4"] - ["Fifth Level atx" markdown-insert-header-atx-5 - :keys "C-c C-s 5"] - ["Sixth Level atx" markdown-insert-header-atx-6 - :keys "C-c C-s 6"]) - ("Specific Heading (Setext)" - ["First Level Setext" markdown-insert-header-setext-1 - :keys "C-c C-s !"] - ["Second Level Setext" markdown-insert-header-setext-2 - :keys "C-c C-s @"]) - ["Horizontal Rule" markdown-insert-hr - :keys "C-c C-s -"] - "---" - ["Move Subtree Up" markdown-move-up - :keys "C-c <up>"] - ["Move Subtree Down" markdown-move-down - :keys "C-c <down>"] - ["Promote Subtree" markdown-promote - :keys "C-c <left>"] - ["Demote Subtree" markdown-demote - :keys "C-c <right>"]) - ("Region & Mark" - ["Indent Region" markdown-indent-region] - ["Outdent Region" markdown-outdent-region] - "--" - ["Mark Paragraph" mark-paragraph] - ["Mark Block" markdown-mark-block] - ["Mark Section" mark-defun] - ["Mark Subtree" markdown-mark-subtree]) - ("Tables" - ["Move Row Up" markdown-move-up - :enable (markdown-table-at-point-p) - :keys "C-c <up>"] - ["Move Row Down" markdown-move-down - :enable (markdown-table-at-point-p) - :keys "C-c <down>"] - ["Move Column Left" markdown-promote - :enable (markdown-table-at-point-p) - :keys "C-c <left>"] - ["Move Column Right" markdown-demote - :enable (markdown-table-at-point-p) - :keys "C-c <right>"] - ["Delete Row" markdown-table-delete-row - :enable (markdown-table-at-point-p)] - ["Insert Row" markdown-table-insert-row - :enable (markdown-table-at-point-p)] - ["Delete Column" markdown-table-delete-column - :enable (markdown-table-at-point-p)] - ["Insert Column" markdown-table-insert-column - :enable (markdown-table-at-point-p)] - ["Insert Table" markdown-insert-table] - "--" - ["Convert Region to Table" markdown-table-convert-region] - ["Sort Table Lines" markdown-table-sort-lines - :enable (markdown-table-at-point-p)] - ["Transpose Table" markdown-table-transpose - :enable (markdown-table-at-point-p)]) - ("Lists" - ["Insert List Item" markdown-insert-list-item] - ["Move Subtree Up" markdown-move-up - :keys "C-c <up>"] - ["Move Subtree Down" markdown-move-down - :keys "C-c <down>"] - ["Indent Subtree" markdown-demote - :keys "C-c <right>"] - ["Outdent Subtree" markdown-promote - :keys "C-c <left>"] - ["Renumber List" markdown-cleanup-list-numbers] - ["Insert Task List Item" markdown-insert-gfm-checkbox - :keys "C-c C-x ["] - ["Toggle Task List Item" markdown-toggle-gfm-checkbox - :enable (markdown-gfm-task-list-item-at-point) - :keys "C-c C-d"]) - ("Links & Images" - ["Insert Link" markdown-insert-link] - ["Insert Image" markdown-insert-image] - ["Insert Footnote" markdown-insert-footnote - :keys "C-c C-s f"] - ["Insert Wiki Link" markdown-insert-wiki-link - :keys "C-c C-s w"] - "---" - ["Check References" markdown-check-refs] - ["Find Unused References" markdown-unused-refs] - ["Toggle URL Hiding" markdown-toggle-url-hiding - :style radio - :selected markdown-hide-urls] - ["Toggle Inline Images" markdown-toggle-inline-images - :keys "C-c C-x C-i" - :style radio - :selected markdown-inline-image-overlays] - ["Toggle Wiki Links" markdown-toggle-wiki-links - :style radio - :selected markdown-enable-wiki-links]) - ("Styles" - ["Bold" markdown-insert-bold] - ["Italic" markdown-insert-italic] - ["Code" markdown-insert-code] - ["Strikethrough" markdown-insert-strike-through] - ["Keyboard" markdown-insert-kbd] - "---" - ["Blockquote" markdown-insert-blockquote] - ["Preformatted" markdown-insert-pre] - ["GFM Code Block" markdown-insert-gfm-code-block] - ["Edit Code Block" markdown-edit-code-block - :enable (markdown-code-block-at-point-p)] - ["Foldable Block" markdown-insert-foldable-block] - "---" - ["Blockquote Region" markdown-blockquote-region] - ["Preformatted Region" markdown-pre-region] - "---" - ["Fontify Code Blocks Natively" - markdown-toggle-fontify-code-blocks-natively - :style radio - :selected markdown-fontify-code-blocks-natively] - ["LaTeX Math Support" markdown-toggle-math - :style radio - :selected markdown-enable-math]) - "---" - ("Preview & Export" - ["Compile" markdown-other-window] - ["Preview" markdown-preview] - ["Export" markdown-export] - ["Export & View" markdown-export-and-preview] - ["Open" markdown-open] - ["Live Export" markdown-live-preview-mode - :style radio - :selected markdown-live-preview-mode] - ["Kill ring save" markdown-kill-ring-save]) - ("Markup Completion and Cycling" - ["Complete Markup" markdown-complete] - ["Promote Element" markdown-promote - :keys "C-c C--"] - ["Demote Element" markdown-demote - :keys "C-c C-="]) - "---" - ["Kill Element" markdown-kill-thing-at-point] - "---" - ("Documentation" - ["Version" markdown-show-version] - ["Homepage" markdown-mode-info] - ["Describe Mode" (describe-function 'markdown-mode)] - ["Guide" (browse-url "https://leanpub.com/markdown-mode")]))) - - -;;; imenu ===================================================================== - -(defun markdown-imenu-create-nested-index () - "Create and return a nested imenu index alist for the current buffer. -See `imenu-create-index-function' and `imenu--index-alist' for details." - (let* ((root (list nil)) - (min-level 9999) - hashes headers) - (save-excursion - ;; Headings - (goto-char (point-min)) - (while (re-search-forward markdown-regex-header (point-max) t) - (unless (or (markdown-code-block-at-point-p) - (and (match-beginning 3) - (get-text-property (match-beginning 3) 'markdown-yaml-metadata-end))) - (cond - ((match-string-no-properties 2) ;; level 1 setext - (setq min-level 1) - (push (list :heading (match-string-no-properties 1) - :point (match-beginning 1) - :level 1) headers)) - ((match-string-no-properties 3) ;; level 2 setext - (setq min-level (min min-level 2)) - (push (list :heading (match-string-no-properties 1) - :point (match-beginning 1) - :level (- 2 (1- min-level))) headers)) - ((setq hashes (markdown-trim-whitespace - (match-string-no-properties 4))) - (setq min-level (min min-level (length hashes))) - (push (list :heading (match-string-no-properties 5) - :point (match-beginning 4) - :level (- (length hashes) (1- min-level))) headers))))) - (cl-loop with cur-level = 0 - with cur-alist = nil - with empty-heading = "-" - with self-heading = "." - for header in (reverse headers) - for level = (plist-get header :level) - do - (let ((alist (list (cons (plist-get header :heading) (plist-get header :point))))) - (cond - ((= cur-level level) ; new sibling - (setcdr cur-alist alist) - (setq cur-alist alist)) - ((< cur-level level) ; first child - (dotimes (_ (- level cur-level 1)) - (setq alist (list (cons empty-heading alist)))) - (if cur-alist - (let* ((parent (car cur-alist)) - (self-pos (cdr parent))) - (setcdr parent (cons (cons self-heading self-pos) alist))) - (setcdr root alist)) ; primogenitor - (setq cur-alist alist) - (setq cur-level level)) - (t ; new sibling of an ancestor - (let ((sibling-alist (last (cdr root)))) - (dotimes (_ (1- level)) - (setq sibling-alist (last (cdar sibling-alist)))) - (setcdr sibling-alist alist) - (setq cur-alist alist)) - (setq cur-level level))))) - (setq root (copy-tree root)) - ;; Footnotes - (let ((fn (markdown-get-defined-footnotes))) - (if (or (zerop (length fn)) - (null markdown-add-footnotes-to-imenu)) - (cdr root) - (nconc (cdr root) (list (cons "Footnotes" fn)))))))) - -(defun markdown-imenu-create-flat-index () - "Create and return a flat imenu index alist for the current buffer. -See `imenu-create-index-function' and `imenu--index-alist' for details." - (let* ((empty-heading "-") index heading pos) - (save-excursion - ;; Headings - (goto-char (point-min)) - (while (re-search-forward markdown-regex-header (point-max) t) - (when (and (not (markdown-code-block-at-point-p (line-beginning-position))) - (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin))) - (cond - ((setq heading (match-string-no-properties 1)) - (setq pos (match-beginning 1))) - ((setq heading (match-string-no-properties 5)) - (setq pos (match-beginning 4)))) - (or (> (length heading) 0) - (setq heading empty-heading)) - (setq index (append index (list (cons heading pos)))))) - ;; Footnotes - (when markdown-add-footnotes-to-imenu - (nconc index (markdown-get-defined-footnotes))) - index))) - - -;;; References ================================================================ - -(defun markdown-reference-goto-definition () - "Jump to the definition of the reference at point or create it." - (interactive) - (when (thing-at-point-looking-at markdown-regex-link-reference) - (let* ((text (match-string-no-properties 3)) - (reference (match-string-no-properties 6)) - (target (downcase (if (string= reference "") text reference))) - (loc (cadr (save-match-data (markdown-reference-definition target))))) - (if loc - (goto-char loc) - (goto-char (match-beginning 0)) - (markdown-insert-reference-definition target))))) - -(defun markdown-reference-find-links (reference) - "Return a list of all links for REFERENCE. -REFERENCE should not include the surrounding square brackets. -Elements of the list have the form (text start line), where -text is the link text, start is the location at the beginning of -the link, and line is the line number on which the link appears." - (let* ((ref-quote (regexp-quote reference)) - (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)" - ref-quote ref-quote)) - links) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (let* ((text (or (match-string-no-properties 1) - (match-string-no-properties 2))) - (start (match-beginning 0)) - (line (markdown-line-number-at-pos))) - (cl-pushnew (list text start line) links :test #'equal)))) - links)) - -(defmacro markdown-for-all-refs (f) - `(let ((result)) - (save-excursion - (goto-char (point-min)) - (while - (re-search-forward markdown-regex-link-reference nil t) - (let* ((text (match-string-no-properties 3)) - (reference (match-string-no-properties 6)) - (target (downcase (if (string= reference "") text reference)))) - (,f text target result)))) - (reverse result))) - -(defmacro markdown-collect-always (_ target result) - `(cl-pushnew ,target ,result :test #'equal)) - -(defmacro markdown-collect-undefined (text target result) - `(unless (markdown-reference-definition target) - (let ((entry (assoc ,target ,result))) - (if (not entry) - (cl-pushnew - (cons ,target (list (cons ,text (markdown-line-number-at-pos)))) - ,result :test #'equal) - (setcdr entry - (append (cdr entry) (list (cons ,text (markdown-line-number-at-pos))))))))) - -(defun markdown-get-all-refs () - "Return a list of all Markdown references." - (markdown-for-all-refs markdown-collect-always)) - -(defun markdown-get-undefined-refs () - "Return a list of undefined Markdown references. -Result is an alist of pairs (reference . occurrences), where -occurrences is itself another alist of pairs (label . line-number). -For example, an alist corresponding to [Nice editor][Emacs] at line 12, -\[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is -\((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))." - (markdown-for-all-refs markdown-collect-undefined)) - -(defun markdown-get-unused-refs () - (cl-sort - (cl-set-difference - (markdown-get-defined-references) (markdown-get-all-refs) - :test (lambda (e1 e2) (equal (car e1) e2))) - #'< :key #'cdr)) - -(defmacro defun-markdown-buffer (name docstring) - "Define a function to name and return a buffer. - -By convention, NAME must be a name of a string constant with -%buffer% placeholder used to name the buffer, and will also be -used as a name of the function defined. - -DOCSTRING will be used as the first part of the docstring." - `(defun ,name (&optional buffer-name) - ,(concat docstring "\n\nBUFFER-NAME is the name of the main buffer being visited.") - (or buffer-name (setq buffer-name (buffer-name))) - (let ((refbuf (get-buffer-create (replace-regexp-in-string - "%buffer%" buffer-name - ,name)))) - (with-current-buffer refbuf - (when view-mode - (View-exit-and-edit)) - (use-local-map button-buffer-map) - (erase-buffer)) - refbuf))) - -(defconst markdown-reference-check-buffer - "*Undefined references for %buffer%*" - "Pattern for name of buffer for listing undefined references. -The string %buffer% will be replaced by the corresponding -`markdown-mode' buffer name.") - -(defun-markdown-buffer - markdown-reference-check-buffer - "Name and return buffer for reference checking.") - -(defconst markdown-unused-references-buffer - "*Unused references for %buffer%*" - "Pattern for name of buffer for listing unused references. -The string %buffer% will be replaced by the corresponding -`markdown-mode' buffer name.") - -(defun-markdown-buffer - markdown-unused-references-buffer - "Name and return buffer for unused reference checking.") - -(defconst markdown-reference-links-buffer - "*Reference links for %buffer%*" - "Pattern for name of buffer for listing references. -The string %buffer% will be replaced by the corresponding buffer name.") - -(defun-markdown-buffer - markdown-reference-links-buffer - "Name, setup, and return a buffer for listing links.") - -;; Add an empty Markdown reference definition to buffer -;; specified in the 'target-buffer property. The reference name is -;; the button's label. -(define-button-type 'markdown-undefined-reference-button - 'help-echo "mouse-1, RET: create definition for undefined reference" - 'follow-link t - 'face 'bold - 'action (lambda (b) - (let ((buffer (button-get b 'target-buffer)) - (line (button-get b 'target-line)) - (label (button-label b))) - (switch-to-buffer-other-window buffer) - (goto-char (point-min)) - (forward-line line) - (markdown-insert-reference-definition label) - (markdown-check-refs t)))) - -;; Jump to line in buffer specified by 'target-buffer property. -;; Line number is button's 'target-line property. -(define-button-type 'markdown-goto-line-button - 'help-echo "mouse-1, RET: go to line" - 'follow-link t - 'face 'italic - 'action (lambda (b) - (switch-to-buffer-other-window (button-get b 'target-buffer)) - ;; use call-interactively to silence compiler - (let ((current-prefix-arg (button-get b 'target-line))) - (call-interactively 'goto-line)))) - -;; Kill a line in buffer specified by 'target-buffer property. -;; Line number is button's 'target-line property. -(define-button-type 'markdown-kill-line-button - 'help-echo "mouse-1, RET: kill line" - 'follow-link t - 'face 'italic - 'action (lambda (b) - (switch-to-buffer-other-window (button-get b 'target-buffer)) - ;; use call-interactively to silence compiler - (let ((current-prefix-arg (button-get b 'target-line))) - (call-interactively 'goto-line)) - (kill-line 1) - (markdown-unused-refs t))) - -;; Jumps to a particular link at location given by 'target-char -;; property in buffer given by 'target-buffer property. -(define-button-type 'markdown-location-button - 'help-echo "mouse-1, RET: jump to location of link" - 'follow-link t - 'face 'bold - 'action (lambda (b) - (let ((target (button-get b 'target-buffer)) - (loc (button-get b 'target-char))) - (kill-buffer-and-window) - (switch-to-buffer target) - (goto-char loc)))) - -(defun markdown-insert-undefined-reference-button (reference oldbuf) - "Insert a button for creating REFERENCE in buffer OLDBUF. -REFERENCE should be a list of the form (reference . occurrences), -as returned by `markdown-get-undefined-refs'." - (let ((label (car reference))) - ;; Create a reference button - (insert-button label - :type 'markdown-undefined-reference-button - 'target-buffer oldbuf - 'target-line (cdr (car (cdr reference)))) - (insert " (") - (dolist (occurrence (cdr reference)) - (let ((line (cdr occurrence))) - ;; Create a line number button - (insert-button (number-to-string line) - :type 'markdown-goto-line-button - 'target-buffer oldbuf - 'target-line line) - (insert " "))) - (delete-char -1) - (insert ")") - (newline))) - -(defun markdown-insert-unused-reference-button (reference oldbuf) - "Insert a button for creating REFERENCE in buffer OLDBUF. -REFERENCE must be a pair of (ref . line-number)." - (let ((label (car reference)) - (line (cdr reference))) - ;; Create a reference button - (insert-button label - :type 'markdown-goto-line-button - 'face 'bold - 'target-buffer oldbuf - 'target-line line) - (insert (format " (%d) [" line)) - (insert-button "X" - :type 'markdown-kill-line-button - 'face 'bold - 'target-buffer oldbuf - 'target-line line) - (insert "]") - (newline))) - -(defun markdown-insert-link-button (link oldbuf) - "Insert a button for jumping to LINK in buffer OLDBUF. -LINK should be a list of the form (text char line) containing -the link text, location, and line number." - (let ((label (cl-first link)) - (char (cl-second link)) - (line (cl-third link))) - ;; Create a reference button - (insert-button label - :type 'markdown-location-button - 'target-buffer oldbuf - 'target-char char) - (insert (format " (line %d)\n" line)))) - -(defun markdown-reference-goto-link (&optional reference) - "Jump to the location of the first use of REFERENCE." - (interactive) - (unless reference - (if (thing-at-point-looking-at markdown-regex-reference-definition) - (setq reference (match-string-no-properties 2)) - (user-error "No reference definition at point"))) - (let ((links (markdown-reference-find-links reference))) - (cond ((= (length links) 1) - (goto-char (cadr (car links)))) - ((> (length links) 1) - (let ((oldbuf (current-buffer)) - (linkbuf (markdown-reference-links-buffer))) - (with-current-buffer linkbuf - (insert "Links using reference " reference ":\n\n") - (dolist (link (reverse links)) - (markdown-insert-link-button link oldbuf))) - (view-buffer-other-window linkbuf) - (goto-char (point-min)) - (forward-line 2))) - (t - (error "No links for reference %s" reference))))) - -(defmacro defun-markdown-ref-checker - (name docstring checker-function buffer-function none-message buffer-header insert-reference) - "Define a function NAME acting on result of CHECKER-FUNCTION. - -DOCSTRING is used as a docstring for the defined function. - -BUFFER-FUNCTION should name and return an auxiliary buffer to put -results in. - -NONE-MESSAGE is used when CHECKER-FUNCTION returns no results. - -BUFFER-HEADER is put into the auxiliary buffer first, followed by -calling INSERT-REFERENCE for each element in the list returned by -CHECKER-FUNCTION." - `(defun ,name (&optional silent) - ,(concat - docstring - "\n\nIf SILENT is non-nil, do not message anything when no -such references found.") - (interactive "P") - (unless (derived-mode-p 'markdown-mode) - (user-error "Not available in current mode")) - (let ((oldbuf (current-buffer)) - (refs (,checker-function)) - (refbuf (,buffer-function))) - (if (null refs) - (progn - (when (not silent) - (message ,none-message)) - (kill-buffer refbuf)) - (with-current-buffer refbuf - (insert ,buffer-header) - (dolist (ref refs) - (,insert-reference ref oldbuf)) - (view-buffer-other-window refbuf) - (goto-char (point-min)) - (forward-line 2)))))) - -(defun-markdown-ref-checker - markdown-check-refs - "Show all undefined Markdown references in current `markdown-mode' buffer. - -Links which have empty reference definitions are considered to be -defined." - markdown-get-undefined-refs - markdown-reference-check-buffer - "No undefined references found" - "The following references are undefined:\n\n" - markdown-insert-undefined-reference-button) - - -(defun-markdown-ref-checker - markdown-unused-refs - "Show all unused Markdown references in current `markdown-mode' buffer." - markdown-get-unused-refs - markdown-unused-references-buffer - "No unused references found" - "The following references are unused:\n\n" - markdown-insert-unused-reference-button) - - - -;;; Lists ===================================================================== - -(defun markdown-insert-list-item (&optional arg) - "Insert a new list item. -If the point is inside unordered list, insert a bullet mark. If -the point is inside ordered list, insert the next number followed -by a period. Use the previous list item to determine the amount -of whitespace to place before and after list markers. - -With a \\[universal-argument] prefix (i.e., when ARG is (4)), -decrease the indentation by one level. - -With two \\[universal-argument] prefixes (i.e., when ARG is (16)), -increase the indentation by one level." - (interactive "p") - (let (bounds cur-indent marker indent new-indent new-loc) - (save-match-data - ;; Look for a list item on current or previous non-blank line - (save-excursion - (while (and (not (setq bounds (markdown-cur-list-item-bounds))) - (not (bobp)) - (markdown-cur-line-blank-p)) - (forward-line -1))) - (when bounds - (cond ((save-excursion - (skip-chars-backward " \t") - (looking-at-p markdown-regex-list)) - (beginning-of-line) - (insert "\n") - (forward-line -1)) - ((not (markdown-cur-line-blank-p)) - (newline))) - (setq new-loc (point))) - ;; Look ahead for a list item on next non-blank line - (unless bounds - (save-excursion - (while (and (null bounds) - (not (eobp)) - (markdown-cur-line-blank-p)) - (forward-line) - (setq bounds (markdown-cur-list-item-bounds)))) - (when bounds - (setq new-loc (point)) - (unless (markdown-cur-line-blank-p) - (newline)))) - (if (not bounds) - ;; When not in a list, start a new unordered one - (progn - (unless (markdown-cur-line-blank-p) - (insert "\n")) - (insert markdown-unordered-list-item-prefix)) - ;; Compute indentation and marker for new list item - (setq cur-indent (nth 2 bounds)) - (setq marker (nth 4 bounds)) - ;; If current item is a GFM checkbox, insert new unchecked checkbox. - (when (nth 5 bounds) - (setq marker - (concat marker - (replace-regexp-in-string "[Xx]" " " (nth 5 bounds))))) - (cond - ;; Dedent: decrement indentation, find previous marker. - ((= arg 4) - (setq indent (max (- cur-indent markdown-list-indent-width) 0)) - (let ((prev-bounds - (save-excursion - (goto-char (nth 0 bounds)) - (when (markdown-up-list) - (markdown-cur-list-item-bounds))))) - (when prev-bounds - (setq marker (nth 4 prev-bounds))))) - ;; Indent: increment indentation by 4, use same marker. - ((= arg 16) (setq indent (+ cur-indent markdown-list-indent-width))) - ;; Same level: keep current indentation and marker. - (t (setq indent cur-indent))) - (setq new-indent (make-string indent 32)) - (goto-char new-loc) - (cond - ;; Ordered list - ((string-match-p "[0-9]" marker) - (if (= arg 16) ;; starting a new column indented one more level - (insert (concat new-indent "1. ")) - ;; Don't use previous match-data - (set-match-data nil) - ;; travel up to the last item and pick the correct number. If - ;; the argument was nil, "new-indent = cur-indent" is the same, - ;; so we don't need special treatment. Neat. - (save-excursion - (while (and (not (looking-at (concat new-indent "\\([0-9]+\\)\\(\\.[ \t]*\\)"))) - (>= (forward-line -1) 0)))) - (let* ((old-prefix (match-string 1)) - (old-spacing (match-string 2)) - (new-prefix (if (and old-prefix markdown-ordered-list-enumeration) - (int-to-string (1+ (string-to-number old-prefix))) - "1")) - (space-adjust (- (length old-prefix) (length new-prefix))) - (new-spacing (if (and (match-string 2) - (not (string-match-p "\t" old-spacing)) - (< space-adjust 0) - (> space-adjust (- 1 (length (match-string 2))))) - (substring (match-string 2) 0 space-adjust) - (or old-spacing ". ")))) - (insert (concat new-indent new-prefix new-spacing))))) - ;; Unordered list, GFM task list, or ordered list with hash mark - ((string-match-p "[\\*\\+-]\\|#\\." marker) - (insert new-indent marker)))) - ;; Propertize the newly inserted list item now - (markdown-syntax-propertize-list-items (line-beginning-position) (line-end-position))))) - -(defun markdown-move-list-item-up () - "Move the current list item up in the list when possible. -In nested lists, move child items with the parent item." - (interactive) - (let (cur prev old) - (when (setq cur (markdown-cur-list-item-bounds)) - (setq old (point)) - (goto-char (nth 0 cur)) - (if (markdown-prev-list-item (nth 3 cur)) - (progn - (setq prev (markdown-cur-list-item-bounds)) - (condition-case nil - (progn - (transpose-regions (nth 0 prev) (nth 1 prev) - (nth 0 cur) (nth 1 cur) t) - (goto-char (+ (nth 0 prev) (- old (nth 0 cur))))) - ;; Catch error in case regions overlap. - (error (goto-char old)))) - (goto-char old))))) - -(defun markdown-move-list-item-down () - "Move the current list item down in the list when possible. -In nested lists, move child items with the parent item." - (interactive) - (let (cur next old) - (when (setq cur (markdown-cur-list-item-bounds)) - (setq old (point)) - (if (markdown-next-list-item (nth 3 cur)) - (progn - (setq next (markdown-cur-list-item-bounds)) - (condition-case nil - (progn - (transpose-regions (nth 0 cur) (nth 1 cur) - (nth 0 next) (nth 1 next) nil) - (goto-char (+ old (- (nth 1 next) (nth 1 cur))))) - ;; Catch error in case regions overlap. - (error (goto-char old)))) - (goto-char old))))) - -(defun markdown-demote-list-item (&optional bounds) - "Indent (or demote) the current list item. -Optionally, BOUNDS of the current list item may be provided if available. -In nested lists, demote child items as well." - (interactive) - (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) - (save-excursion - (let* ((item-start (set-marker (make-marker) (nth 0 bounds))) - (item-end (set-marker (make-marker) (nth 1 bounds))) - (list-start (progn (markdown-beginning-of-list) - (set-marker (make-marker) (point)))) - (list-end (progn (markdown-end-of-list) - (set-marker (make-marker) (point))))) - (goto-char item-start) - (while (< (point) item-end) - (unless (markdown-cur-line-blank-p) - (insert (make-string markdown-list-indent-width ? ))) - (forward-line)) - (markdown-syntax-propertize-list-items list-start list-end))))) - -(defun markdown-promote-list-item (&optional bounds) - "Unindent (or promote) the current list item. -Optionally, BOUNDS of the current list item may be provided if available. -In nested lists, demote child items as well." - (interactive) - (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) - (save-excursion - (save-match-data - (let ((item-start (set-marker (make-marker) (nth 0 bounds))) - (item-end (set-marker (make-marker) (nth 1 bounds))) - (list-start (progn (markdown-beginning-of-list) - (set-marker (make-marker) (point)))) - (list-end (progn (markdown-end-of-list) - (set-marker (make-marker) (point)))) - num regexp) - (goto-char item-start) - (when (looking-at (format "^[ ]\\{1,%d\\}" - markdown-list-indent-width)) - (setq num (- (match-end 0) (match-beginning 0))) - (setq regexp (format "^[ ]\\{1,%d\\}" num)) - (while (and (< (point) item-end) - (re-search-forward regexp item-end t)) - (replace-match "" nil nil) - (forward-line)) - (markdown-syntax-propertize-list-items list-start list-end))))))) - -(defun markdown-cleanup-list-numbers-level (&optional pfx prev-item) - "Update the numbering for level PFX (as a string of spaces) and PREV-ITEM. -PREV-ITEM is width of previous-indentation and list number - -Assume that the previously found match was for a numbered item in -a list." - (let ((cpfx pfx) - (cur-item nil) - (idx 0) - (continue t) - (step t) - (sep nil)) - (while (and continue (not (eobp))) - (setq step t) - (cond - ((looking-at "^\\(\\([\s-]*\\)[0-9]+\\)\\. ") - (setq cpfx (match-string-no-properties 2)) - (setq cur-item (match-string-no-properties 1)) ;; indentation and list marker - (cond - ((or (= (length cpfx) (length pfx)) - (= (length cur-item) (length prev-item))) - (save-excursion - (replace-match - (if (not markdown-ordered-list-enumeration) - (concat pfx "1. ") - (cl-incf idx) - (concat pfx (number-to-string idx) ". ")))) - (setq sep nil)) - ;; indented a level - ((< (length pfx) (length cpfx)) - (setq sep (markdown-cleanup-list-numbers-level cpfx cur-item)) - (setq step nil)) - ;; exit the loop - (t - (setq step nil) - (setq continue nil)))) - - ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$") - (setq cpfx (match-string-no-properties 1)) - (cond - ;; reset if separated before - ((string= cpfx pfx) (when sep (setq idx 0))) - ((string< cpfx pfx) - (setq step nil) - (setq continue nil)))) - (t (setq sep t))) - - (when step - (beginning-of-line) - (setq continue (= (forward-line) 0)))) - sep)) - -(defun markdown-cleanup-list-numbers () - "Update the numbering of ordered lists." - (interactive) - (save-excursion - (goto-char (point-min)) - (markdown-cleanup-list-numbers-level ""))) - - -;;; Movement ================================================================== - -;; This function was originally derived from `org-beginning-of-line' from org.el. -(defun markdown-beginning-of-line (&optional n) - "Go to the beginning of the current visible line. - -If this is a headline, and `markdown-special-ctrl-a/e' is not nil -or symbol `reversed', on the first attempt move to where the -headline text hashes, and only move to beginning of line when the -cursor is already before the hashes of the text of the headline. - -If `markdown-special-ctrl-a/e' is symbol `reversed' then go to -the hashes of the text on the second attempt. - -With argument N not nil or 1, move forward N - 1 lines first." - (interactive "^p") - (let ((origin (point)) - (special (pcase markdown-special-ctrl-a/e - (`(,C-a . ,_) C-a) (_ markdown-special-ctrl-a/e))) - deactivate-mark) - ;; First move to a visible line. - (if visual-line-mode - (beginning-of-visual-line n) - (move-beginning-of-line n) - ;; `move-beginning-of-line' may leave point after invisible - ;; characters if line starts with such of these (e.g., with - ;; a link at column 0). Really move to the beginning of the - ;; current visible line. - (forward-line 0)) - (cond - ;; No special behavior. Point is already at the beginning of - ;; a line, logical or visual. - ((not special)) - ;; `beginning-of-visual-line' left point before logical beginning - ;; of line: point is at the beginning of a visual line. Bail - ;; out. - ((and visual-line-mode (not (bolp)))) - ((looking-at markdown-regex-header-atx) - ;; At a header, special position is before the title. - (let ((refpos (match-beginning 2)) - (bol (point))) - (if (eq special 'reversed) - (when (and (= origin bol) (eq last-command this-command)) - (goto-char refpos)) - (when (or (> origin refpos) (<= origin bol)) - (goto-char refpos))) - ;; Prevent automatic cursor movement caused by the command loop. - ;; Enable disable-point-adjustment to avoid unintended cursor repositioning. - (when (and markdown-hide-markup - (equal (get-char-property (point) 'display) "")) - (setq disable-point-adjustment t)))) - ((looking-at markdown-regex-list) - ;; At a list item, special position is after the list marker or checkbox. - (let ((refpos (or (match-end 4) (match-end 3)))) - (if (eq special 'reversed) - (when (and (= (point) origin) (eq last-command this-command)) - (goto-char refpos)) - (when (or (> origin refpos) (<= origin (line-beginning-position))) - (goto-char refpos))))) - ;; No special case, already at beginning of line. - (t nil)))) - -;; This function was originally derived from `org-end-of-line' from org.el. -(defun markdown-end-of-line (&optional n) - "Go to the end of the line, but before ellipsis, if any. - -If this is a headline, and `markdown-special-ctrl-a/e' is not nil -or symbol `reversed', ignore closing tags on the first attempt, -and only move to after the closing tags when the cursor is -already beyond the end of the headline. - -If `markdown-special-ctrl-a/e' is symbol `reversed' then ignore -closing tags on the second attempt. - -With argument N not nil or 1, move forward N - 1 lines first." - (interactive "^p") - (let ((origin (point)) - (special (pcase markdown-special-ctrl-a/e - (`(,_ . ,C-e) C-e) (_ markdown-special-ctrl-a/e))) - deactivate-mark) - ;; First move to a visible line. - (if visual-line-mode - (beginning-of-visual-line n) - (move-beginning-of-line n)) - (cond - ;; At a headline, with closing tags. - ((save-excursion - (forward-line 0) - (and (looking-at markdown-regex-header-atx) (match-end 3))) - (let ((refpos (match-end 2)) - (visual-end (and visual-line-mode - (save-excursion - (end-of-visual-line) - (point))))) - ;; If `end-of-visual-line' brings us before end of line or even closing - ;; tags, i.e., the headline spans over multiple visual lines, move - ;; there. - (cond ((and visual-end - (< visual-end refpos) - (<= origin visual-end)) - (goto-char visual-end)) - ((not special) (end-of-line)) - ((eq special 'reversed) - (if (and (= origin (line-end-position)) - (eq this-command last-command)) - (goto-char refpos) - (end-of-line))) - (t - (if (or (< origin refpos) (>= origin (line-end-position))) - (goto-char refpos) - (end-of-line)))) - ;; Prevent automatic cursor movement caused by the command loop. - ;; Enable disable-point-adjustment to avoid unintended cursor repositioning. - (when (and markdown-hide-markup - (equal (get-char-property (point) 'display) "")) - (setq disable-point-adjustment t)))) - (visual-line-mode - (let ((bol (line-beginning-position))) - (end-of-visual-line) - ;; If `end-of-visual-line' gets us past the ellipsis at the - ;; end of a line, backtrack and use `end-of-line' instead. - (when (/= bol (line-beginning-position)) - (goto-char bol) - (end-of-line)))) - (t (end-of-line))))) - -(defun markdown-beginning-of-defun (&optional arg) - "`beginning-of-defun-function' for Markdown. -This is used to find the beginning of the defun and should behave -like ‘beginning-of-defun’, returning non-nil if it found the -beginning of a defun. It moves the point backward, right before a -heading which defines a defun. When ARG is non-nil, repeat that -many times. When ARG is negative, move forward to the ARG-th -following section." - (or arg (setq arg 1)) - (when (< arg 0) (end-of-line)) - ;; Adjust position for setext headings. - (when (and (thing-at-point-looking-at markdown-regex-header-setext) - (not (= (point) (match-beginning 0))) - (not (markdown-code-block-at-point-p))) - (goto-char (match-end 0))) - (let (found) - ;; Move backward with positive argument. - (while (and (not (bobp)) (> arg 0)) - (setq found nil) - (while (and (not found) - (not (bobp)) - (re-search-backward markdown-regex-header nil 'move)) - (markdown-code-block-at-pos (match-beginning 0)) - (setq found (match-beginning 0))) - (setq arg (1- arg))) - ;; Move forward with negative argument. - (while (and (not (eobp)) (< arg 0)) - (setq found nil) - (while (and (not found) - (not (eobp)) - (re-search-forward markdown-regex-header nil 'move)) - (markdown-code-block-at-pos (match-beginning 0)) - (setq found (match-beginning 0))) - (setq arg (1+ arg))) - (when found - (beginning-of-line) - t))) - -(defun markdown-end-of-defun () - "`end-of-defun-function’ for Markdown. -This is used to find the end of the defun at point. -It is called with no argument, right after calling ‘beginning-of-defun-raw’, -so it can assume that point is at the beginning of the defun body. -It should move point to the first position after the defun." - (or (eobp) (forward-char 1)) - (let (found) - (while (and (not found) - (not (eobp)) - (re-search-forward markdown-regex-header nil 'move)) - (when (not (markdown-code-block-at-pos (match-beginning 0))) - (setq found (match-beginning 0)))) - (when found - (goto-char found) - (skip-syntax-backward "-")))) - -(defun markdown-beginning-of-text-block () - "Move backward to previous beginning of a plain text block. -This function simply looks for blank lines without considering -the surrounding context in light of Markdown syntax. For that, see -`markdown-backward-block'." - (interactive) - (let ((start (point))) - (if (re-search-backward markdown-regex-block-separator nil t) - (goto-char (match-end 0)) - (goto-char (point-min))) - (when (and (= start (point)) (not (bobp))) - (forward-line -1) - (if (re-search-backward markdown-regex-block-separator nil t) - (goto-char (match-end 0)) - (goto-char (point-min)))))) - -(defun markdown-end-of-text-block () - "Move forward to next beginning of a plain text block. -This function simply looks for blank lines without considering -the surrounding context in light of Markdown syntax. For that, see -`markdown-forward-block'." - (interactive) - (beginning-of-line) - (skip-chars-forward " \t\n") - (when (= (point) (point-min)) - (forward-char)) - (if (re-search-forward markdown-regex-block-separator nil t) - (goto-char (match-end 0)) - (goto-char (point-max))) - (skip-chars-backward " \t\n") - (forward-line)) - -(defun markdown-backward-paragraph (&optional arg) - "Move the point to the start of the current paragraph. -With argument ARG, do it ARG times; a negative argument ARG = -N -means move forward N blocks." - (interactive "^p") - (or arg (setq arg 1)) - (if (< arg 0) - (markdown-forward-paragraph (- arg)) - (dotimes (_ arg) - ;; Skip over whitespace in between paragraphs when moving backward. - (skip-chars-backward " \t\n") - (beginning-of-line) - ;; Skip over code block endings. - (when (markdown-range-properties-exist - (line-beginning-position) (line-end-position) - '(markdown-gfm-block-end - markdown-tilde-fence-end)) - (forward-line -1)) - ;; Skip over blank lines inside blockquotes. - (while (and (not (eobp)) - (looking-at markdown-regex-blockquote) - (= (length (match-string 3)) 0)) - (forward-line -1)) - ;; Proceed forward based on the type of block of paragraph. - (let (bounds skip) - (cond - ;; Blockquotes - ((looking-at markdown-regex-blockquote) - (while (and (not (bobp)) - (looking-at markdown-regex-blockquote) - (> (length (match-string 3)) 0)) ;; not blank - (forward-line -1)) - (forward-line)) - ;; List items - ((setq bounds (markdown-cur-list-item-bounds)) - (goto-char (nth 0 bounds))) - ;; Other - (t - (while (and (not (bobp)) - (not skip) - (not (markdown-cur-line-blank-p)) - (not (looking-at markdown-regex-blockquote)) - (not (markdown-range-properties-exist - (line-beginning-position) (line-end-position) - '(markdown-gfm-block-end - markdown-tilde-fence-end)))) - (setq skip (markdown-range-properties-exist - (line-beginning-position) (line-end-position) - '(markdown-gfm-block-begin - markdown-tilde-fence-begin))) - (forward-line -1)) - (unless (bobp) - (forward-line 1)))))))) - -(defun markdown-forward-paragraph (&optional arg) - "Move forward to the next end of a paragraph. -With argument ARG, do it ARG times; a negative argument ARG = -N -means move backward N blocks." - (interactive "^p") - (or arg (setq arg 1)) - (if (< arg 0) - (markdown-backward-paragraph (- arg)) - (dotimes (_ arg) - ;; Skip whitespace in between paragraphs. - (when (markdown-cur-line-blank-p) - (skip-syntax-forward "-") - (beginning-of-line)) - ;; Proceed forward based on the type of block. - (let (bounds skip) - (cond - ;; Blockquotes - ((looking-at markdown-regex-blockquote) - ;; Skip over blank lines inside blockquotes. - (while (and (not (eobp)) - (looking-at markdown-regex-blockquote) - (= (length (match-string 3)) 0)) - (forward-line)) - ;; Move to end of quoted text block - (while (and (not (eobp)) - (looking-at markdown-regex-blockquote) - (> (length (match-string 3)) 0)) ;; not blank - (forward-line))) - ;; List items - ((and (markdown-cur-list-item-bounds) - (setq bounds (markdown-next-list-item-bounds))) - (goto-char (nth 0 bounds))) - ;; Other - (t - (forward-line) - (while (and (not (eobp)) - (not skip) - (not (markdown-cur-line-blank-p)) - (not (looking-at markdown-regex-blockquote)) - (not (markdown-range-properties-exist - (line-beginning-position) (line-end-position) - '(markdown-gfm-block-begin - markdown-tilde-fence-begin)))) - (setq skip (markdown-range-properties-exist - (line-beginning-position) (line-end-position) - '(markdown-gfm-block-end - markdown-tilde-fence-end))) - (forward-line)))))))) - -(defun markdown-backward-block (&optional arg) - "Move the point to the start of the current Markdown block. -Moves across complete code blocks, list items, and blockquotes, -but otherwise stops at blank lines, headers, and horizontal -rules. With argument ARG, do it ARG times; a negative argument -ARG = -N means move forward N blocks." - (interactive "^p") - (or arg (setq arg 1)) - (if (< arg 0) - (markdown-forward-block (- arg)) - (dotimes (_ arg) - ;; Skip over whitespace in between blocks when moving backward, - ;; unless at a block boundary with no whitespace. - (skip-syntax-backward "-") - (beginning-of-line) - ;; Proceed forward based on the type of block. - (cond - ;; Code blocks - ((and (markdown-code-block-at-pos (point)) ;; this line - (markdown-code-block-at-pos (line-beginning-position 0))) ;; previous line - (forward-line -1) - (while (and (markdown-code-block-at-point-p) (not (bobp))) - (forward-line -1)) - (forward-line)) - ;; Headings - ((markdown-heading-at-point) - (goto-char (match-beginning 0))) - ;; Horizontal rules - ((looking-at markdown-regex-hr)) - ;; Blockquotes - ((looking-at markdown-regex-blockquote) - (forward-line -1) - (while (and (looking-at markdown-regex-blockquote) - (not (bobp))) - (forward-line -1)) - (forward-line)) - ;; List items - ((markdown-cur-list-item-bounds) - (markdown-beginning-of-list)) - ;; Other - (t - ;; Move forward in case it is a one line regular paragraph. - (unless (markdown-next-line-blank-p) - (forward-line)) - (unless (markdown-prev-line-blank-p) - (markdown-backward-paragraph))))))) - -(defun markdown-forward-block (&optional arg) - "Move forward to the next end of a Markdown block. -Moves across complete code blocks, list items, and blockquotes, -but otherwise stops at blank lines, headers, and horizontal -rules. With argument ARG, do it ARG times; a negative argument -ARG = -N means move backward N blocks." - (interactive "^p") - (or arg (setq arg 1)) - (if (< arg 0) - (markdown-backward-block (- arg)) - (dotimes (_ arg) - ;; Skip over whitespace in between blocks when moving forward. - (if (markdown-cur-line-blank-p) - (skip-syntax-forward "-") - (beginning-of-line)) - ;; Proceed forward based on the type of block. - (cond - ;; Code blocks - ((markdown-code-block-at-point-p) - (forward-line) - (while (and (markdown-code-block-at-point-p) (not (eobp))) - (forward-line))) - ;; Headings - ((looking-at markdown-regex-header) - (goto-char (or (match-end 4) (match-end 2) (match-end 3))) - (forward-line)) - ;; Horizontal rules - ((looking-at markdown-regex-hr) - (forward-line)) - ;; Blockquotes - ((looking-at markdown-regex-blockquote) - (forward-line) - (while (and (looking-at markdown-regex-blockquote) (not (eobp))) - (forward-line))) - ;; List items - ((markdown-cur-list-item-bounds) - (markdown-end-of-list) - (forward-line)) - ;; Other - (t (markdown-forward-paragraph)))) - (skip-syntax-backward "-") - (unless (eobp) - (forward-char 1)))) - -(defun markdown-backward-page (&optional count) - "Move backward to boundary of the current toplevel section. -With COUNT, repeat, or go forward if negative." - (interactive "p") - (or count (setq count 1)) - (if (< count 0) - (markdown-forward-page (- count)) - (skip-syntax-backward "-") - (or (markdown-back-to-heading-over-code-block t t) - (goto-char (point-min))) - (when (looking-at markdown-regex-header) - (let ((level (markdown-outline-level))) - (when (> level 1) (markdown-up-heading level)) - (when (> count 1) - (condition-case nil - (markdown-backward-same-level (1- count)) - (error (goto-char (point-min))))))))) - -(defun markdown-forward-page (&optional count) - "Move forward to boundary of the current toplevel section. -With COUNT, repeat, or go backward if negative." - (interactive "p") - (or count (setq count 1)) - (if (< count 0) - (markdown-backward-page (- count)) - (if (markdown-back-to-heading-over-code-block t t) - (let ((level (markdown-outline-level))) - (when (> level 1) (markdown-up-heading level)) - (condition-case nil - (markdown-forward-same-level count) - (error (goto-char (point-max))))) - (markdown-next-visible-heading 1)))) - -(defun markdown-next-link () - "Jump to next inline, reference, or wiki link. -If successful, return point. Otherwise, return nil. -See `markdown-wiki-link-p' and `markdown-previous-wiki-link'." - (interactive) - (let ((opoint (point))) - (when (or (markdown-link-p) (markdown-wiki-link-p)) - ;; At a link already, move past it. - (goto-char (+ (match-end 0) 1))) - ;; Search for the next wiki link and move to the beginning. - (while (and (re-search-forward (markdown-make-regex-link-generic) nil t) - (markdown-code-block-at-point-p) - (< (point) (point-max)))) - (if (and (not (eq (point) opoint)) - (or (markdown-link-p) (markdown-wiki-link-p))) - ;; Group 1 will move past non-escape character in wiki link regexp. - ;; Go to beginning of group zero for all other link types. - (goto-char (or (match-beginning 1) (match-beginning 0))) - (goto-char opoint) - nil))) - -(defun markdown-previous-link () - "Jump to previous wiki link. -If successful, return point. Otherwise, return nil. -See `markdown-wiki-link-p' and `markdown-next-wiki-link'." - (interactive) - (let ((opoint (point))) - (while (and (re-search-backward (markdown-make-regex-link-generic) nil t) - (markdown-code-block-at-point-p) - (> (point) (point-min)))) - (if (and (not (eq (point) opoint)) - (or (markdown-link-p) (markdown-wiki-link-p))) - (goto-char (or (match-beginning 1) (match-beginning 0))) - (goto-char opoint) - nil))) - - -;;; Outline =================================================================== - -(defun markdown-move-heading-common (move-fn &optional arg adjust) - "Wrapper for `outline-mode' functions to skip false positives. -MOVE-FN is a function and ARG is its argument. For example, -headings inside preformatted code blocks may match -`outline-regexp' but should not be considered as headings. -When ADJUST is non-nil, adjust the point for interactive calls -to avoid leaving the point at invisible markup. This adjustment -generally should only be done for interactive calls, since other -functions may expect the point to be at the beginning of the -regular expression." - (let ((prev -1) (start (point))) - (if arg (funcall move-fn arg) (funcall move-fn)) - (while (and (/= prev (point)) (markdown-code-block-at-point-p)) - (setq prev (point)) - (if arg (funcall move-fn arg) (funcall move-fn))) - ;; Adjust point for setext headings and invisible text. - (save-match-data - (when (and adjust (thing-at-point-looking-at markdown-regex-header)) - (if markdown-hide-markup - ;; Move to beginning of heading text if markup is hidden. - (goto-char (or (match-beginning 1) (match-beginning 5))) - ;; Move to beginning of markup otherwise. - (goto-char (or (match-beginning 1) (match-beginning 4)))))) - (if (= (point) start) nil (point)))) - -(defun markdown-next-visible-heading (arg) - "Move to the next visible heading line of any level. -With argument, repeats or can move backward if negative. ARG is -passed to `outline-next-visible-heading'." - (interactive "p") - (markdown-move-heading-common #'outline-next-visible-heading arg 'adjust)) - -(defun markdown-previous-visible-heading (arg) - "Move to the previous visible heading line of any level. -With argument, repeats or can move backward if negative. ARG is -passed to `outline-previous-visible-heading'." - (interactive "p") - (markdown-move-heading-common #'outline-previous-visible-heading arg 'adjust)) - -(defun markdown-next-heading () - "Move to the next heading line of any level." - (markdown-move-heading-common #'outline-next-heading)) - -(defun markdown-previous-heading () - "Move to the previous heading line of any level." - (markdown-move-heading-common #'outline-previous-heading)) - -(defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error) - "Move back to the beginning of the previous heading. -Returns t if the point is at a heading, the location if a heading -was found, and nil otherwise. -Only visible heading lines are considered, unless INVISIBLE-OK is -non-nil. Throw an error if there is no previous heading unless -NO-ERROR is non-nil. -Leaves match data intact for `markdown-regex-header'." - (beginning-of-line) - (or (and (markdown-heading-at-point) - (not (markdown-code-block-at-point-p))) - (let (found) - (save-excursion - (while (and (not found) - (re-search-backward markdown-regex-header nil t)) - (when (and (or invisible-ok (not (outline-invisible-p))) - (not (markdown-code-block-at-point-p))) - (setq found (point)))) - (if (not found) - (unless no-error (user-error "Before first heading")) - (setq found (point)))) - (when found (goto-char found))))) - -(defun markdown-forward-same-level (arg) - "Move forward to the ARG'th heading at same level as this one. -Stop at the first and last headings of a superior heading." - (interactive "p") - (markdown-back-to-heading-over-code-block) - (markdown-move-heading-common #'outline-forward-same-level arg 'adjust)) - -(defun markdown-backward-same-level (arg) - "Move backward to the ARG'th heading at same level as this one. -Stop at the first and last headings of a superior heading." - (interactive "p") - (markdown-back-to-heading-over-code-block) - (while (> arg 0) - (let ((point-to-move-to - (save-excursion - (markdown-move-heading-common #'outline-get-last-sibling nil 'adjust)))) - (if point-to-move-to - (progn - (goto-char point-to-move-to) - (setq arg (1- arg))) - (user-error "No previous same-level heading"))))) - -(defun markdown-up-heading (arg &optional interactive) - "Move to the visible heading line of which the present line is a subheading. -With argument, move up ARG levels. When called interactively (or -INTERACTIVE is non-nil), also push the mark." - (interactive "p\np") - (and interactive (not (eq last-command 'markdown-up-heading)) - (push-mark)) - (markdown-move-heading-common #'outline-up-heading arg 'adjust)) - -(defun markdown-back-to-heading (&optional invisible-ok) - "Move to previous heading line, or beg of this line if it's a heading. -Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." - (interactive) - (markdown-move-heading-common #'outline-back-to-heading invisible-ok)) - -(defalias 'markdown-end-of-heading 'outline-end-of-heading) - -(defun markdown-on-heading-p () - "Return non-nil if point is on a heading line." - (get-text-property (line-beginning-position) 'markdown-heading)) - -(defun markdown-end-of-subtree (&optional invisible-OK) - "Move to the end of the current subtree. -Only visible heading lines are considered, unless INVISIBLE-OK is -non-nil. -Derived from `org-end-of-subtree'." - (markdown-back-to-heading invisible-OK) - (let ((first t) - (level (markdown-outline-level))) - (while (and (not (eobp)) - (or first (> (markdown-outline-level) level))) - (setq first nil) - (markdown-next-heading)) - (if (memq (preceding-char) '(?\n ?\^M)) - (progn - ;; Go to end of line before heading - (forward-char -1) - (if (memq (preceding-char) '(?\n ?\^M)) - ;; leave blank line before heading - (forward-char -1))))) - (point)) - -(defun markdown-outline-fix-visibility () - "Hide any false positive headings that should not be shown. -For example, headings inside preformatted code blocks may match -`outline-regexp' but should not be shown as headings when cycling. -Also, the ending --- line in metadata blocks appears to be a -setext header, but should not be folded." - (save-excursion - (goto-char (point-min)) - ;; Unhide any false positives in metadata blocks - (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin) - (let ((body (progn (forward-line) - (markdown-text-property-at-point - 'markdown-yaml-metadata-section)))) - (when body - (let ((end (progn (goto-char (cl-second body)) - (markdown-text-property-at-point - 'markdown-yaml-metadata-end)))) - (outline-flag-region (point-min) (1+ (cl-second end)) nil))))) - ;; Hide any false positives in code blocks - (unless (outline-on-heading-p) - (outline-next-visible-heading 1)) - (while (< (point) (point-max)) - (when (markdown-code-block-at-point-p) - (outline-flag-region (1- (line-beginning-position)) (line-end-position) t)) - (outline-next-visible-heading 1)))) - -(defvar markdown-cycle-global-status 1) -(defvar markdown-cycle-subtree-status nil) - -(defun markdown-next-preface () - (let (finish) - (while (and (not finish) (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") - nil 'move)) - (unless (markdown-code-block-at-point-p) - (goto-char (match-beginning 0)) - (setq finish t)))) - (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp))) - (forward-char -1))) - -(defun markdown-show-entry () - (save-excursion - (outline-back-to-heading t) - (outline-flag-region (1- (point)) - (progn - (markdown-next-preface) - (if (= 1 (- (point-max) (point))) - (point-max) - (point))) - nil))) - -;; This function was originally derived from `org-cycle' from org.el. -(defun markdown-cycle (&optional arg) - "Visibility cycling for Markdown mode. -This function is called with a `\\[universal-argument]' or if ARG is t, perform -global visibility cycling. If the point is at an atx-style header, cycle -visibility of the corresponding subtree. Otherwise, indent the current line - or insert a tab, as appropriate, by calling `indent-for-tab-command'." - (interactive "P") - (cond - - ;; Global cycling - (arg - (cond - ;; Move from overview to contents - ((and (eq last-command this-command) - (eq markdown-cycle-global-status 2)) - (outline-hide-sublevels 1) - (message "CONTENTS") - (setq markdown-cycle-global-status 3) - (markdown-outline-fix-visibility)) - ;; Move from contents to all - ((and (eq last-command this-command) - (eq markdown-cycle-global-status 3)) - (outline-show-all) - (message "SHOW ALL") - (setq markdown-cycle-global-status 1)) - ;; Defaults to overview - (t - (outline-hide-body) - (message "OVERVIEW") - (setq markdown-cycle-global-status 2) - (markdown-outline-fix-visibility)))) - - ;; At a heading: rotate between three different views - ((save-excursion (beginning-of-line 1) (markdown-on-heading-p)) - (markdown-back-to-heading) - (let ((goal-column 0) eoh eol eos) - ;; Determine boundaries - (save-excursion - (markdown-back-to-heading) - (save-excursion - (beginning-of-line 2) - (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (beginning-of-line 2)) (setq eol (point))) - (markdown-end-of-heading) (setq eoh (point)) - (markdown-end-of-subtree t) - (skip-chars-forward " \t\n") - (beginning-of-line 1) ; in case this is an item - (setq eos (1- (point)))) - ;; Find out what to do next and set `this-command' - (cond - ;; Nothing is hidden behind this heading - ((= eos eoh) - (message "EMPTY ENTRY") - (setq markdown-cycle-subtree-status nil)) - ;; Entire subtree is hidden in one line: open it - ((>= eol eos) - (markdown-show-entry) - (outline-show-children) - (message "CHILDREN") - (setq markdown-cycle-subtree-status 'children)) - ;; We just showed the children, now show everything. - ((and (eq last-command this-command) - (eq markdown-cycle-subtree-status 'children)) - (outline-show-subtree) - (message "SUBTREE") - (setq markdown-cycle-subtree-status 'subtree)) - ;; Default action: hide the subtree. - (t - (outline-hide-subtree) - (message "FOLDED") - (setq markdown-cycle-subtree-status 'folded))))) - - ;; In a table, move forward by one cell - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-forward-cell)) - - ;; Otherwise, indent as appropriate - (t - (indent-for-tab-command)))) - -(defun markdown-shifttab () - "Handle S-TAB keybinding based on context. -When in a table, move backward one cell. -Otherwise, cycle global heading visibility by calling -`markdown-cycle' with argument t." - (interactive) - (cond ((markdown-table-at-point-p) - (call-interactively #'markdown-table-backward-cell)) - (t (markdown-cycle t)))) - -(defun markdown-outline-level () - "Return the depth to which a statement is nested in the outline." - (cond - ((and (match-beginning 0) - (markdown-code-block-at-pos (match-beginning 0))) - 7) ;; Only 6 header levels are defined. - ((match-end 2) 1) - ((match-end 3) 2) - ((match-end 4) - (length (markdown-trim-whitespace (match-string-no-properties 4)))))) - -(defun markdown-promote-subtree (&optional arg) - "Promote the current subtree of ATX headings. -Note that Markdown does not support heading levels higher than -six and therefore level-six headings will not be promoted -further. If ARG is non-nil promote the heading, otherwise -demote." - (interactive "*P") - (save-excursion - (when (and (or (thing-at-point-looking-at markdown-regex-header-atx) - (re-search-backward markdown-regex-header-atx nil t)) - (not (markdown-code-block-at-point-p))) - (let ((level (length (match-string 1))) - (promote-or-demote (if arg 1 -1)) - (remove 't)) - (markdown-cycle-atx promote-or-demote remove) - (catch 'end-of-subtree - (while (and (markdown-next-heading) - (looking-at markdown-regex-header-atx)) - ;; Exit if this not a higher level heading; promote otherwise. - (if (and (looking-at markdown-regex-header-atx) - (<= (length (match-string-no-properties 1)) level)) - (throw 'end-of-subtree nil) - (markdown-cycle-atx promote-or-demote remove)))))))) - -(defun markdown-demote-subtree () - "Demote the current subtree of ATX headings." - (interactive) - (markdown-promote-subtree t)) - -(defun markdown-move-subtree-up () - "Move the current subtree of ATX headings up." - (interactive) - (outline-move-subtree-up 1)) - -(defun markdown-move-subtree-down () - "Move the current subtree of ATX headings down." - (interactive) - (outline-move-subtree-down 1)) - -(defun markdown-outline-next () - "Move to next list item, when in a list, or next visible heading." - (interactive) - (let ((bounds (markdown-next-list-item-bounds))) - (if bounds - (goto-char (nth 0 bounds)) - (markdown-next-visible-heading 1)))) - -(defun markdown-outline-previous () - "Move to previous list item, when in a list, or previous visible heading." - (interactive) - (let ((bounds (markdown-prev-list-item-bounds))) - (if bounds - (goto-char (nth 0 bounds)) - (markdown-previous-visible-heading 1)))) - -(defun markdown-outline-next-same-level () - "Move to next list item or heading of same level." - (interactive) - (let ((bounds (markdown-cur-list-item-bounds))) - (if bounds - (markdown-next-list-item (nth 3 bounds)) - (markdown-forward-same-level 1)))) - -(defun markdown-outline-previous-same-level () - "Move to previous list item or heading of same level." - (interactive) - (let ((bounds (markdown-cur-list-item-bounds))) - (if bounds - (markdown-prev-list-item (nth 3 bounds)) - (markdown-backward-same-level 1)))) - -(defun markdown-outline-up () - "Move to previous list item, when in a list, or previous heading." - (interactive) - (unless (markdown-up-list) - (markdown-up-heading 1))) - - -;;; Marking and Narrowing ===================================================== - -(defun markdown-mark-paragraph () - "Put mark at end of this block, point at beginning. -The block marked is the one that contains point or follows point. - -Interactively, if this command is repeated or (in Transient Mark -mode) if the mark is active, it marks the next block after the -ones already marked." - (interactive) - (if (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active)) - (set-mark - (save-excursion - (goto-char (mark)) - (markdown-forward-paragraph) - (point))) - (let ((beginning-of-defun-function #'markdown-backward-paragraph) - (end-of-defun-function #'markdown-forward-paragraph)) - (mark-defun)))) - -(defun markdown-mark-block () - "Put mark at end of this block, point at beginning. -The block marked is the one that contains point or follows point. - -Interactively, if this command is repeated or (in Transient Mark -mode) if the mark is active, it marks the next block after the -ones already marked." - (interactive) - (if (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active)) - (set-mark - (save-excursion - (goto-char (mark)) - (markdown-forward-block) - (point))) - (let ((beginning-of-defun-function #'markdown-backward-block) - (end-of-defun-function #'markdown-forward-block)) - (mark-defun)))) - -(defun markdown-narrow-to-block () - "Make text outside current block invisible. -The current block is the one that contains point or follows point." - (interactive) - (let ((beginning-of-defun-function #'markdown-backward-block) - (end-of-defun-function #'markdown-forward-block)) - (narrow-to-defun))) - -(defun markdown-mark-text-block () - "Put mark at end of this plain text block, point at beginning. -The block marked is the one that contains point or follows point. - -Interactively, if this command is repeated or (in Transient Mark -mode) if the mark is active, it marks the next block after the -ones already marked." - (interactive) - (if (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active)) - (set-mark - (save-excursion - (goto-char (mark)) - (markdown-end-of-text-block) - (point))) - (let ((beginning-of-defun-function #'markdown-beginning-of-text-block) - (end-of-defun-function #'markdown-end-of-text-block)) - (mark-defun)))) - -(defun markdown-mark-page () - "Put mark at end of this top level section, point at beginning. -The top level section marked is the one that contains point or -follows point. - -Interactively, if this command is repeated or (in Transient Mark -mode) if the mark is active, it marks the next page after the -ones already marked." - (interactive) - (if (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active)) - (set-mark - (save-excursion - (goto-char (mark)) - (markdown-forward-page) - (point))) - (let ((beginning-of-defun-function #'markdown-backward-page) - (end-of-defun-function #'markdown-forward-page)) - (mark-defun)))) - -(defun markdown-narrow-to-page () - "Make text outside current top level section invisible. -The current section is the one that contains point or follows point." - (interactive) - (let ((beginning-of-defun-function #'markdown-backward-page) - (end-of-defun-function #'markdown-forward-page)) - (narrow-to-defun))) - -(defun markdown-mark-subtree () - "Mark the current subtree. -This puts point at the start of the current subtree, and mark at the end." - (interactive) - (let ((beg)) - (if (markdown-heading-at-point) - (beginning-of-line) - (markdown-previous-visible-heading 1)) - (setq beg (point)) - (markdown-end-of-subtree) - (push-mark (point) nil t) - (goto-char beg))) - -(defun markdown-narrow-to-subtree () - "Narrow buffer to the current subtree." - (interactive) - (save-excursion - (save-match-data - (narrow-to-region - (progn (markdown-back-to-heading-over-code-block t) (point)) - (progn (markdown-end-of-subtree) - (if (and (markdown-heading-at-point) (not (eobp))) - (backward-char 1)) - (point)))))) - - -;;; Generic Structure Editing, Completion, and Cycling Commands =============== - -(defun markdown-move-up () - "Move thing at point up. -When in a list item, call `markdown-move-list-item-up'. -When in a table, call `markdown-table-move-row-up'. -Otherwise, move the current heading subtree up with -`markdown-move-subtree-up'." - (interactive) - (cond - ((markdown-list-item-at-point-p) - (call-interactively #'markdown-move-list-item-up)) - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-move-row-up)) - (t - (call-interactively #'markdown-move-subtree-up)))) - -(defun markdown-move-down () - "Move thing at point down. -When in a list item, call `markdown-move-list-item-down'. -Otherwise, move the current heading subtree up with -`markdown-move-subtree-down'." - (interactive) - (cond - ((markdown-list-item-at-point-p) - (call-interactively #'markdown-move-list-item-down)) - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-move-row-down)) - (t - (call-interactively #'markdown-move-subtree-down)))) - -(defun markdown-promote () - "Promote or move element at point to the left. -Depending on the context, this function will promote a heading or -list item at the point, move a table column to the left, or cycle -markup." - (interactive) - (let (bounds) - (cond - ;; Promote atx heading subtree - ((thing-at-point-looking-at markdown-regex-header-atx) - (markdown-promote-subtree)) - ;; Promote setext heading - ((thing-at-point-looking-at markdown-regex-header-setext) - (markdown-cycle-setext -1)) - ;; Promote horizontal rule - ((thing-at-point-looking-at markdown-regex-hr) - (markdown-cycle-hr -1)) - ;; Promote list item - ((setq bounds (markdown-cur-list-item-bounds)) - (markdown-promote-list-item bounds)) - ;; Move table column to the left - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-move-column-left)) - ;; Promote bold - ((thing-at-point-looking-at markdown-regex-bold) - (markdown-cycle-bold)) - ;; Promote italic - ((thing-at-point-looking-at markdown-regex-italic) - (markdown-cycle-italic)) - (t - (user-error "Nothing to promote at point"))))) - -(defun markdown-demote () - "Demote or move element at point to the right. -Depending on the context, this function will demote a heading or -list item at the point, move a table column to the right, or cycle -or remove markup." - (interactive) - (let (bounds) - (cond - ;; Demote atx heading subtree - ((thing-at-point-looking-at markdown-regex-header-atx) - (markdown-demote-subtree)) - ;; Demote setext heading - ((thing-at-point-looking-at markdown-regex-header-setext) - (markdown-cycle-setext 1)) - ;; Demote horizontal rule - ((thing-at-point-looking-at markdown-regex-hr) - (markdown-cycle-hr 1)) - ;; Demote list item - ((setq bounds (markdown-cur-list-item-bounds)) - (markdown-demote-list-item bounds)) - ;; Move table column to the right - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-move-column-right)) - ;; Demote bold - ((thing-at-point-looking-at markdown-regex-bold) - (markdown-cycle-bold)) - ;; Demote italic - ((thing-at-point-looking-at markdown-regex-italic) - (markdown-cycle-italic)) - (t - (user-error "Nothing to demote at point"))))) - - -;;; Commands ================================================================== - -(defun markdown (&optional output-buffer-name) - "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME. -The output buffer name defaults to `markdown-output-buffer-name'. -Return the name of the output buffer used." - (interactive) - (save-window-excursion - (let* ((commands (cond ((stringp markdown-command) (split-string markdown-command)) - ((listp markdown-command) markdown-command))) - (command (car-safe commands)) - (command-args (cdr-safe commands)) - begin-region end-region) - (if (use-region-p) - (setq begin-region (region-beginning) - end-region (region-end)) - (setq begin-region (point-min) - end-region (point-max))) - - (unless output-buffer-name - (setq output-buffer-name markdown-output-buffer-name)) - (when (and (stringp command) (not (executable-find command))) - (user-error "Markdown command %s is not found" command)) - (let ((exit-code - (cond - ;; Handle case when `markdown-command' does not read from stdin - ((and (stringp command) markdown-command-needs-filename) - (if (not buffer-file-name) - (user-error "Must be visiting a file") - ;; Don’t use ‘shell-command’ because it’s not guaranteed to - ;; return the exit code of the process. - (let ((command (if (listp markdown-command) - (string-join markdown-command " ") - markdown-command))) - (shell-command-on-region - ;; Pass an empty region so that stdin is empty. - (point) (point) - (concat command " " - (shell-quote-argument buffer-file-name)) - output-buffer-name)))) - ;; Pass region to `markdown-command' via stdin - (t - (let ((buf (get-buffer-create output-buffer-name))) - (with-current-buffer buf - (setq buffer-read-only nil) - (erase-buffer)) - (if (stringp command) - (if (not (null command-args)) - (apply #'call-process-region begin-region end-region command nil buf nil command-args) - (call-process-region begin-region end-region command nil buf)) - (if markdown-command-needs-filename - (if (not buffer-file-name) - (user-error "Must be visiting a file") - (funcall markdown-command begin-region end-region buf buffer-file-name)) - (funcall markdown-command begin-region end-region buf)) - ;; If the ‘markdown-command’ function didn’t signal an - ;; error, assume it succeeded by binding ‘exit-code’ to 0. - 0)))))) - ;; The exit code can be a signal description string, so don’t use ‘=’ - ;; or ‘zerop’. - (unless (eq exit-code 0) - (user-error "%s failed with exit code %s" - markdown-command exit-code)))) - output-buffer-name)) - -(defun markdown-standalone (&optional output-buffer-name) - "Special function to provide standalone HTML output. -Insert the output in the buffer named OUTPUT-BUFFER-NAME." - (interactive) - (setq output-buffer-name (markdown output-buffer-name)) - (let ((css-path markdown-css-paths)) - (with-current-buffer output-buffer-name - (set-buffer output-buffer-name) - (setq-local markdown-css-paths css-path) - (unless (markdown-output-standalone-p) - (markdown-add-xhtml-header-and-footer output-buffer-name)) - (goto-char (point-min)) - (html-mode))) - output-buffer-name) - -(defun markdown-other-window (&optional output-buffer-name) - "Run `markdown-command' on current buffer and display in other window. -When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with -that name." - (interactive) - (markdown-display-buffer-other-window - (markdown-standalone output-buffer-name))) - -(defun markdown-output-standalone-p () - "Determine whether `markdown-command' output is standalone XHTML. -Standalone XHTML output is identified by an occurrence of -`markdown-xhtml-standalone-regexp' in the first five lines of output." - (save-excursion - (goto-char (point-min)) - (save-match-data - (re-search-forward - markdown-xhtml-standalone-regexp - (save-excursion (goto-char (point-min)) (forward-line 4) (point)) - t)))) - -(defun markdown-stylesheet-link-string (stylesheet-path) - (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\"" - (or (and (string-prefix-p "~" stylesheet-path) - (expand-file-name stylesheet-path)) - stylesheet-path) - "\" />")) - -(defun markdown-escape-title (title) - "Escape a minimum set of characters in TITLE so they don't clash with html." - (replace-regexp-in-string ">" ">" - (replace-regexp-in-string "<" "<" - (replace-regexp-in-string "&" "&" title)))) - -(defun markdown-add-xhtml-header-and-footer (title) - "Wrap XHTML header and footer with given TITLE around current buffer." - (goto-char (point-min)) - (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n" - "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n" - "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n" - "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n" - "<head>\n<title>") - (insert (markdown-escape-title title)) - (insert "</title>\n") - (unless (= (length markdown-content-type) 0) - (insert - (format - "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n" - markdown-content-type - (or (and markdown-coding-system - (coding-system-get markdown-coding-system - 'mime-charset)) - (coding-system-get buffer-file-coding-system - 'mime-charset) - "utf-8")))) - (if (> (length markdown-css-paths) 0) - (insert (mapconcat #'markdown-stylesheet-link-string - markdown-css-paths "\n"))) - (when (> (length markdown-xhtml-header-content) 0) - (insert markdown-xhtml-header-content)) - (insert "\n</head>\n\n" - "<body>\n\n") - (when (> (length markdown-xhtml-body-preamble) 0) - (insert markdown-xhtml-body-preamble "\n")) - (goto-char (point-max)) - (when (> (length markdown-xhtml-body-epilogue) 0) - (insert "\n" markdown-xhtml-body-epilogue)) - (insert "\n" - "</body>\n" - "</html>\n")) - -(defun markdown-preview (&optional output-buffer-name) - "Run `markdown-command' on the current buffer and view output in browser. -When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with -that name." - (interactive) - (browse-url-of-buffer - (markdown-standalone (or output-buffer-name markdown-output-buffer-name)))) - -(defun markdown-export-file-name (&optional extension) - "Attempt to generate a filename for Markdown output. -The file extension will be EXTENSION if given, or .html by default. -If the current buffer is visiting a file, we construct a new -output filename based on that filename. Otherwise, return nil." - (when (buffer-file-name) - (unless extension - (setq extension ".html")) - (let ((candidate - (concat - (cond - ((buffer-file-name) - (file-name-sans-extension (buffer-file-name))) - (t (buffer-name))) - extension))) - (cond - ((equal candidate (buffer-file-name)) - (concat candidate extension)) - (t - candidate))))) - -(defun markdown-export (&optional output-file) - "Run Markdown on the current buffer, save to file, and return the filename. -If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename -generated by `markdown-export-file-name', which will be constructed using the -current filename, but with the extension removed and replaced with .html." - (interactive) - (unless output-file - (setq output-file (markdown-export-file-name ".html"))) - (when output-file - (let* ((init-buf (current-buffer)) - (init-point (point)) - (init-buf-string (buffer-string)) - (output-buffer (find-file-noselect output-file)) - (output-buffer-name (buffer-name output-buffer))) - (run-hooks 'markdown-before-export-hook) - (markdown-standalone output-buffer-name) - (with-current-buffer output-buffer - (run-hooks 'markdown-after-export-hook) - (save-buffer) - (when markdown-export-kill-buffer (kill-buffer))) - ;; if modified, restore initial buffer - (when (buffer-modified-p init-buf) - (erase-buffer) - (insert init-buf-string) - (save-buffer) - (goto-char init-point)) - output-file))) - -(defun markdown-export-and-preview () - "Export to XHTML using `markdown-export' and browse the resulting file." - (interactive) - (browse-url-of-file (markdown-export))) - -(defvar-local markdown-live-preview-buffer nil - "Buffer used to preview markdown output in `markdown-live-preview-export'.") - -(defvar-local markdown-live-preview-source-buffer nil - "Source buffer from which current buffer was generated. -This is the inverse of `markdown-live-preview-buffer'.") - -(defvar markdown-live-preview-currently-exporting nil) - -(defun markdown-live-preview-get-filename () - "Standardize the filename exported by `markdown-live-preview-export'." - (markdown-export-file-name ".html")) - -(defun markdown-live-preview-window-eww (file) - "Preview FILE with eww. -To be used with `markdown-live-preview-window-function'." - (when (and (bound-and-true-p eww-auto-rename-buffer) - markdown-live-preview-buffer) - (kill-buffer markdown-live-preview-buffer)) - (eww-open-file file) - ;; #737 if `eww-auto-rename-buffer' is non-nil, the buffer name is not "*eww*" - ;; Try to find the buffer whose name ends with "eww*" - (if (bound-and-true-p eww-auto-rename-buffer) - (cl-loop for buf in (buffer-list) - when (string-match-p "eww\\*\\'" (buffer-name buf)) - return buf) - (get-buffer "*eww*"))) - -(defun markdown-visual-lines-between-points (beg end) - (save-excursion - (goto-char beg) - (cl-loop with count = 0 - while (progn (end-of-visual-line) - (and (< (point) end) (line-move-visual 1 t))) - do (cl-incf count) - finally return count))) - -(defun markdown-live-preview-window-serialize (buf) - "Get window point and scroll data for all windows displaying BUF." - (when (buffer-live-p buf) - (with-current-buffer buf - (mapcar - (lambda (win) - (with-selected-window win - (let* ((start (window-start)) - (pt (window-point)) - (pt-or-sym (cond ((= pt (point-min)) 'min) - ((= pt (point-max)) 'max) - (t pt))) - (diff (markdown-visual-lines-between-points - start pt))) - (list win pt-or-sym diff)))) - (get-buffer-window-list buf))))) - -(defun markdown-get-point-back-lines (pt num-lines) - (save-excursion - (goto-char pt) - (line-move-visual (- num-lines) t) - ;; in testing, can occasionally overshoot the number of lines to traverse - (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt))) - (when (> actual-num-lines num-lines) - (line-move-visual (- actual-num-lines num-lines) t))) - (point))) - -(defun markdown-live-preview-window-deserialize (window-posns) - "Apply window point and scroll data from WINDOW-POSNS. -WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'." - (cl-destructuring-bind (win pt-or-sym diff) window-posns - (when (window-live-p win) - (with-current-buffer markdown-live-preview-buffer - (set-window-buffer win (current-buffer)) - (cl-destructuring-bind (actual-pt actual-diff) - (cl-case pt-or-sym - (min (list (point-min) 0)) - (max (list (point-max) diff)) - (t (list pt-or-sym diff))) - (set-window-start - win (markdown-get-point-back-lines actual-pt actual-diff)) - (set-window-point win actual-pt)))))) - -(defun markdown-live-preview-export () - "Export to XHTML using `markdown-export'. -Browse the resulting file within Emacs using -`markdown-live-preview-window-function' Return the buffer -displaying the rendered output." - (interactive) - (let ((filename (markdown-live-preview-get-filename))) - (when filename - (let* ((markdown-live-preview-currently-exporting t) - (cur-buf (current-buffer)) - (export-file (markdown-export filename)) - ;; get positions in all windows currently displaying output buffer - (window-data - (markdown-live-preview-window-serialize - markdown-live-preview-buffer))) - (save-window-excursion - (let ((output-buffer - (funcall markdown-live-preview-window-function export-file))) - (with-current-buffer output-buffer - (setq markdown-live-preview-source-buffer cur-buf) - (add-hook 'kill-buffer-hook - #'markdown-live-preview-remove-on-kill t t)) - (with-current-buffer cur-buf - (setq markdown-live-preview-buffer output-buffer)))) - (with-current-buffer cur-buf - ;; reset all windows displaying output buffer to where they were, - ;; now with the new output - (mapc #'markdown-live-preview-window-deserialize window-data) - ;; delete html editing buffer - (let ((buf (get-file-buffer export-file))) (when buf (kill-buffer buf))) - (when (and export-file (file-exists-p export-file) - (eq markdown-live-preview-delete-export - 'delete-on-export)) - (delete-file export-file)) - markdown-live-preview-buffer))))) - -(defun markdown-live-preview-remove () - (when (buffer-live-p markdown-live-preview-buffer) - (kill-buffer markdown-live-preview-buffer)) - (setq markdown-live-preview-buffer nil) - ;; if set to 'delete-on-export, the output has already been deleted - (when (eq markdown-live-preview-delete-export 'delete-on-destroy) - (let ((outfile-name (markdown-live-preview-get-filename))) - (when (and outfile-name (file-exists-p outfile-name)) - (delete-file outfile-name))))) - -(defun markdown-get-other-window () - "Find another window to display preview or output content." - (cond - ((memq markdown-split-window-direction '(vertical below)) - (or (window-in-direction 'below) (split-window-vertically))) - ((memq markdown-split-window-direction '(horizontal right)) - (or (window-in-direction 'right) (split-window-horizontally))) - (t (split-window-sensibly (get-buffer-window))))) - -(defun markdown-display-buffer-other-window (buf) - "Display preview or output buffer BUF in another window." - (if (and display-buffer-alist (eq markdown-split-window-direction 'any)) - (display-buffer buf) - (let ((cur-buf (current-buffer)) - (window (markdown-get-other-window))) - (set-window-buffer window buf) - (set-buffer cur-buf)))) - -(defun markdown-live-preview-if-markdown () - (when (and (derived-mode-p 'markdown-mode) - markdown-live-preview-mode) - (unless markdown-live-preview-currently-exporting - (if (buffer-live-p markdown-live-preview-buffer) - (markdown-live-preview-export) - (markdown-display-buffer-other-window - (markdown-live-preview-export)))))) - -(defun markdown-live-preview-remove-on-kill () - (cond ((and (derived-mode-p 'markdown-mode) - markdown-live-preview-mode) - (markdown-live-preview-remove)) - (markdown-live-preview-source-buffer - (with-current-buffer markdown-live-preview-source-buffer - (setq markdown-live-preview-buffer nil)) - (setq markdown-live-preview-source-buffer nil)))) - -(defun markdown-live-preview-switch-to-output () - "Turn on `markdown-live-preview-mode' and switch to output buffer. -The output buffer is opened in another window." - (interactive) - (if markdown-live-preview-mode - (markdown-display-buffer-other-window (markdown-live-preview-export))) - (markdown-live-preview-mode)) - -(defun markdown-live-preview-re-export () - "Re-export the current live previewed content. -If the current buffer is a buffer displaying the exported version of a -`markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and -update this buffer's contents." - (interactive) - (when markdown-live-preview-source-buffer - (with-current-buffer markdown-live-preview-source-buffer - (markdown-live-preview-export)))) - -(defun markdown-open () - "Open file for the current buffer with `markdown-open-command'." - (interactive) - (unless markdown-open-command - (user-error "Variable `markdown-open-command' must be set")) - (if (stringp markdown-open-command) - (if (not buffer-file-name) - (user-error "Must be visiting a file") - (save-buffer) - (let ((exit-code (call-process markdown-open-command nil nil nil - buffer-file-name))) - ;; The exit code can be a signal description string, so don’t use ‘=’ - ;; or ‘zerop’. - (unless (eq exit-code 0) - (user-error "%s failed with exit code %s" - markdown-open-command exit-code)))) - (funcall markdown-open-command)) - nil) - -(defun markdown-kill-ring-save () - "Run Markdown on file and store output in the kill ring." - (interactive) - (save-window-excursion - (markdown) - (with-current-buffer markdown-output-buffer-name - (kill-ring-save (point-min) (point-max))))) - - -;;; Links ===================================================================== - -(defun markdown-backward-to-link-start () - "Backward link start position if current position is in link title." - ;; Issue #305 - (when (eq (get-text-property (point) 'face) 'markdown-link-face) - (skip-chars-backward "^[") - (forward-char -1))) - -(defun markdown-link-p () - "Return non-nil when `point' is at a non-wiki link. -See `markdown-wiki-link-p' for more information." - (save-excursion - (let ((case-fold-search nil)) - (when (and (not (markdown-wiki-link-p)) (not (markdown-code-block-at-point-p))) - (markdown-backward-to-link-start) - (or (thing-at-point-looking-at markdown-regex-link-inline) - (thing-at-point-looking-at markdown-regex-link-reference) - (thing-at-point-looking-at markdown-regex-uri) - (thing-at-point-looking-at markdown-regex-angle-uri)))))) - -(defun markdown-link-at-pos (pos) - "Return properties of link or image at position POS. -Value is a list of elements describing the link: - 0. beginning position - 1. end position - 2. link text - 3. URL - 4. reference label - 5. title text - 6. bang (nil or \"!\")" - (save-excursion - (goto-char pos) - (markdown-backward-to-link-start) - (let (begin end text url reference title bang) - (cond - ;; Inline image or link at point. - ((thing-at-point-looking-at markdown-regex-link-inline) - (setq bang (match-string-no-properties 1) - begin (match-beginning 0) - text (match-string-no-properties 3) - url (match-string-no-properties 6)) - ;; consider nested parentheses - ;; if link target contains parentheses, (match-end 0) isn't correct end position of the link - (let* ((close-pos (scan-sexps (match-beginning 5) 1)) - (destination-part (string-trim (buffer-substring-no-properties (1+ (match-beginning 5)) (1- close-pos))))) - (setq end close-pos) - ;; A link can contain spaces if it is wrapped with angle brackets - (cond ((string-match "\\`<\\(.+\\)>\\'" destination-part) - (setq url (match-string-no-properties 1 destination-part))) - ((string-match "\\([^ ]+\\)\\s-+\\(.+\\)" destination-part) - (setq url (match-string-no-properties 1 destination-part) - title (substring (match-string-no-properties 2 destination-part) 1 -1))) - (t (setq url destination-part))) - (setq url (url-unhex-string url)))) - ;; Reference link at point. - ((thing-at-point-looking-at markdown-regex-link-reference) - (setq bang (match-string-no-properties 1) - begin (match-beginning 0) - end (match-end 0) - text (match-string-no-properties 3)) - (when (char-equal (char-after (match-beginning 5)) ?\[) - (setq reference (match-string-no-properties 6)))) - ;; Angle bracket URI at point. - ((thing-at-point-looking-at markdown-regex-angle-uri) - (setq begin (match-beginning 0) - end (match-end 0) - url (match-string-no-properties 2))) - ;; Plain URI at point. - ((thing-at-point-looking-at markdown-regex-uri) - (setq begin (match-beginning 0) - end (match-end 0) - url (match-string-no-properties 1)))) - (list begin end text url reference title bang)))) - -(defun markdown-link-url () - "Return the URL part of the regular (non-wiki) link at point. -Works with both inline and reference style links, and with images. -If point is not at a link or the link reference is not defined -returns nil." - (let* ((values (markdown-link-at-pos (point))) - (text (nth 2 values)) - (url (nth 3 values)) - (ref (nth 4 values))) - (or url (and ref (car (markdown-reference-definition - (downcase (if (string= ref "") text ref)))))))) - -(defun markdown--browse-url (url) - (let* ((struct (url-generic-parse-url url)) - (full (url-fullness struct)) - (file url)) - ;; Parse URL, determine fullness, strip query string - (setq file (car (url-path-and-query struct))) - ;; Open full URLs in browser, files in Emacs - (if full - (browse-url url) - (when (and file (> (length file) 0)) - (let ((link-file (funcall markdown-translate-filename-function file))) - (if (and markdown-open-image-command (string-match-p (image-file-name-regexp) link-file)) - (if (functionp markdown-open-image-command) - (funcall markdown-open-image-command link-file) - (process-file markdown-open-image-command nil nil nil link-file)) - (find-file link-file))))))) - -(defun markdown-follow-link-at-point (&optional event) - "Open the non-wiki link at point or EVENT. -If the link is a complete URL, open in browser with `browse-url'. -Otherwise, open with `find-file' after stripping anchor and/or query string. -Translate filenames using `markdown-filename-translate-function'." - (interactive (list last-command-event)) - (if event (posn-set-point (event-start event))) - (if (markdown-link-p) - (or (run-hook-with-args-until-success 'markdown-follow-link-functions (markdown-link-url)) - (markdown--browse-url (markdown-link-url))) - (user-error "Point is not at a Markdown link or URL"))) - -(defun markdown-fontify-inline-links (last) - "Add text properties to next inline link from point to LAST." - (when (markdown-match-generic-links last nil) - (let* ((link-start (match-beginning 3)) - (link-end (match-end 3)) - (url-start (match-beginning 6)) - (url-end (match-end 6)) - (url (match-string-no-properties 6)) - (title-start (match-beginning 7)) - (title-end (match-end 7)) - (title (match-string-no-properties 7)) - ;; Markup part - (mp (list 'invisible 'markdown-markup - 'rear-nonsticky t - 'font-lock-multiline t)) - ;; Link part (without face) - (lp (list 'keymap markdown-mode-mouse-map - 'mouse-face 'markdown-highlight-face - 'font-lock-multiline t - 'help-echo (if title (concat title "\n" url) url))) - ;; URL part - (up (list 'keymap markdown-mode-mouse-map - 'invisible 'markdown-markup - 'mouse-face 'markdown-highlight-face - 'font-lock-multiline t)) - ;; URL composition character - (url-char (markdown--first-displayable markdown-url-compose-char)) - ;; Title part - (tp (list 'invisible 'markdown-markup - 'font-lock-multiline t))) - (dolist (g '(1 2 4 5 8)) - (when (match-end g) - (add-text-properties (match-beginning g) (match-end g) mp) - (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face))) - ;; Preserve existing faces applied to link part (e.g., inline code) - (when link-start - (add-text-properties link-start link-end lp) - (add-face-text-property link-start link-end 'markdown-link-face)) - (when url-start - (add-text-properties url-start url-end up) - (add-face-text-property url-start url-end 'markdown-url-face)) - (when title-start - (add-text-properties url-end title-end tp) - (add-face-text-property url-end title-end 'markdown-link-title-face)) - (when (and markdown-hide-urls url-start) - (compose-region url-start (or title-end url-end) url-char)) - t))) - -(defun markdown-fontify-reference-links (last) - "Add text properties to next reference link from point to LAST." - (when (markdown-match-generic-links last t) - (let* ((link-start (match-beginning 3)) - (link-end (match-end 3)) - (ref-start (match-beginning 6)) - (ref-end (match-end 6)) - ;; Markup part - (mp (list 'invisible 'markdown-markup - 'rear-nonsticky t - 'font-lock-multiline t)) - ;; Link part - (lp (list 'keymap markdown-mode-mouse-map - 'mouse-face 'markdown-highlight-face - 'font-lock-multiline t - 'help-echo (lambda (_ __ pos) - (save-match-data - (save-excursion - (goto-char pos) - (or (markdown-link-url) - "Undefined reference")))))) - ;; URL composition character - (url-char (markdown--first-displayable markdown-url-compose-char)) - ;; Reference part - (rp (list 'invisible 'markdown-markup - 'font-lock-multiline t))) - (dolist (g '(1 2 4 5 8)) - (when (match-end g) - (add-text-properties (match-beginning g) (match-end g) mp) - (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face))) - (when link-start - (add-text-properties link-start link-end lp) - (add-face-text-property link-start link-end 'markdown-link-face)) - (when ref-start - (add-text-properties ref-start ref-end rp) - (add-face-text-property ref-start ref-end 'markdown-reference-face) - (when (and markdown-hide-urls (> (- ref-end ref-start) 2)) - (compose-region ref-start ref-end url-char))) - t))) - -(defun markdown-fontify-angle-uris (last) - "Add text properties to angle URIs from point to LAST." - (when (markdown-match-angle-uris last) - (let* ((url-start (match-beginning 2)) - (url-end (match-end 2)) - ;; Markup part - (mp (list 'face 'markdown-markup-face - 'invisible 'markdown-markup - 'rear-nonsticky t - 'font-lock-multiline t)) - ;; URI part - (up (list 'keymap markdown-mode-mouse-map - 'face 'markdown-plain-url-face - 'mouse-face 'markdown-highlight-face - 'font-lock-multiline t))) - (dolist (g '(1 3)) - (add-text-properties (match-beginning g) (match-end g) mp)) - (add-text-properties url-start url-end up) - t))) - -(defun markdown-fontify-plain-uris (last) - "Add text properties to plain URLs from point to LAST." - (when (markdown-match-plain-uris last) - (let* ((start (match-beginning 0)) - (end (match-end 0)) - (props (list 'keymap markdown-mode-mouse-map - 'face 'markdown-plain-url-face - 'mouse-face 'markdown-highlight-face - 'rear-nonsticky t - 'font-lock-multiline t))) - (add-text-properties start end props) - t))) - -(defun markdown-toggle-url-hiding (&optional arg) - "Toggle the display or hiding of URLs. -With a prefix argument ARG, enable URL hiding if ARG is positive, -and disable it otherwise." - (interactive (list (or current-prefix-arg 'toggle))) - (setq markdown-hide-urls - (if (eq arg 'toggle) - (not markdown-hide-urls) - (> (prefix-numeric-value arg) 0))) - (when (called-interactively-p 'interactive) - (message "markdown-mode URL hiding %s" (if markdown-hide-urls "enabled" "disabled"))) - (markdown-reload-extensions)) - - -;;; Wiki Links ================================================================ - -(defun markdown-wiki-link-p () - "Return non-nil if wiki links are enabled and `point' is at a true wiki link. -A true wiki link name matches `markdown-regex-wiki-link' but does -not match the current file name after conversion. This modifies -the data returned by `match-data'. Note that the potential wiki -link name must be available via `match-string'." - (when markdown-enable-wiki-links - (let ((case-fold-search nil)) - (and (thing-at-point-looking-at markdown-regex-wiki-link) - (not (markdown-code-block-at-point-p)) - (or (not buffer-file-name) - (not (string-equal (buffer-file-name) - (markdown-convert-wiki-link-to-filename - (markdown-wiki-link-link))))))))) - -(defun markdown-wiki-link-link () - "Return the link part of the wiki link using current match data. -The location of the link component depends on the value of -`markdown-wiki-link-alias-first'." - (if markdown-wiki-link-alias-first - (or (match-string-no-properties 5) (match-string-no-properties 3)) - (match-string-no-properties 3))) - -(defun markdown-wiki-link-alias () - "Return the alias or text part of the wiki link using current match data. -The location of the alias component depends on the value of -`markdown-wiki-link-alias-first'." - (if markdown-wiki-link-alias-first - (match-string-no-properties 3) - (or (match-string-no-properties 5) (match-string-no-properties 3)))) - -(defun markdown--wiki-link-search-types () - (let ((ret (and markdown-wiki-link-search-type - (cl-copy-list markdown-wiki-link-search-type)))) - (when (and markdown-wiki-link-search-subdirectories - (not (memq 'sub-directories markdown-wiki-link-search-type))) - (push 'sub-directories ret)) - (when (and markdown-wiki-link-search-parent-directories - (not (memq 'parent-directories markdown-wiki-link-search-type))) - (push 'parent-directories ret)) - ret)) - -(defun markdown--project-root () - (or (cl-loop for dir in '(".git" ".hg" ".svn") - when (locate-dominating-file default-directory dir) - return it) - (progn - (require 'project) - (let ((project (project-current t))) - (with-no-warnings - (if (fboundp 'project-root) - (project-root project) - (car (project-roots project)))))))) - -(defun markdown-convert-wiki-link-to-filename (name) - "Generate a filename from the wiki link NAME. -Spaces in NAME are replaced with `markdown-link-space-sub-char'. -When in `gfm-mode', follow GitHub's conventions where [[Test Test]] -and [[test test]] both map to Test-test.ext. Look in the current -directory first, then in subdirectories if -`markdown-wiki-link-search-subdirectories' is non-nil, and then -in parent directories if -`markdown-wiki-link-search-parent-directories' is non-nil." - (save-match-data - ;; This function must not overwrite match data(PR #590) - (let* ((basename (replace-regexp-in-string - "[[:space:]\n]" markdown-link-space-sub-char name)) - (basename (if (derived-mode-p 'gfm-mode) - (concat (upcase (substring basename 0 1)) - (downcase (substring basename 1 nil))) - basename)) - (search-types (markdown--wiki-link-search-types)) - directory extension default candidates dir) - (when buffer-file-name - (setq directory (file-name-directory buffer-file-name) - extension (file-name-extension buffer-file-name))) - (setq default (concat basename - (when extension (concat "." extension)))) - (cond - ;; Look in current directory first. - ((or (null buffer-file-name) - (file-exists-p default)) - default) - ;; Possibly search in subdirectories, next. - ((and (memq 'sub-directories search-types) - (setq candidates - (directory-files-recursively - directory (concat "^" default "$")))) - (car candidates)) - ;; Possibly search in parent directories as a last resort. - ((and (memq 'parent-directories search-types) - (setq dir (locate-dominating-file directory default))) - (concat dir default)) - ((and (memq 'project search-types) - (setq candidates - (directory-files-recursively - (markdown--project-root) (concat "^" default "$")))) - (car candidates)) - ;; If nothing is found, return default in current directory. - (t default))))) - -(defun markdown-follow-wiki-link (name &optional other) - "Follow the wiki link NAME. -Convert the name to a file name and call `find-file'. Ensure that -the new buffer remains in `markdown-mode'. Open the link in another -window when OTHER is non-nil." - (let ((filename (markdown-convert-wiki-link-to-filename name)) - (wp (when buffer-file-name - (file-name-directory buffer-file-name)))) - (if (not wp) - (user-error "Must be visiting a file") - (when other (other-window 1)) - (let ((default-directory wp)) - (find-file filename))) - (unless (derived-mode-p 'markdown-mode) - (markdown-mode)))) - -(defun markdown-follow-wiki-link-at-point (&optional arg) - "Find Wiki Link at point. -With prefix argument ARG, open the file in other window. -See `markdown-wiki-link-p' and `markdown-follow-wiki-link'." - (interactive "P") - (if (markdown-wiki-link-p) - (markdown-follow-wiki-link (markdown-wiki-link-link) arg) - (user-error "Point is not at a Wiki Link"))) - -(defun markdown-highlight-wiki-link (from to face) - "Highlight the wiki link in the region between FROM and TO using FACE." - (put-text-property from to 'font-lock-face face)) - -(defun markdown-unfontify-region-wiki-links (from to) - "Remove wiki link faces from the region specified by FROM and TO." - (interactive "*r") - (let ((modified (buffer-modified-p))) - (remove-text-properties from to '(font-lock-face markdown-link-face)) - (remove-text-properties from to '(font-lock-face markdown-missing-link-face)) - ;; remove-text-properties marks the buffer modified in emacs 24.3, - ;; undo that if it wasn't originally marked modified - (set-buffer-modified-p modified))) - -(defun markdown-fontify-region-wiki-links (from to) - "Search region given by FROM and TO for wiki links and fontify them. -If a wiki link is found check to see if the backing file exists -and highlight accordingly." - (goto-char from) - (save-match-data - (while (re-search-forward markdown-regex-wiki-link to t) - (when (not (markdown-code-block-at-point-p)) - (let ((highlight-beginning (match-beginning 1)) - (highlight-end (match-end 1)) - (file-name - (markdown-convert-wiki-link-to-filename - (markdown-wiki-link-link)))) - (if (condition-case nil (file-exists-p file-name) (error nil)) - (markdown-highlight-wiki-link - highlight-beginning highlight-end 'markdown-link-face) - (markdown-highlight-wiki-link - highlight-beginning highlight-end 'markdown-missing-link-face))))))) - -(defun markdown-extend-changed-region (from to) - "Extend region given by FROM and TO so that we can fontify all links. -The region is extended to the first newline before and the first -newline after." - ;; start looking for the first new line before 'from - (goto-char from) - (re-search-backward "\n" nil t) - (let ((new-from (point-min)) - (new-to (point-max))) - (if (not (= (point) from)) - (setq new-from (point))) - ;; do the same thing for the first new line after 'to - (goto-char to) - (re-search-forward "\n" nil t) - (if (not (= (point) to)) - (setq new-to (point))) - (cl-values new-from new-to))) - -(defun markdown-check-change-for-wiki-link (from to) - "Check region between FROM and TO for wiki links and re-fontify as needed." - (interactive "*r") - (let* ((modified (buffer-modified-p)) - (buffer-undo-list t) - (inhibit-read-only t) - deactivate-mark - buffer-file-truename) - (unwind-protect - (save-excursion - (save-match-data - (save-restriction - (cursor-intangible-mode +1) ;; inhibit-point-motion-hooks is obsoleted since Emacs 29 - ;; Extend the region to fontify so that it starts - ;; and ends at safe places. - (cl-multiple-value-bind (new-from new-to) - (markdown-extend-changed-region from to) - (goto-char new-from) - ;; Only refontify when the range contains text with a - ;; wiki link face or if the wiki link regexp matches. - (when (or (markdown-range-property-any - new-from new-to 'font-lock-face - '(markdown-link-face markdown-missing-link-face)) - (re-search-forward - markdown-regex-wiki-link new-to t)) - ;; Unfontify existing fontification (start from scratch) - (markdown-unfontify-region-wiki-links new-from new-to) - ;; Now do the fontification. - (markdown-fontify-region-wiki-links new-from new-to)))))) - (cursor-intangible-mode -1) - (and (not modified) - (buffer-modified-p) - (set-buffer-modified-p nil))))) - -(defun markdown-check-change-for-wiki-link-after-change (from to _) - "Check region between FROM and TO for wiki links and re-fontify as needed. -Designed to be used with the `after-change-functions' hook." - (markdown-check-change-for-wiki-link from to)) - -(defun markdown-fontify-buffer-wiki-links () - "Refontify all wiki links in the buffer." - (interactive) - (markdown-check-change-for-wiki-link (point-min) (point-max))) - -(defun markdown-toggle-wiki-links (&optional arg) - "Toggle support for wiki links. -With a prefix argument ARG, enable wiki link support if ARG is positive, -and disable it otherwise." - (interactive (list (or current-prefix-arg 'toggle))) - (setq markdown-enable-wiki-links - (if (eq arg 'toggle) - (not markdown-enable-wiki-links) - (> (prefix-numeric-value arg) 0))) - (when (called-interactively-p 'interactive) - (message "markdown-mode wiki link support %s" (if markdown-enable-wiki-links "enabled" "disabled"))) - (markdown-reload-extensions)) - -(defun markdown-setup-wiki-link-hooks () - "Add or remove hooks for fontifying wiki links. -These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil." - ;; Anytime text changes make sure it gets fontified correctly - (if (and markdown-enable-wiki-links - markdown-wiki-link-fontify-missing) - (add-hook 'after-change-functions - #'markdown-check-change-for-wiki-link-after-change t t) - (remove-hook 'after-change-functions - #'markdown-check-change-for-wiki-link-after-change t)) - ;; If we left the buffer there is a really good chance we were - ;; creating one of the wiki link documents. Make sure we get - ;; refontified when we come back. - (if (and markdown-enable-wiki-links - markdown-wiki-link-fontify-missing) - (progn - (add-hook 'window-configuration-change-hook - #'markdown-fontify-buffer-wiki-links t t) - (markdown-fontify-buffer-wiki-links)) - (remove-hook 'window-configuration-change-hook - #'markdown-fontify-buffer-wiki-links t) - (markdown-unfontify-region-wiki-links (point-min) (point-max)))) - - -;;; Following & Doing ========================================================= - -(defun markdown-follow-thing-at-point (arg) - "Follow thing at point if possible, such as a reference link or wiki link. -Opens inline and reference links in a browser. Opens wiki links -to other files in the current window, or the another window if -ARG is non-nil. -See `markdown-follow-link-at-point' and -`markdown-follow-wiki-link-at-point'." - (interactive "P") - (cond ((markdown-link-p) - (markdown-follow-link-at-point)) - ((markdown-wiki-link-p) - (markdown-follow-wiki-link-at-point arg)) - (t - (let* ((values (markdown-link-at-pos (point))) - (url (nth 3 values))) - (unless url - (user-error "Nothing to follow at point")) - (markdown--browse-url url))))) - -(defun markdown-do () - "Do something sensible based on context at point. -Jumps between reference links and definitions; between footnote -markers and footnote text." - (interactive) - (cond - ;; Footnote definition - ((markdown-footnote-text-positions) - (markdown-footnote-return)) - ;; Footnote marker - ((markdown-footnote-marker-positions) - (markdown-footnote-goto-text)) - ;; Reference link - ((thing-at-point-looking-at markdown-regex-link-reference) - (markdown-reference-goto-definition)) - ;; Reference definition - ((thing-at-point-looking-at markdown-regex-reference-definition) - (markdown-reference-goto-link (match-string-no-properties 2))) - ;; Link - ((or (markdown-link-p) (markdown-wiki-link-p)) - (markdown-follow-thing-at-point nil)) - ;; GFM task list item - ((markdown-gfm-task-list-item-at-point) - (markdown-toggle-gfm-checkbox)) - ;; Align table - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-align)) - ;; Otherwise - (t - (markdown-insert-gfm-checkbox)))) - - -;;; Miscellaneous ============================================================= - -(defun markdown-compress-whitespace-string (str) - "Compress whitespace in STR and return result. -Leading and trailing whitespace is removed. Sequences of multiple -spaces, tabs, and newlines are replaced with single spaces." - (replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" "" - (replace-regexp-in-string "[ \t\n]+" " " str))) - -(defun markdown--substitute-command-keys (string) - "Like `substitute-command-keys' but, but prefers control characters. -First pass STRING to `substitute-command-keys' and then -substitute `C-i` for `TAB` and `C-m` for `RET`." - (replace-regexp-in-string - "\\<TAB\\>" "C-i" - (replace-regexp-in-string - "\\<RET\\>" "C-m" (substitute-command-keys string) t) t)) - -(defun markdown-line-number-at-pos (&optional pos) - "Return (narrowed) buffer line number at position POS. -If POS is nil, use current buffer location. -This is an exact copy of `line-number-at-pos' for use in emacs21." - (let ((opoint (or pos (point))) start) - (save-excursion - (goto-char (point-min)) - (setq start (point)) - (goto-char opoint) - (forward-line 0) - (1+ (count-lines start (point)))))) - -(defun markdown-inside-link-p () - "Return t if point is within a link." - (save-match-data - (thing-at-point-looking-at (markdown-make-regex-link-generic)))) - -(defun markdown-line-is-reference-definition-p () - "Return whether the current line is a (non-footnote) reference definition." - (save-excursion - (move-beginning-of-line 1) - (and (looking-at-p markdown-regex-reference-definition) - (not (looking-at-p "[ \t]*\\[^"))))) - -(defun markdown-adaptive-fill-function () - "Return prefix for filling paragraph or nil if not determined." - (cond - ;; List item inside blockquote - ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+") - (replace-regexp-in-string - "[0-9\\.*+-]" " " (match-string-no-properties 0))) - ;; Blockquote - ((looking-at markdown-regex-blockquote) - (buffer-substring-no-properties (match-beginning 0) (match-end 2))) - ;; List items - ((looking-at markdown-regex-list) - (match-string-no-properties 0)) - ;; Footnote definition - ((looking-at-p markdown-regex-footnote-definition) - " ") ; four spaces - ;; No match - (t nil))) - -(defun markdown-fill-paragraph (&optional justify) - "Fill paragraph at or after point. -This function is like \\[fill-paragraph], but it skips Markdown -code blocks. If the point is in a code block, or just before one, -do not fill. Otherwise, call `fill-paragraph' as usual. If -JUSTIFY is non-nil, justify text as well. Since this function -handles filling itself, it always returns t so that -`fill-paragraph' doesn't run." - (interactive "P") - (unless (or (markdown-code-block-at-point-p) - (save-excursion - (back-to-indentation) - (skip-syntax-forward "-") - (markdown-code-block-at-point-p))) - (let ((fill-prefix (save-excursion - (goto-char (line-beginning-position)) - (when (looking-at "\\([ \t]*>[ \t]*\\(?:>[ \t]*\\)+\\)") - (match-string-no-properties 1))))) - (fill-paragraph justify))) - t) - -(defun markdown-fill-forward-paragraph (&optional arg) - "Function used by `fill-paragraph' to move over ARG paragraphs. -This is a `fill-forward-paragraph-function' for `markdown-mode'. -It is called with a single argument specifying the number of -paragraphs to move. Just like `forward-paragraph', it should -return the number of paragraphs left to move." - (or arg (setq arg 1)) - (if (> arg 0) - ;; With positive ARG, move across ARG non-code-block paragraphs, - ;; one at a time. When passing a code block, don't decrement ARG. - (while (and (not (eobp)) - (> arg 0) - (= (forward-paragraph 1) 0) - (or (markdown-code-block-at-pos (line-beginning-position 0)) - (setq arg (1- arg))))) - ;; Move backward by one paragraph with negative ARG (always -1). - (let ((start (point))) - (setq arg (forward-paragraph arg)) - (while (and (not (eobp)) - (progn (move-to-left-margin) (not (eobp))) - (looking-at-p paragraph-separate)) - (forward-line 1)) - (cond - ;; Move point past whitespace following list marker. - ((looking-at markdown-regex-list) - (goto-char (match-end 0))) - ;; Move point past whitespace following pipe at beginning of line - ;; to handle Pandoc line blocks. - ((looking-at "^|\\s-*") - (goto-char (match-end 0))) - ;; Return point if the paragraph passed was a code block. - ((markdown-code-block-at-pos (line-beginning-position 2)) - (goto-char start))))) - arg) - -(defun markdown--inhibit-electric-quote () - "Function added to `electric-quote-inhibit-functions'. -Return non-nil if the quote has been inserted inside a code block -or span." - (let ((pos (1- (point)))) - (or (markdown-inline-code-at-pos pos) - (markdown-code-block-at-pos pos)))) - - -;;; Extension Framework ======================================================= - -(defun markdown-reload-extensions () - "Check settings, update font-lock keywords and hooks, and re-fontify buffer." - (interactive) - (when (derived-mode-p 'markdown-mode) - ;; Refontify buffer - (font-lock-flush) - ;; Add or remove hooks related to extensions - (markdown-setup-wiki-link-hooks))) - -(defun markdown-handle-local-variables () - "Run in `hack-local-variables-hook' to update font lock rules. -Checks to see if there is actually a ‘markdown-mode’ file local variable -before regenerating font-lock rules for extensions." - (when (or (assoc 'markdown-enable-wiki-links file-local-variables-alist) - (assoc 'markdown-enable-math file-local-variables-alist)) - (when (assoc 'markdown-enable-math file-local-variables-alist) - (markdown-toggle-math markdown-enable-math)) - (markdown-reload-extensions))) - - -;;; Math Support ============================================================== - -(defconst markdown-mode-font-lock-keywords-math - (list - ;; Equation reference (eq:foo) - '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" . ((1 markdown-markup-face) - (2 markdown-reference-face) - (3 markdown-markup-face))) - ;; Equation reference \eqref{foo} - '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" . ((1 markdown-markup-face) - (2 markdown-reference-face) - (3 markdown-markup-face)))) - "Font lock keywords to add and remove when toggling math support.") - -(defun markdown-toggle-math (&optional arg) - "Toggle support for inline and display LaTeX math expressions. -With a prefix argument ARG, enable math mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." - (interactive (list (or current-prefix-arg 'toggle))) - (setq markdown-enable-math - (if (eq arg 'toggle) - (not markdown-enable-math) - (> (prefix-numeric-value arg) 0))) - (if markdown-enable-math - (font-lock-add-keywords - 'markdown-mode markdown-mode-font-lock-keywords-math) - (font-lock-remove-keywords - 'markdown-mode markdown-mode-font-lock-keywords-math)) - (when (called-interactively-p 'interactive) - (message "markdown-mode math support %s" (if markdown-enable-math "enabled" "disabled"))) - (markdown-reload-extensions)) - - -;;; GFM Checkboxes ============================================================ - -(define-button-type 'markdown-gfm-checkbox-button - 'follow-link t - 'face 'markdown-gfm-checkbox-face - 'mouse-face 'markdown-highlight-face - 'action #'markdown-toggle-gfm-checkbox-button) - -(defun markdown-gfm-task-list-item-at-point (&optional bounds) - "Return non-nil if there is a GFM task list item at the point. -Optionally, the list item BOUNDS may be given if available, as -returned by `markdown-cur-list-item-bounds'. When a task list item -is found, the return value is the same value returned by -`markdown-cur-list-item-bounds'." - (unless bounds - (setq bounds (markdown-cur-list-item-bounds))) - (> (length (nth 5 bounds)) 0)) - -(defun markdown-insert-gfm-checkbox () - "Add GFM checkbox at point. -Returns t if added. -Returns nil if non-applicable." - (interactive) - (let ((bounds (markdown-cur-list-item-bounds))) - (if bounds - (unless (cl-sixth bounds) - (let ((pos (+ (cl-first bounds) (cl-fourth bounds))) - (markup "[ ] ")) - (if (< pos (point)) - (save-excursion - (goto-char pos) - (insert markup)) - (goto-char pos) - (insert markup)) - (syntax-propertize (+ (cl-second bounds) 4)) - t)) - (unless (save-excursion - (back-to-indentation) - (or (markdown-list-item-at-point-p) - (markdown-heading-at-point) - (markdown-in-comment-p) - (markdown-code-block-at-point-p))) - (let ((pos (save-excursion - (back-to-indentation) - (point))) - (markup (concat (or (save-excursion - (beginning-of-line 0) - (cl-fifth (markdown-cur-list-item-bounds))) - markdown-unordered-list-item-prefix) - "[ ] "))) - (if (< pos (point)) - (save-excursion - (goto-char pos) - (insert markup)) - (goto-char pos) - (insert markup)) - (syntax-propertize (line-end-position)) - t))))) - -(defun markdown-toggle-gfm-checkbox () - "Toggle GFM checkbox at point. -Returns the resulting status as a string, either \"[x]\" or \"[ ]\". -Returns nil if there is no task list item at the point." - (interactive) - (save-match-data - (save-excursion - (let ((bounds (markdown-cur-list-item-bounds))) - (when bounds - ;; Move to beginning of task list item - (goto-char (cl-first bounds)) - ;; Advance to column of first non-whitespace after marker - (forward-char (cl-fourth bounds)) - (cond ((looking-at "\\[ \\]") - (replace-match - (if markdown-gfm-uppercase-checkbox "[X]" "[x]") - nil t) - (match-string-no-properties 0)) - ((looking-at "\\[[xX]\\]") - (replace-match "[ ]" nil t) - (match-string-no-properties 0)))))))) - -(defun markdown-toggle-gfm-checkbox-button (button) - "Toggle GFM checkbox BUTTON on click." - (save-match-data - (save-excursion - (goto-char (button-start button)) - (markdown-toggle-gfm-checkbox)))) - -(defun markdown-make-gfm-checkboxes-buttons (start end) - "Make GFM checkboxes buttons in region between START and END." - (save-excursion - (goto-char start) - (let ((case-fold-search t)) - (save-excursion - (while (re-search-forward markdown-regex-gfm-checkbox end t) - (make-button (match-beginning 1) (match-end 1) - :type 'markdown-gfm-checkbox-button)))))) - -;; Called when any modification is made to buffer text. -(defun markdown-gfm-checkbox-after-change-function (beg end _) - "Add to `after-change-functions' to setup GFM checkboxes as buttons. -BEG and END are the limits of scanned region." - (save-excursion - (save-match-data - ;; Rescan between start of line from `beg' and start of line after `end'. - (markdown-make-gfm-checkboxes-buttons - (progn (goto-char beg) (beginning-of-line) (point)) - (progn (goto-char end) (forward-line 1) (point)))))) - -(defun markdown-remove-gfm-checkbox-overlays () - "Remove all GFM checkbox overlays in buffer." - (save-excursion - (save-restriction - (widen) - (remove-overlays nil nil 'face 'markdown-gfm-checkbox-face)))) - - -;;; Display inline image ====================================================== - -(defvar-local markdown-inline-image-overlays nil) - -(defun markdown-remove-inline-images () - "Remove inline image overlays from image links in the buffer. -This can be toggled with `markdown-toggle-inline-images' -or \\[markdown-toggle-inline-images]." - (interactive) - (mapc #'delete-overlay markdown-inline-image-overlays) - (setq markdown-inline-image-overlays nil) - (when (fboundp 'clear-image-cache) (clear-image-cache))) - -(defcustom markdown-display-remote-images nil - "If non-nil, download and display remote images. -See also `markdown-inline-image-overlays'. - -Only image URLs specified with a protocol listed in -`markdown-remote-image-protocols' are displayed." - :group 'markdown - :type 'boolean) - -(defcustom markdown-remote-image-protocols '("https") - "List of protocols to use to download remote images. -See also `markdown-display-remote-images'." - :group 'markdown - :type '(repeat string)) - -(defvar markdown--remote-image-cache - (make-hash-table :test 'equal) - "A map from URLs to image paths.") - -(defun markdown--get-remote-image (url) - "Retrieve the image path for a given URL." - (or (gethash url markdown--remote-image-cache) - (let ((dl-path (make-temp-file "markdown-mode--image"))) - (require 'url) - (url-copy-file url dl-path t) - (puthash url dl-path markdown--remote-image-cache)))) - -(defun markdown-display-inline-images () - "Add inline image overlays to image links in the buffer. -This can be toggled with `markdown-toggle-inline-images' -or \\[markdown-toggle-inline-images]." - (interactive) - (unless (display-images-p) - (error "Cannot show images")) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward markdown-regex-link-inline nil t) - (let* ((start (match-beginning 0)) - (imagep (match-beginning 1)) - (end (match-end 0)) - (file (match-string-no-properties 6))) - (when (and imagep - (not (zerop (length file)))) - (unless (file-exists-p file) - (let* ((download-file (funcall markdown-translate-filename-function file)) - (valid-url (ignore-errors - (member (downcase (url-type (url-generic-parse-url download-file))) - markdown-remote-image-protocols)))) - (if (and markdown-display-remote-images valid-url) - (setq file (markdown--get-remote-image download-file)) - (when (not valid-url) - ;; strip query parameter - (setq file (replace-regexp-in-string "?.+\\'" "" file)) - (unless (file-exists-p file) - (setq file (url-unhex-string file))))))) - (when (file-exists-p file) - (let* ((abspath (if (file-name-absolute-p file) - file - (concat default-directory file))) - (image - (cond ((and markdown-max-image-size - (image-type-available-p 'imagemagick)) - (create-image - abspath 'imagemagick nil - :max-width (car markdown-max-image-size) - :max-height (cdr markdown-max-image-size))) - (markdown-max-image-size - (create-image abspath nil nil - :max-width (car markdown-max-image-size) - :max-height (cdr markdown-max-image-size))) - (t (create-image abspath))))) - (when image - (let ((ov (make-overlay start end))) - (overlay-put ov 'display image) - (overlay-put ov 'face 'default) - (push ov markdown-inline-image-overlays))))))))))) - -(defun markdown-toggle-inline-images () - "Toggle inline image overlays in the buffer." - (interactive) - (if markdown-inline-image-overlays - (markdown-remove-inline-images) - (markdown-display-inline-images))) - - -;;; GFM Code Block Fontification ============================================== - -(defcustom markdown-fontify-code-blocks-natively nil - "When non-nil, fontify code in code blocks using the native major mode. -This only works for fenced code blocks where the language is -specified where we can automatically determine the appropriate -mode to use. The language to mode mapping may be customized by -setting the variable `markdown-code-lang-modes'." - :group 'markdown - :type 'boolean - :safe #'booleanp - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-fontify-code-block-default-mode nil - "Default mode to use to fontify code blocks. -This mode is used when automatic detection fails, such as for GFM -code blocks with no language specified." - :group 'markdown - :type '(choice function (const :tag "None" nil)) - :package-version '(markdown-mode . "2.4")) - -(defun markdown-toggle-fontify-code-blocks-natively (&optional arg) - "Toggle the native fontification of code blocks. -With a prefix argument ARG, enable if ARG is positive, -and disable otherwise." - (interactive (list (or current-prefix-arg 'toggle))) - (setq markdown-fontify-code-blocks-natively - (if (eq arg 'toggle) - (not markdown-fontify-code-blocks-natively) - (> (prefix-numeric-value arg) 0))) - (when (called-interactively-p 'interactive) - (message "markdown-mode native code block fontification %s" - (if markdown-fontify-code-blocks-natively "enabled" "disabled"))) - (markdown-reload-extensions)) - -;; This is based on `org-src-lang-modes' from org-src.el -(defcustom markdown-code-lang-modes - '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode) - ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode) - ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode) - ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode) - ("bash" . sh-mode)) - "Alist mapping languages to their major mode. -The key is the language name, the value is the major mode. For -many languages this is simple, but for language where this is not -the case, this variable provides a way to simplify things on the -user side. For example, there is no ocaml-mode in Emacs, but the -mode to use is `tuareg-mode'." - :group 'markdown - :type '(repeat - (cons - (string "Language name") - (symbol "Major mode"))) - :package-version '(markdown-mode . "2.3")) - -(defun markdown-get-lang-mode (lang) - "Return major mode that should be used for LANG. -LANG is a string, and the returned major mode is a symbol." - (cl-find-if - #'markdown--lang-mode-predicate - (nconc (list (cdr (assoc lang markdown-code-lang-modes)) - (cdr (assoc (downcase lang) markdown-code-lang-modes))) - (and (fboundp 'treesit-language-available-p) - (list (and (treesit-language-available-p (intern lang)) - (intern (concat lang "-ts-mode"))) - (and (treesit-language-available-p (intern (downcase lang))) - (intern (concat (downcase lang) "-ts-mode"))))) - (list - (intern (concat lang "-mode")) - (intern (concat (downcase lang) "-mode")))))) - -(defun markdown--lang-mode-predicate (mode) - (and mode - (fboundp mode) - (or - ;; https://github.com/jrblevin/markdown-mode/issues/787 - ;; major-mode-remap-alist was introduced at Emacs 29.1 - (cl-loop for pair in (bound-and-true-p major-mode-remap-alist) - for func = (cdr pair) - thereis (and (atom func) (eq mode func))) - ;; https://github.com/jrblevin/markdown-mode/issues/761 - (cl-loop for pair in auto-mode-alist - for func = (cdr pair) - thereis (and (atom func) (eq mode func)))))) - -(defun markdown-fontify-code-blocks-generic (matcher last) - "Add text properties to next code block from point to LAST. -Use matching function MATCHER." - (when (funcall matcher last) - (save-excursion - (save-match-data - (let* ((start (match-beginning 0)) - (end (match-end 0)) - ;; Find positions outside opening and closing backquotes. - (bol-prev (progn (goto-char start) - (if (bolp) (line-beginning-position 0) (line-beginning-position)))) - (eol-next (progn (goto-char end) - (if (bolp) (line-beginning-position 2) (line-beginning-position 3)))) - lang) - (if (and markdown-fontify-code-blocks-natively - (or (setq lang (markdown-code-block-lang)) - markdown-fontify-code-block-default-mode)) - (markdown-fontify-code-block-natively lang start end) - (add-text-properties start end '(face markdown-pre-face))) - ;; Set background for block as well as opening and closing lines. - (font-lock-append-text-property - bol-prev eol-next 'face 'markdown-code-face) - ;; Set invisible property for lines before and after, including newline. - (add-text-properties bol-prev start '(invisible markdown-markup)) - (add-text-properties end eol-next '(invisible markdown-markup))))) - t)) - -(defun markdown-fontify-gfm-code-blocks (last) - "Add text properties to next GFM code block from point to LAST." - (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last)) - -(defun markdown-fontify-fenced-code-blocks (last) - "Add text properties to next tilde fenced code block from point to LAST." - (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last)) - -;; Based on `org-src-font-lock-fontify-block' from org-src.el. -(defun markdown-fontify-code-block-natively (lang start end) - "Fontify given GFM or fenced code block. -This function is called by Emacs for automatic fontification when -`markdown-fontify-code-blocks-natively' is non-nil. LANG is the -language used in the block. START and END specify the block -position." - (let ((lang-mode (if lang (markdown-get-lang-mode lang) - markdown-fontify-code-block-default-mode))) - (when (fboundp lang-mode) - (let ((string (buffer-substring-no-properties start end)) - (modified (buffer-modified-p)) - (markdown-buffer (current-buffer)) pos next) - (remove-text-properties start end '(face nil)) - (with-current-buffer - (get-buffer-create - (format " *markdown-code-fontification:%s*" (symbol-name lang-mode))) - ;; Make sure that modification hooks are not inhibited in - ;; the org-src-fontification buffer in case we're called - ;; from `jit-lock-function' (Bug#25132). - (let ((inhibit-modification-hooks nil)) - (delete-region (point-min) (point-max)) - (insert string " ")) ;; so there's a final property change - (unless (eq major-mode lang-mode) (funcall lang-mode)) - (font-lock-ensure) - (setq pos (point-min)) - (while (setq next (next-single-property-change pos 'face)) - (let ((val (get-text-property pos 'face))) - (when val - (put-text-property - (+ start (1- pos)) (1- (+ start next)) 'face - val markdown-buffer))) - (setq pos next))) - (add-text-properties - start end - '(font-lock-fontified t fontified t font-lock-multiline t)) - (set-buffer-modified-p modified))))) - -(require 'edit-indirect nil t) -(defvar edit-indirect-guess-mode-function) -(defvar edit-indirect-after-commit-functions) - -(defun markdown--edit-indirect-after-commit-function (beg end) - "Corrective logic run on code block content from lines BEG to END. -Restores code block indentation from BEG to END, and ensures trailing newlines -at the END of code blocks." - ;; ensure trailing newlines - (goto-char end) - (unless (eq (char-before) ?\n) - (insert "\n")) - ;; restore code block indentation - (goto-char (- beg 1)) - (let ((block-indentation (current-indentation))) - (when (> block-indentation 0) - (indent-rigidly beg end block-indentation))) - (font-lock-ensure)) - -(defun markdown-edit-code-block () - "Edit Markdown code block in an indirect buffer." - (interactive) - (save-excursion - (if (fboundp 'edit-indirect-region) - (let* ((bounds (markdown-get-enclosing-fenced-block-construct)) - (begin (and bounds (not (null (nth 0 bounds))) (goto-char (nth 0 bounds)) (line-beginning-position 2))) - (end (and bounds(not (null (nth 1 bounds))) (goto-char (nth 1 bounds)) (line-beginning-position 1)))) - (if (and begin end) - (let* ((indentation (and (goto-char (nth 0 bounds)) (current-indentation))) - (lang (markdown-code-block-lang)) - (mode (or (and lang (markdown-get-lang-mode lang)) - markdown-edit-code-block-default-mode)) - (edit-indirect-guess-mode-function - (lambda (_parent-buffer _beg _end) - (funcall mode))) - (indirect-buf (edit-indirect-region begin end 'display-buffer))) - ;; reset `sh-shell' when indirect buffer - (when (and (not (member system-type '(ms-dos windows-nt))) - (member mode '(shell-script-mode sh-mode)) - (member lang (append - (mapcar (lambda (e) (symbol-name (car e))) - sh-ancestor-alist) - '("csh" "rc" "sh")))) - (with-current-buffer indirect-buf - (sh-set-shell lang))) - (when (> indentation 0) ;; un-indent in edit-indirect buffer - (with-current-buffer indirect-buf - (indent-rigidly (point-min) (point-max) (- indentation))))) - (user-error "Not inside a GFM or tilde fenced code block"))) - (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ") - (progn (package-refresh-contents) - (package-install 'edit-indirect) - (markdown-edit-code-block)))))) - - -;;; Table Editing ============================================================= - -;; These functions were originally adapted from `org-table.el'. - -;; General helper functions - -(defmacro markdown--with-gensyms (symbols &rest body) - (declare (debug (sexp body)) (indent 1)) - `(let ,(mapcar (lambda (s) - `(,s (make-symbol (concat "--" (symbol-name ',s))))) - symbols) - ,@body)) - -(defun markdown--split-string (string &optional separators) - "Splits STRING into substrings at SEPARATORS. -SEPARATORS is a regular expression. If nil it defaults to -`split-string-default-separators'. This version returns no empty -strings if there are matches at the beginning and end of string." - (let ((start 0) notfirst list) - (while (and (string-match - (or separators split-string-default-separators) - string - (if (and notfirst - (= start (match-beginning 0)) - (< start (length string))) - (1+ start) start)) - (< (match-beginning 0) (length string))) - (setq notfirst t) - (or (eq (match-beginning 0) 0) - (and (eq (match-beginning 0) (match-end 0)) - (eq (match-beginning 0) start)) - (push (substring string start (match-beginning 0)) list)) - (setq start (match-end 0))) - (or (eq start (length string)) - (push (substring string start) list)) - (nreverse list))) - -(defun markdown--string-width (s) - "Return width of string S. -This version ignores characters with invisibility property -`markdown-markup'." - (let (b) - (when (or (eq t buffer-invisibility-spec) - (member 'markdown-markup buffer-invisibility-spec)) - (while (setq b (text-property-any - 0 (length s) - 'invisible 'markdown-markup s)) - (setq s (concat - (substring s 0 b) - (substring s (or (next-single-property-change - b 'invisible s) - (length s)))))))) - (string-width s)) - -(defun markdown--remove-invisible-markup (s) - "Remove Markdown markup from string S. -This version removes characters with invisibility property -`markdown-markup'." - (let (b) - (while (setq b (text-property-any - 0 (length s) - 'invisible 'markdown-markup s)) - (setq s (concat - (substring s 0 b) - (substring s (or (next-single-property-change - b 'invisible s) - (length s))))))) - s) - -;; Functions for maintaining tables - -(defvar markdown-table-at-point-p-function #'markdown--table-at-point-p - "Function to decide if point is inside a table. - -The indirection serves to differentiate between standard markdown -tables and gfm tables which are less strict about the markup.") - -(defconst markdown-table-line-regexp "^[ \t]*|" - "Regexp matching any line inside a table.") - -(defconst markdown-table-hline-regexp "^[ \t]*|[-:]" - "Regexp matching hline inside a table.") - -(defconst markdown-table-dline-regexp "^[ \t]*|[^-:]" - "Regexp matching dline inside a table.") - -(defun markdown-table-at-point-p () - "Return non-nil when point is inside a table." - (funcall markdown-table-at-point-p-function)) - -(defun markdown--table-at-point-p () - "Return non-nil when point is inside a table." - (save-excursion - (beginning-of-line) - (and (looking-at-p markdown-table-line-regexp) - (not (markdown-code-block-at-point-p))))) - -(defconst gfm-table-line-regexp "^.?*|" - "Regexp matching any line inside a table.") - -(defconst gfm-table-hline-regexp "^-+\\(|-\\)+" - "Regexp matching hline inside a table.") - -;; GFM simplified tables syntax is as follows: -;; - A header line for the column names, this is any text -;; separated by `|'. -;; - Followed by a string -|-|- ..., the number of dashes is optional -;; but must be higher than 1. The number of separators should match -;; the number of columns. -;; - Followed by the rows of data, which has the same format as the -;; header line. -;; Example: -;; -;; foo | bar -;; ------|--------- -;; bar | baz -;; bar | baz -(defun gfm--table-at-point-p () - "Return non-nil when point is inside a gfm-compatible table." - (or (markdown--table-at-point-p) - (save-excursion - (beginning-of-line) - (when (looking-at-p gfm-table-line-regexp) - ;; we might be at the first line of the table, check if the - ;; line below is the hline - (or (save-excursion - (forward-line 1) - (looking-at-p gfm-table-hline-regexp)) - ;; go up to find the header - (catch 'done - (while (looking-at-p gfm-table-line-regexp) - (cond - ((looking-at-p gfm-table-hline-regexp) - (throw 'done t)) - ((bobp) - (throw 'done nil))) - (forward-line -1)) - nil)))))) - -(defun markdown-table-hline-at-point-p () - "Return non-nil when point is on a hline in a table. -This function assumes point is on a table." - (save-excursion - (beginning-of-line) - (looking-at-p markdown-table-hline-regexp))) - -(defun markdown-table-begin () - "Find the beginning of the table and return its position. -This function assumes point is on a table." - (save-excursion - (while (and (not (bobp)) - (markdown-table-at-point-p)) - (forward-line -1)) - (unless (or (eobp) - (markdown-table-at-point-p)) - (forward-line 1)) - (point))) - -(defun markdown-table-end () - "Find the end of the table and return its position. -This function assumes point is on a table." - (save-excursion - (while (and (not (eobp)) - (markdown-table-at-point-p)) - (forward-line 1)) - (point))) - -(defun markdown-table-get-dline () - "Return index of the table data line at point. -This function assumes point is on a table." - (let ((pos (point)) (end (markdown-table-end)) (cnt 0)) - (save-excursion - (goto-char (markdown-table-begin)) - (while (and (re-search-forward - markdown-table-dline-regexp end t) - (setq cnt (1+ cnt)) - (< (line-end-position) pos)))) - cnt)) - -(defun markdown--thing-at-wiki-link (pos) - (when markdown-enable-wiki-links - (save-excursion - (save-match-data - (goto-char pos) - (thing-at-point-looking-at markdown-regex-wiki-link))))) - -(defun markdown-table-get-column () - "Return table column at point. -This function assumes point is on a table." - (let ((pos (point)) (cnt 0)) - (save-excursion - (beginning-of-line) - (while (search-forward "|" pos t) - (when (and (not (looking-back "\\\\|" (line-beginning-position))) - (not (markdown--thing-at-wiki-link (match-beginning 0)))) - (setq cnt (1+ cnt))))) - cnt)) - -(defun markdown-table-get-cell (&optional n) - "Return the content of the cell in column N of current row. -N defaults to column at point. This function assumes point is on -a table." - (and n (markdown-table-goto-column n)) - (skip-chars-backward "^|\n") (backward-char 1) - (if (looking-at "|[^|\r\n]*") - (let* ((pos (match-beginning 0)) - (val (buffer-substring (1+ pos) (match-end 0)))) - (goto-char (min (line-end-position) (+ 2 pos))) - ;; Trim whitespaces - (setq val (replace-regexp-in-string "\\`[ \t]+" "" val) - val (replace-regexp-in-string "[ \t]+\\'" "" val))) - (forward-char 1) "")) - -(defun markdown-table-goto-dline (n) - "Go to the Nth data line in the table at point. -Return t when the line exists, nil otherwise. This function -assumes point is on a table." - (goto-char (markdown-table-begin)) - (let ((end (markdown-table-end)) (cnt 0)) - (while (and (re-search-forward - markdown-table-dline-regexp end t) - (< (setq cnt (1+ cnt)) n))) - (= cnt n))) - -(defun markdown-table-goto-column (n &optional on-delim) - "Go to the Nth column in the table line at point. -With optional argument ON-DELIM, stop with point before the left -delimiter of the cell. If there are less than N cells, just go -beyond the last delimiter. This function assumes point is on a -table." - (beginning-of-line 1) - (when (> n 0) - (while (and (> n 0) (search-forward "|" (line-end-position) t)) - (when (and (not (looking-back "\\\\|" (line-beginning-position))) - (not (markdown--thing-at-wiki-link (match-beginning 0)))) - (cl-decf n))) - (if on-delim - (backward-char 1) - (when (looking-at " ") (forward-char 1))))) - -(defmacro markdown-table-save-cell (&rest body) - "Save cell at point, execute BODY and restore cell. -This function assumes point is on a table." - (declare (debug (body))) - (markdown--with-gensyms (line column) - `(let ((,line (copy-marker (line-beginning-position))) - (,column (markdown-table-get-column))) - (unwind-protect - (progn ,@body) - (goto-char ,line) - (markdown-table-goto-column ,column) - (set-marker ,line nil))))) - -(defun markdown-table-blank-line (s) - "Convert a table line S into a line with blank cells." - (if (string-match "^[ \t]*|-" s) - (setq s (mapconcat - (lambda (x) (if (member x '(?| ?+)) "|" " ")) - s "")) - (with-temp-buffer - (insert s) - (goto-char (point-min)) - (when (re-search-forward "|" nil t) - (let ((cur (point)) - ret) - (while (re-search-forward "|" nil t) - (when (and (not (eql (char-before (match-beginning 0)) ?\\)) - (not (markdown--thing-at-wiki-link (match-beginning 0)))) - (push (make-string (- (match-beginning 0) cur) ? ) ret) - (setq cur (match-end 0)))) - (format "|%s|" (string-join (nreverse ret) "|"))))))) - -(defun markdown-table-colfmt (fmtspec) - "Process column alignment specifier FMTSPEC for tables." - (when (stringp fmtspec) - (mapcar (lambda (x) - (cond ((string-match-p "^:.*:$" x) 'c) - ((string-match-p "^:" x) 'l) - ((string-match-p ":$" x) 'r) - (t 'd))) - (markdown--split-string fmtspec "\\s-*|\\s-*")))) - -(defun markdown--first-column-p (bar-pos) - (save-excursion - (save-match-data - (goto-char bar-pos) - (looking-back "^\\s-*" (line-beginning-position))))) - -(defun markdown--table-line-to-columns (line) - (with-temp-buffer - (insert line) - (goto-char (point-min)) - (let ((cur (point)) - ret) - (while (and (re-search-forward "\\s-*\\(|\\)\\s-*" nil t)) - (when (not (markdown--face-p (match-beginning 1) '(markdown-inline-code-face))) - (if (markdown--first-column-p (match-beginning 1)) - (setq cur (match-end 0)) - (cond ((eql (char-before (match-beginning 1)) ?\\) - ;; keep spaces - (goto-char (match-end 1))) - ((markdown--thing-at-wiki-link (match-beginning 1))) ;; do nothing - (t - (push (buffer-substring-no-properties cur (match-beginning 0)) ret) - (setq cur (match-end 0))))))) - (when (< cur (length line)) - (push (buffer-substring-no-properties cur (point-max)) ret)) - (nreverse ret)))) - -(defsubst markdown--is-delimiter-row (line) - (and (string-match-p "\\`[ \t]*|[ \t]*[-:]" line) - (cl-loop for c across line - always (member c '(?| ?- ?: ?\t ? ))))) - -(defun markdown-table-align () - "Align table at point. -This function assumes point is on a table." - (interactive) - (let ((begin (markdown-table-begin)) - (end (copy-marker (markdown-table-end)))) - (markdown-table-save-cell - (goto-char begin) - (let* (fmtspec - ;; Store table indent - (indent (progn (looking-at "[ \t]*") (match-string 0))) - ;; Split table in lines and save column format specifier - (lines (mapcar (lambda (line) - (if (markdown--is-delimiter-row line) - (progn (setq fmtspec (or fmtspec line)) nil) - line)) - (markdown--split-string (buffer-substring begin end) "\n"))) - ;; Split lines in cells - (cells (mapcar (lambda (l) (markdown--table-line-to-columns l)) - (remq nil lines))) - ;; Calculate maximum number of cells in a line - (maxcells (if cells - (apply #'max (mapcar #'length cells)) - (user-error "Empty table"))) - ;; Empty cells to fill short lines - (emptycells (make-list maxcells "")) - maxwidths) - ;; Calculate maximum width for each column - (dotimes (i maxcells) - (let ((column (mapcar (lambda (x) (or (nth i x) "")) cells))) - (push (apply #'max 1 (mapcar #'markdown--string-width column)) - maxwidths))) - (setq maxwidths (nreverse maxwidths)) - ;; Process column format specifier - (setq fmtspec (markdown-table-colfmt fmtspec)) - ;; Compute formats needed for output of table lines - (let ((hfmt (concat indent "|")) - (rfmt (concat indent "|")) - hfmt1 rfmt1 fmt) - (dolist (width maxwidths (setq hfmt (concat (substring hfmt 0 -1) "|"))) - (setq fmt (pop fmtspec)) - (cond ((equal fmt 'l) (setq hfmt1 ":%s-|" rfmt1 " %%-%ds |")) - ((equal fmt 'r) (setq hfmt1 "-%s:|" rfmt1 " %%%ds |")) - ((equal fmt 'c) (setq hfmt1 ":%s:|" rfmt1 " %%-%ds |")) - (t (setq hfmt1 "-%s-|" rfmt1 " %%-%ds |"))) - (setq rfmt (concat rfmt (format rfmt1 width))) - (setq hfmt (concat hfmt (format hfmt1 (make-string width ?-))))) - ;; Replace modified lines only - (dolist (line lines) - (let ((line (if line - (apply #'format rfmt (append (pop cells) emptycells)) - hfmt)) - (previous (buffer-substring (point) (line-end-position)))) - (if (equal previous line) - (forward-line) - (insert line "\n") - (delete-region (point) (line-beginning-position 2)))))) - (set-marker end nil))))) - -(defun markdown-table-insert-row (&optional arg) - "Insert a new row above the row at point into the table. -With optional argument ARG, insert below the current row." - (interactive "P") - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let* ((line (buffer-substring - (line-beginning-position) (line-end-position))) - (new (markdown-table-blank-line line))) - (beginning-of-line (if arg 2 1)) - (unless (bolp) (insert "\n")) - (insert-before-markers new "\n") - (beginning-of-line 0) - (re-search-forward "| ?" (line-end-position) t))) - -(defun markdown-table-delete-row () - "Delete row or horizontal line at point from the table." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let ((col (current-column))) - (kill-region (line-beginning-position) - (min (1+ (line-end-position)) (point-max))) - (unless (markdown-table-at-point-p) (beginning-of-line 0)) - (move-to-column col))) - -(defun markdown-table-move-row (&optional up) - "Move table line at point down. -With optional argument UP, move it up." - (interactive "P") - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let* ((col (current-column)) (pos (point)) - (tonew (if up 0 2)) txt) - (beginning-of-line tonew) - (unless (markdown-table-at-point-p) - (goto-char pos) (user-error "Cannot move row further")) - (goto-char pos) (beginning-of-line 1) (setq pos (point)) - (setq txt (buffer-substring (point) (1+ (line-end-position)))) - (delete-region (point) (1+ (line-end-position))) - (beginning-of-line tonew) - (insert txt) (beginning-of-line 0) - (move-to-column col))) - -(defun markdown-table-move-row-up () - "Move table row at point up." - (interactive) - (markdown-table-move-row 'up)) - -(defun markdown-table-move-row-down () - "Move table row at point down." - (interactive) - (markdown-table-move-row nil)) - -(defun markdown-table-insert-column () - "Insert a new table column." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let* ((col (max 1 (markdown-table-get-column))) - (begin (markdown-table-begin)) - (end (copy-marker (markdown-table-end)))) - (markdown-table-save-cell - (goto-char begin) - (while (< (point) end) - (markdown-table-goto-column col t) - (if (markdown-table-hline-at-point-p) - (insert "|---") - (insert "| ")) - (forward-line))) - (set-marker end nil) - (when markdown-table-align-p - (markdown-table-align)))) - -(defun markdown-table-delete-column () - "Delete column at point from table." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let ((col (markdown-table-get-column)) - (begin (markdown-table-begin)) - (end (copy-marker (markdown-table-end)))) - (markdown-table-save-cell - (goto-char begin) - (while (< (point) end) - (markdown-table-goto-column col t) - (and (looking-at "|\\(?:\\\\|\\|[^|\n]\\)+|") - (replace-match "|")) - (forward-line))) - (set-marker end nil) - (markdown-table-goto-column (max 1 (1- col))) - (when markdown-table-align-p - (markdown-table-align)))) - -(defun markdown-table-move-column (&optional left) - "Move table column at point to the right. -With optional argument LEFT, move it to the left." - (interactive "P") - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let* ((col (markdown-table-get-column)) - (col1 (if left (1- col) col)) - (colpos (if left (1- col) (1+ col))) - (begin (markdown-table-begin)) - (end (copy-marker (markdown-table-end)))) - (when (and left (= col 1)) - (user-error "Cannot move column further left")) - (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) - (user-error "Cannot move column further right")) - (markdown-table-save-cell - (goto-char begin) - (while (< (point) end) - (markdown-table-goto-column col1 t) - (when (looking-at "|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|") - (replace-match "|\\2|\\1|")) - (forward-line))) - (set-marker end nil) - (markdown-table-goto-column colpos) - (when markdown-table-align-p - (markdown-table-align)))) - -(defun markdown-table-move-column-left () - "Move table column at point to the left." - (interactive) - (markdown-table-move-column 'left)) - -(defun markdown-table-move-column-right () - "Move table column at point to the right." - (interactive) - (markdown-table-move-column nil)) - -(defun markdown-table-next-row () - "Go to the next row (same column) in the table. -Create new table lines if required." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (if (or (looking-at "[ \t]*$") - (save-excursion (skip-chars-backward " \t") (bolp))) - (newline) - (when markdown-table-align-p - (markdown-table-align)) - (let ((col (markdown-table-get-column))) - (beginning-of-line 2) - (if (or (not (markdown-table-at-point-p)) - (markdown-table-hline-at-point-p)) - (progn - (beginning-of-line 0) - (markdown-table-insert-row 'below))) - (markdown-table-goto-column col) - (skip-chars-backward "^|\n\r") - (when (looking-at " ") (forward-char 1))))) - -(defun markdown-table-forward-cell () - "Go to the next cell in the table. -Create new table lines if required." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (when markdown-table-align-p - (markdown-table-align)) - (let ((end (markdown-table-end))) - (when (markdown-table-hline-at-point-p) (end-of-line 1)) - (condition-case nil - (progn - (re-search-forward "\\(?:^\\|[^\\]\\)|" end) - (when (looking-at "[ \t]*$") - (re-search-forward "\\(?:^\\|[^\\]:\\)|" end)) - (when (and (looking-at "[-:]") - (re-search-forward "^\\(?:[ \t]*\\|[^\\]\\)|\\([^-:]\\)" end t)) - (goto-char (match-beginning 1))) - (if (looking-at "[-:]") - (progn - (beginning-of-line 0) - (markdown-table-insert-row 'below)) - (when (looking-at " ") (forward-char 1)))) - (error (markdown-table-insert-row 'below))))) - -(defun markdown-table-backward-cell () - "Go to the previous cell in the table." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (when markdown-table-align-p - (markdown-table-align)) - (when (markdown-table-hline-at-point-p) (beginning-of-line 1)) - (condition-case nil - (progn - (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)) - ;; When this function is called while in the first cell in a - ;; table, the point will now be at the beginning of a line. In - ;; this case, we need to move past one additional table - ;; boundary, the end of the table on the previous line. - (when (= (point) (line-beginning-position)) - (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) - (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) - (error (user-error "Cannot move to previous table cell"))) - (when (looking-at "\\(?:^\\|[^\\]\\)| ?") (goto-char (match-end 0))) - - ;; This may have dropped point on the hline. - (when (markdown-table-hline-at-point-p) - (markdown-table-backward-cell))) - -(defun markdown-table-transpose () - "Transpose table at point. -Horizontal separator lines will be eliminated." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let* ((table (buffer-substring-no-properties - (markdown-table-begin) (markdown-table-end))) - ;; Convert table to Lisp structure - (table (delq nil - (mapcar - (lambda (x) - (unless (string-match-p - markdown-table-hline-regexp x) - (markdown--table-line-to-columns x))) - (markdown--split-string table "[ \t]*\n[ \t]*")))) - (dline_old (markdown-table-get-dline)) - (col_old (markdown-table-get-column)) - (contents (mapcar (lambda (_) - (let ((tp table)) - (mapcar - (lambda (_) - (prog1 - (pop (car tp)) - (setq tp (cdr tp)))) - table))) - (car table)))) - (goto-char (markdown-table-begin)) - (save-excursion - (re-search-forward "|") (backward-char) - (delete-region (point) (markdown-table-end)) - (insert (mapconcat - (lambda(x) - (concat "| " (mapconcat 'identity x " | " ) " |\n")) - contents ""))) - (markdown-table-goto-dline col_old) - (markdown-table-goto-column dline_old)) - (when markdown-table-align-p - (markdown-table-align))) - -(defun markdown-table-sort-lines (&optional sorting-type) - "Sort table lines according to the column at point. - -The position of point indicates the column to be used for -sorting, and the range of lines is the range between the nearest -horizontal separator lines, or the entire table of no such lines -exist. If point is before the first column, user will be prompted -for the sorting column. If there is an active region, the mark -specifies the first line and the sorting column, while point -should be in the last line to be included into the sorting. - -The command then prompts for the sorting type which can be -alphabetically or numerically. Sorting in reverse order is also -possible. - -If SORTING-TYPE is specified when this function is called from a -Lisp program, no prompting will take place. SORTING-TYPE must be -a character, any of (?a ?A ?n ?N) where the capital letters -indicate that sorting should be done in reverse order." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - ;; Set sorting type and column used for sorting - (let ((column (let ((c (markdown-table-get-column))) - (cond ((> c 0) c) - ((called-interactively-p 'any) - (read-number "Use column N for sorting: ")) - (t 1)))) - (sorting-type - (or sorting-type - (progn - ;; workaround #641 - ;; Emacs < 28 hides prompt message by another message. This erases it. - (message "") - (read-char-exclusive - "Sort type: [a]lpha [n]umeric (A/N means reversed): "))))) - (save-restriction - ;; Narrow buffer to appropriate sorting area - (if (region-active-p) - (narrow-to-region - (save-excursion - (progn - (goto-char (region-beginning)) (line-beginning-position))) - (save-excursion - (progn - (goto-char (region-end)) (line-end-position)))) - (let ((start (markdown-table-begin)) - (end (markdown-table-end))) - (narrow-to-region - (save-excursion - (if (re-search-backward - markdown-table-hline-regexp start t) - (line-beginning-position 2) - start)) - (if (save-excursion (re-search-forward - markdown-table-hline-regexp end t)) - (match-beginning 0) - end)))) - ;; Determine arguments for `sort-subr' - (let* ((extract-key-from-cell - (cl-case sorting-type - ((?a ?A) #'markdown--remove-invisible-markup) ;; #'identity) - ((?n ?N) #'string-to-number) - (t (user-error "Invalid sorting type: %c" sorting-type)))) - (predicate - (cl-case sorting-type - ((?n ?N) #'<) - ((?a ?A) #'string<)))) - ;; Sort selected area - (goto-char (point-min)) - (sort-subr (memq sorting-type '(?A ?N)) - (lambda () - (forward-line) - (while (and (not (eobp)) - (not (looking-at - markdown-table-dline-regexp))) - (forward-line))) - #'end-of-line - (lambda () - (funcall extract-key-from-cell - (markdown-table-get-cell column))) - nil - predicate) - (goto-char (point-min)))))) - -(defun markdown-table-convert-region (begin end &optional separator) - "Convert region from BEGIN to END to table with SEPARATOR. - -If every line contains at least one TAB character, the function -assumes that the material is tab separated (TSV). If every line -contains a comma, comma-separated values (CSV) are assumed. If -not, lines are split at whitespace into cells. - -You can use a prefix argument to force a specific separator: -\\[universal-argument] once forces CSV, \\[universal-argument] -twice forces TAB, and \\[universal-argument] three times will -prompt for a regular expression to match the separator, and a -numeric argument N indicates that at least N consecutive -spaces, or alternatively a TAB should be used as the separator." - - (interactive "r\nP") - (let* ((begin (min begin end)) (end (max begin end)) re) - (goto-char begin) (beginning-of-line 1) - (setq begin (point-marker)) - (goto-char end) - (if (bolp) (backward-char 1) (end-of-line 1)) - (setq end (point-marker)) - (when (equal separator '(64)) - (setq separator (read-regexp "Regexp for cell separator: "))) - (unless separator - ;; Get the right cell separator - (goto-char begin) - (setq separator - (cond - ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) - ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) - (t 1)))) - (goto-char begin) - (if (equal separator '(4)) - ;; Parse CSV - (while (< (point) end) - (cond - ((looking-at "^") (insert "| ")) - ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) - ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") - (replace-match "\\1") (if (looking-at "\"") (insert "\""))) - ((looking-at "[^,\n]+") (goto-char (match-end 0))) - ((looking-at "[ \t]*,") (replace-match " | ")) - (t (beginning-of-line 2)))) - (setq re - (cond - ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") - ((equal separator '(16)) "^\\|\t") - ((integerp separator) - (if (< separator 1) - (user-error "Cell separator must contain one or more spaces") - (format "^ *\\| *\t *\\| \\{%d,\\}\\|$" separator))) - ((stringp separator) (format "^ *\\|%s" separator)) - (t (error "Invalid cell separator")))) - (let (finish) - (while (and (not finish) (re-search-forward re end t)) - (if (eolp) - (progn - (replace-match "|" t t) - (forward-line 1) - (when (eobp) - (setq finish t))) - (replace-match "| " t t))))) - (goto-char begin) - (when markdown-table-align-p - (markdown-table-align)))) - -(defun markdown-insert-table (&optional rows columns align) - "Insert an empty pipe table. -Optional arguments ROWS, COLUMNS, and ALIGN specify number of -rows and columns and the column alignment." - (interactive) - (let* ((rows (or rows (read-number "Number of Rows: "))) - (columns (or columns (read-number "Number of Columns: "))) - (align (or align (read-string "Alignment ([l]eft, [r]ight, [c]enter, or RET for default): "))) - (align (cond ((equal align "l") ":--") - ((equal align "r") "--:") - ((equal align "c") ":-:") - (t "---"))) - (pos (point)) - (indent (make-string (current-column) ?\ )) - (line (concat - (apply 'concat indent "|" - (make-list columns " |")) "\n")) - (hline (apply 'concat indent "|" - (make-list columns (concat align "|"))))) - (if (string-match - "^[ \t]*$" (buffer-substring-no-properties - (line-beginning-position) (point))) - (beginning-of-line 1) - (newline)) - (dotimes (_ rows) (insert line)) - (goto-char pos) - (if (> rows 1) - (progn - (end-of-line 1) (insert (concat "\n" hline)) (goto-char pos))) - (markdown-table-forward-cell))) - - -;;; ElDoc Support ============================================================= - -(defun markdown-eldoc-function (&rest _ignored) - "Return a helpful string when appropriate based on context. -* Report URL when point is at a hidden URL. -* Report language name when point is a code block with hidden markup." - (cond - ;; Hidden URL or reference for inline link - ((and (or (thing-at-point-looking-at markdown-regex-link-inline) - (thing-at-point-looking-at markdown-regex-link-reference)) - (or markdown-hide-urls markdown-hide-markup)) - (let* ((imagep (string-equal (match-string 1) "!")) - (referencep (string-equal (match-string 5) "[")) - (link (match-string-no-properties 6)) - (edit-keys (markdown--substitute-command-keys - (if imagep - "\\[markdown-insert-image]" - "\\[markdown-insert-link]"))) - (edit-str (propertize edit-keys 'face 'font-lock-constant-face)) - (object (if referencep "reference" "URL"))) - (format "Hidden %s (%s to edit): %s" object edit-str - (if referencep - (concat - (propertize "[" 'face 'markdown-markup-face) - (propertize link 'face 'markdown-reference-face) - (propertize "]" 'face 'markdown-markup-face)) - (propertize link 'face 'markdown-url-face))))) - ;; Hidden language name for fenced code blocks - ((and (markdown-code-block-at-point-p) - (not (get-text-property (point) 'markdown-pre)) - markdown-hide-markup) - (let ((lang (save-excursion (markdown-code-block-lang)))) - (unless lang (setq lang "[unspecified]")) - (format "Hidden code block language: %s (%s to toggle markup)" - (propertize lang 'face 'markdown-language-keyword-face) - (markdown--substitute-command-keys - "\\[markdown-toggle-markup-hiding]")))))) - -(defun markdown--image-media-handler (mimetype data) - (let* ((ext (symbol-name (mailcap-mime-type-to-extension mimetype))) - (filename (read-string "Insert filename for image: ")) - (link-text (read-string "Link text: ")) - (filepath (file-name-with-extension filename ext)) - (dir (file-name-directory filepath))) - (when (and dir (not (file-directory-p dir))) - (make-directory dir t)) - (with-temp-file filepath - (insert data)) - (when (string-match-p "\\s-" filepath) - (setq filepath (concat "<" filepath ">"))) - (markdown-insert-inline-image link-text filepath))) - -(defun markdown--file-media-handler (_mimetype data) - (let* ((data (split-string data "[\0\r\n]" t "^file://")) - (files (cdr data))) - (while (not (null files)) - (let* ((file (url-unhex-string (car files))) - (file (file-relative-name file)) - (prompt (format "Link text(%s): " (file-name-nondirectory file))) - (link-text (read-string prompt))) - (when (string-match-p "\\s-" file) - (setq file (concat "<" file ">"))) - (markdown-insert-inline-image link-text file) - (when (not (null (cdr files))) - (insert " ")) - (setq files (cdr files)))))) - -(defun markdown--dnd-local-file-handler (url _action) - (require 'mailcap) - (require 'dnd) - (let* ((filename (dnd-get-local-file-name url)) - (mimetype (mailcap-file-name-to-mime-type filename)) - (file (file-relative-name filename)) - (link-text "link text")) - (when (string-match-p "\\s-" file) - (setq file (concat "<" file ">"))) - (if (string-prefix-p "image/" mimetype) - (markdown-insert-inline-image link-text file) - (markdown-insert-inline-link link-text file)))) - - -;;; Mode Definition ========================================================== - -(defun markdown-show-version () - "Show the version number in the minibuffer." - (interactive) - (message "markdown-mode, version %s" markdown-mode-version)) - -(defun markdown-mode-info () - "Open the `markdown-mode' homepage." - (interactive) - (browse-url "https://jblevins.org/projects/markdown-mode/")) - -;;;###autoload -(define-derived-mode markdown-mode text-mode "Markdown" - "Major mode for editing Markdown files." - (when buffer-read-only - (when (or (not (buffer-file-name)) (file-writable-p (buffer-file-name))) - (setq-local buffer-read-only nil))) - ;; Natural Markdown tab width - (setq tab-width 4) - ;; Comments - (setq-local comment-start "<!-- ") - (setq-local comment-end " -->") - (setq-local comment-start-skip "<!--[ \t]*") - (setq-local comment-column 0) - (setq-local comment-auto-fill-only-comments nil) - (setq-local comment-use-syntax t) - ;; Sentence - (setq-local sentence-end-base "[.?!…‽][]\"'”’)}»›*_`~]*") - ;; Syntax - (add-hook 'syntax-propertize-extend-region-functions - #'markdown-syntax-propertize-extend-region nil t) - (add-hook 'jit-lock-after-change-extend-region-functions - #'markdown-font-lock-extend-region-function t t) - (setq-local syntax-propertize-function #'markdown-syntax-propertize) - (syntax-propertize (point-max)) ;; Propertize before hooks run, etc. - ;; Font lock. - (setq font-lock-defaults - '(markdown-mode-font-lock-keywords - nil nil nil nil - (font-lock-multiline . t) - (font-lock-syntactic-face-function . markdown-syntactic-face) - (font-lock-extra-managed-props - . (composition display invisible rear-nonsticky - keymap help-echo mouse-face)))) - (if markdown-hide-markup - (add-to-invisibility-spec 'markdown-markup) - (remove-from-invisibility-spec 'markdown-markup)) - ;; Wiki links - (markdown-setup-wiki-link-hooks) - ;; Math mode - (when markdown-enable-math (markdown-toggle-math t)) - ;; Add a buffer-local hook to reload after file-local variables are read - (add-hook 'hack-local-variables-hook #'markdown-handle-local-variables nil t) - ;; For imenu support - (setq imenu-create-index-function - (if markdown-nested-imenu-heading-index - #'markdown-imenu-create-nested-index - #'markdown-imenu-create-flat-index)) - - ;; Defun movement - (setq-local beginning-of-defun-function #'markdown-beginning-of-defun) - (setq-local end-of-defun-function #'markdown-end-of-defun) - ;; Paragraph filling - (setq-local fill-paragraph-function #'markdown-fill-paragraph) - (setq-local paragraph-start - ;; Should match start of lines that start or separate paragraphs - (mapconcat #'identity - '( - "\f" ; starts with a literal line-feed - "[ \t\f]*$" ; space-only line - "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote - "[ \t]*[*+-][ \t]+" ; unordered list item - "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item - "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def - "[ \t]*:[ \t]+" ; definition - "^|" ; table or Pandoc line block - ) - "\\|")) - (setq-local paragraph-separate - ;; Should match lines that separate paragraphs without being - ;; part of any paragraph: - (mapconcat #'identity - '("[ \t\f]*$" ; space-only line - "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote - ;; The following is not ideal, but the Fill customization - ;; options really only handle paragraph-starting prefixes, - ;; not paragraph-ending suffixes: - ".* $" ; line ending in two spaces - "^#+" - "^\\(?: \\)?[-=]+[ \t]*$" ;; setext - "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def - "\\|")) - (setq-local adaptive-fill-first-line-regexp "\\`[ \t]*[A-Z]?>[ \t]*?\\'") - (setq-local adaptive-fill-regexp "\\s-*") - (setq-local adaptive-fill-function #'markdown-adaptive-fill-function) - (setq-local fill-forward-paragraph-function #'markdown-fill-forward-paragraph) - ;; Outline mode - (setq-local outline-regexp markdown-regex-header) - (setq-local outline-level #'markdown-outline-level) - ;; Cause use of ellipses for invisible text. - (add-to-invisibility-spec '(outline . t)) - ;; ElDoc support - (if (boundp 'eldoc-documentation-functions) - (add-hook 'eldoc-documentation-functions #'markdown-eldoc-function nil t) - (add-function :before-until (local 'eldoc-documentation-function) - #'markdown-eldoc-function)) - ;; Inhibiting line-breaking: - ;; Separating out each condition into a separate function so that users can - ;; override if desired (with remove-hook) - (add-hook 'fill-nobreak-predicate - #'markdown-line-is-reference-definition-p nil t) - (add-hook 'fill-nobreak-predicate - #'markdown-pipe-at-bol-p nil t) - - ;; Indentation - (setq-local indent-line-function markdown-indent-function) - (setq-local indent-region-function #'markdown--indent-region) - - ;; Flyspell - (setq-local flyspell-generic-check-word-predicate - #'markdown-flyspell-check-word-p) - - ;; Electric quoting - (add-hook 'electric-quote-inhibit-functions - #'markdown--inhibit-electric-quote nil :local) - - ;; drag and drop handler - (setq-local dnd-protocol-alist (cons '("^file:///" . markdown--dnd-local-file-handler) - dnd-protocol-alist)) - - ;; media handler - (when (version< "29" emacs-version) - (yank-media-handler "image/.*" #'markdown--image-media-handler) - ;; TODO support other than GNOME, like KDE etc - (yank-media-handler "x-special/gnome-copied-files" #'markdown--file-media-handler)) - - ;; Make checkboxes buttons - (when markdown-make-gfm-checkboxes-buttons - (markdown-make-gfm-checkboxes-buttons (point-min) (point-max)) - (add-hook 'after-change-functions #'markdown-gfm-checkbox-after-change-function t t) - (add-hook 'change-major-mode-hook #'markdown-remove-gfm-checkbox-overlays t t)) - - ;; edit-indirect - (add-hook 'edit-indirect-after-commit-functions - #'markdown--edit-indirect-after-commit-function - nil 'local) - - ;; Marginalized headings - (when markdown-marginalize-headers - (add-hook 'window-configuration-change-hook - #'markdown-marginalize-update-current nil t)) - - ;; add live preview export hook - (add-hook 'after-save-hook #'markdown-live-preview-if-markdown t t) - (add-hook 'kill-buffer-hook #'markdown-live-preview-remove-on-kill t t) - - ;; Add a custom keymap for `visual-line-mode' so that activating - ;; this minor mode does not override markdown-mode's keybindings. - ;; FIXME: Probably `visual-line-mode' should take care of this. - (let ((oldmap (cdr (assoc 'visual-line-mode minor-mode-map-alist))) - (newmap (make-sparse-keymap))) - (set-keymap-parent newmap oldmap) - (define-key newmap [remap move-beginning-of-line] nil) - (define-key newmap [remap move-end-of-line] nil) - (make-local-variable 'minor-mode-overriding-map-alist) - (push `(visual-line-mode . ,newmap) minor-mode-overriding-map-alist))) - -;;;###autoload -(add-to-list 'auto-mode-alist - '("\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" . markdown-mode)) - - -;;; GitHub Flavored Markdown Mode ============================================ - -(defun gfm--electric-pair-fence-code-block () - (when (and electric-pair-mode - (not markdown-gfm-use-electric-backquote) - (eql last-command-event ?`) - (let ((count 0)) - (while (eql (char-before (- (point) count)) ?`) - (cl-incf count)) - (= count 3)) - (eql (char-after) ?`)) - (save-excursion (insert (make-string 2 ?`))))) - -(defvar gfm-mode-hook nil - "Hook run when entering GFM mode.") - -;;;###autoload -(define-derived-mode gfm-mode markdown-mode "GFM" - "Major mode for editing GitHub Flavored Markdown files." - (setq markdown-link-space-sub-char "-") - (setq markdown-wiki-link-search-subdirectories t) - (setq-local markdown-table-at-point-p-function #'gfm--table-at-point-p) - (setq-local paragraph-separate - (concat paragraph-separate - "\\|" - ;; GFM alert syntax - "^>\s-*\\[!\\(?:NOTE\\|TIP\\|IMPORTANT\\|WARNING\\|CAUTION\\)\\]")) - (add-hook 'post-self-insert-hook #'gfm--electric-pair-fence-code-block 'append t) - (markdown-gfm-parse-buffer-for-languages)) - - -;;; Viewing modes ============================================================= - -(defcustom markdown-hide-markup-in-view-modes t - "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'." - :group 'markdown - :type 'boolean - :safe #'booleanp) - -(defvar markdown-view-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "p") #'markdown-outline-previous) - (define-key map (kbd "n") #'markdown-outline-next) - (define-key map (kbd "f") #'markdown-outline-next-same-level) - (define-key map (kbd "b") #'markdown-outline-previous-same-level) - (define-key map (kbd "u") #'markdown-outline-up) - (define-key map (kbd "DEL") #'scroll-down-command) - (define-key map (kbd "SPC") #'scroll-up-command) - (define-key map (kbd ">") #'end-of-buffer) - (define-key map (kbd "<") #'beginning-of-buffer) - (define-key map (kbd "q") #'kill-this-buffer) - (define-key map (kbd "?") #'describe-mode) - map) - "Keymap for `markdown-view-mode'.") - -(defun markdown--filter-visible (beg end &optional delete) - (let ((result "") - (invisible-faces '(markdown-header-delimiter-face markdown-header-rule-face))) - (while (< beg end) - (when (markdown--face-p beg invisible-faces) - (cl-incf beg) - (while (and (markdown--face-p beg invisible-faces) (< beg end)) - (cl-incf beg))) - (let ((next (next-single-char-property-change beg 'invisible))) - (unless (get-char-property beg 'invisible) - (setq result (concat result (buffer-substring beg (min end next))))) - (setq beg next))) - (prog1 result - (when delete - (let ((inhibit-read-only t)) - (delete-region beg end)))))) - -;;;###autoload -(define-derived-mode markdown-view-mode markdown-mode "Markdown-View" - "Major mode for viewing Markdown content." - (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) - (add-to-invisibility-spec 'markdown-markup) - (setq-local filter-buffer-substring-function #'markdown--filter-visible) - (read-only-mode 1)) - -(defvar gfm-view-mode-map - markdown-view-mode-map - "Keymap for `gfm-view-mode'.") - -;;;###autoload -(define-derived-mode gfm-view-mode gfm-mode "GFM-View" - "Major mode for viewing GitHub Flavored Markdown content." - (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) - (setq-local markdown-fontify-code-blocks-natively t) - (setq-local filter-buffer-substring-function #'markdown--filter-visible) - (add-to-invisibility-spec 'markdown-markup) - (read-only-mode 1)) - - -;;; Live Preview Mode ======================================================== -;;;###autoload -(define-minor-mode markdown-live-preview-mode - "Toggle native previewing on save for a specific markdown file." - :lighter " MD-Preview" - (if markdown-live-preview-mode - (if (markdown-live-preview-get-filename) - (markdown-display-buffer-other-window (markdown-live-preview-export)) - (markdown-live-preview-mode -1) - (user-error "Buffer %s does not visit a file" (current-buffer))) - (markdown-live-preview-remove))) - - -(provide 'markdown-mode) - -;; Local Variables: -;; indent-tabs-mode: nil -;; coding: utf-8 -;; End: -;;; markdown-mode.el ends here diff --git a/emacs/elpa/markdown-mode-20241117.307/markdown-mode.elc b/emacs/elpa/markdown-mode-20241117.307/markdown-mode.elc Binary files differ. diff --git a/emacs/elpa/osm-20241105.2132/osm-pkg.el b/emacs/elpa/osm-20241105.2132/osm-pkg.el @@ -1,11 +0,0 @@ -;; -*- no-byte-compile: t; lexical-binding: nil -*- -(define-package "osm" "20241105.2132" - "OpenStreetMap viewer." - '((emacs "28.1") - (compat "30")) - :url "https://github.com/minad/osm" - :commit "b17f4824fce86937dff956d4daf3b62849b27fa7" - :revdesc "b17f4824fce8" - :keywords '("network" "multimedia" "hypermedia" "mouse") - :authors '(("Daniel Mendler" . "mail@daniel-mendler.de")) - :maintainers '(("Daniel Mendler" . "mail@daniel-mendler.de"))) diff --git a/emacs/elpa/osm-20241105.2132/osm.el b/emacs/elpa/osm-20241105.2132/osm.el @@ -1,1835 +0,0 @@ -;;; osm.el --- OpenStreetMap viewer -*- lexical-binding: t -*- - -;; Copyright (C) 2022-2024 Free Software Foundation, Inc. - -;; Author: Daniel Mendler <mail@daniel-mendler.de> -;; Maintainer: Daniel Mendler <mail@daniel-mendler.de> -;; Created: 2022 -;; Package-Version: 20241105.2132 -;; Package-Revision: b17f4824fce8 -;; Package-Requires: ((emacs "28.1") (compat "30")) -;; URL: https://github.com/minad/osm -;; Keywords: network, multimedia, hypermedia, mouse - -;; This file is 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 this program. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Osm.el is a tile-based map viewer, with a responsive movable and -;; zoomable display. The map can be controlled with the keyboard or with -;; the mouse. The viewer fetches the map tiles in parallel from tile -;; servers via the `curl' program. The package comes with a list of -;; multiple preconfigured tile servers. You can bookmark your favorite -;; locations using regular Emacs bookmarks or create links from Org files -;; to locations. Furthermore the package provides commands to measure -;; distances, search for locations by name and to open and display GPX -;; tracks. - -;; osm.el requires Emacs 28 and depends on the external `curl' program. -;; Emacs must be built with libxml, libjansson, librsvg, libjpeg and -;; libpng support. - -;;; Code: - -(require 'compat) -(require 'bookmark) -(require 'dom) -(eval-when-compile - (require 'cl-lib) - (require 'subr-x)) - -(defgroup osm nil - "OpenStreetMap viewer." - :link '(info-link :tag "Info Manual" "(osm)") - :link '(url-link :tag "Website" "https://github.com/minad/osm") - :link '(url-link :tag "Wiki" "https://github.com/minad/osm/wiki") - :link '(emacs-library-link :tag "Library Source" "osm.el") - :group 'web - :prefix "osm-") - -(defcustom osm-curl-options - "--disable --fail --location --silent --max-time 30" - "Curl command line options." - :type 'string) - -(defcustom osm-search-language "en" - "Language used for search results. -Use RFC 1766 abbreviations, e.g.: `en' for English, `de' for German. -A comma-separated specifies descending order of preference. See also -`url-mime-language-string'." - :type 'string) - -(defcustom osm-search-server - "https://nominatim.openstreetmap.org" - "Server used to search for location names. -The server must offer the nominatim.org API." - :type 'string) - -(defcustom osm-server-defaults - '(:min-zoom 2 - :max-zoom 19 - :download-batch 4 - :max-connections 2 - :subdomains ("a" "b" "c")) - "Default server properties. -See also `osm-server-list'." - :type 'plist) - -(defcustom osm-server-list - '((default - :name "Carto" - :description "Standard Carto map provided by OpenStreetMap" - :url "https://%s.tile.openstreetmap.org/%z/%x/%y.png" - :group "Standard" - :copyright ("Map data © {OpenStreetMap|https://www.openstreetmap.org/copyright} contributors" - "Map style © {OpenStreetMap Standard|https://www.openstreetmap.org/copyright}")) - (de - :name "Carto(de)" - :description "Localized Carto map provided by OpenStreetMap Germany" - :url "https://%s.tile.openstreetmap.de/%z/%x/%y.png" - :group "Standard" - :copyright ("Map data © {OpenStreetMap|https://www.openstreetmap.org/copyright} contributors" - "Map style © {OpenStreetMap Deutschland|https://www.openstreetmap.de/germanstyle.html}")) - (fr - :name "Carto(fr)" - :description "Localized Carto map by OpenStreetMap France" - :url "https://%s.tile.openstreetmap.fr/osmfr/%z/%x/%y.png" - :group "Standard" - :copyright ("Map data © {OpenStreetMap|https://www.openstreetmap.org/copyright} contributors" - "Map style © {OpenStreetMap France|https://www.openstreetmap.fr/mentions-legales/}")) - (humanitarian - :name "Humanitarian" - :description "Humanitarian map provided by OpenStreetMap France" - :url "https://%s.tile.openstreetmap.fr/hot/%z/%x/%y.png" - :group "Special Purpose" - :copyright ("Map data © {OpenStreetMap|https://www.openstreetmap.org/copyright} contributors" - "Map style © {Humanitarian OpenStreetMap Team|https://www.hotosm.org/updates/2013-09-29_a_new_window_on_openstreetmap_data}")) - (cyclosm - :name "CyclOSM" - :description "Bicycle-oriented map provided by OpenStreetMap France" - :url "https://%s.tile-cyclosm.openstreetmap.fr/cyclosm/%z/%x/%y.png" - :group "Transportation" - :copyright ("Map data © {OpenStreetMap|https://www.openstreetmap.org/copyright} contributors" - "Map style © {CyclOSM|https://www.cyclosm.org/} contributors")) - (openriverboatmap - :name "OpenRiverBoatMap" - :description "Waterways map provided by OpenStreetMap France" - :url "https://%s.tile.openstreetmap.fr/openriverboatmap/%z/%x/%y.png" - :group "Transportation" - :copyright ("Map data © {OpenStreetMap|https://www.openstreetmap.org/copyright} contributors" - "Map style © {OpenRiverBoatMap|https://github.com/tilery/OpenRiverboatMap}")) - (opentopomap - :name "OpenTopoMap" - :description "Topographical map provided by OpenTopoMap" - :url "https://%s.tile.opentopomap.org/%z/%x/%y.png" - :group "Topographical" - :copyright ("Map data © {OpenStreetMap|https://www.openstreetmap.org/copyright} contributors" - "Map style © {OpenTopoMap|https://www.opentopomap.org} ({CC-BY-SA|https://creativecommons.org/licenses/by-sa/3.0/})" - "Elevation data: {SRTM|https://www2.jpl.nasa.gov/srtm/}")) - (opvn - :name "ÖPNV" :max-zoom 18 - :description "Base layer with public transport information" - :url "http://%s.tile.memomaps.de/tilegen/%z/%x/%y.png" - :group "Transportation" - :copyright ("Map data © {OpenStreetMap|https://www.openstreetmap.org/copyright} contributors" - "Map style © {ÖPNVKarte|https://www.öpnvkarte.de}"))) - "List of tile servers. - -Allowed keys: - :name Server name - :description Server description - :copyright Copyright information - :group Name of server groups for related servers - :url Url with placeholders - :ext File name extension - :min-zoom Minimum zoom level - :max-zoom Maximum zoom level - :download-batch Number of tiles downloaded via a single connection - :max-connections Maximum number of parallel connections - :subdomains Subdomains used for the %s placeholder - -See also `osm-server-defaults' for default values used for a -server if the property is missing. - -The :url of each server should specify %x, %y, %z and %s placeholders -for the map coordinates. It can optionally use an %s placeholder -for the subdomain and a %k placeholder for an apikey. The apikey -will be retrieved via `auth-source-search' with the :host set to -the domain name and the :user to the string \"apikey\"." - :type '(alist :key-type symbol :value-type plist)) - -(defcustom osm-copyright t - "Display the copyright information above the map." - :type 'boolean) - -(defcustom osm-pin-colors - '((osm-selected . "#e20") - (osm-bookmark . "#f80") - (osm-poi . "#88f") - (osm-home . "#80f") - (osm-track . "#00a")) - "Colors of pins." - :type '(alist :key-type symbol :value-type string)) - -(defcustom osm-track-style - "stroke:#00a;stroke-width:5;stroke-linejoin:round;stroke-linecap:round;opacity:0.4;" - "SVG style used to draw tracks." - :type 'string) - -(defcustom osm-home - (let ((lat (bound-and-true-p calendar-latitude)) - (lon (bound-and-true-p calendar-longitude))) - (if (and lat lon) - (list lat lon 12) - (list 0 0 3))) - "Home coordinates, latitude, longitude and zoom level." - :type '(list :tag "Coordinates" - (number :tag "Latitude ") - (number :tag "Longitude ") - (number :tag "Zoom "))) - -(defcustom osm-large-step 256 - "Scroll step in pixel." - :type 'natnum) - -(defcustom osm-tile-border nil - "Set to t to display thin tile borders. -For debugging set the value to `debug', such that a border is -shown around SVG tiles." - :type '(choice boolean (const debug))) - -(defcustom osm-small-step 16 - "Scroll step in pixel." - :type 'natnum) - -(defcustom osm-server 'default - "Tile server name." - :type 'symbol) - -(defcustom osm-tile-directory - (expand-file-name "var/osm/" user-emacs-directory) - "Tile cache directory." - :type 'string) - -(defcustom osm-max-age 14 - "Maximum tile age in days. -Should be at least 7 days according to the server usage policies." - :type '(choice (const nil) natnum)) - -(defcustom osm-max-tiles 256 - "Number of tiles to keep in the memory cache." - :type '(choice (const nil) natnum)) - -(defun osm--menu-item (menu) - "Generate menu item from MENU." - `(menu-item - "" nil :filter - ,(lambda (&optional _) - (select-window - (posn-window - (event-start last-input-event))) - (if (functionp menu) - (funcall menu) - menu)))) - -(defun osm--mouse-ignore-wheel (_prompt) - "Ignore mouse wheel events during key translation." - (pcase (this-single-command-raw-keys) - ((and `[,e] - (let y (event-basic-type e)) - (guard (symbolp y)) - (guard (string-search "wheel-" (symbol-name y)))) - []) - (k k))) - -(defvar-keymap osm-prefix-map - :doc "Global prefix map of OSM entry points." - "h" #'osm-home - "s" #'osm-search - "v" #'osm-server - "t" #'osm-goto - "j" #'osm-jump - "x" #'osm-gpx-show - "X" #'osm-gpx-hide) - -;;;###autoload (autoload 'osm-prefix-map "osm" nil t 'keymap) -(defalias 'osm-prefix-map osm-prefix-map) - -(defvar-keymap osm-mode-map - :doc "Keymap used by `osm-mode'." - :parent (make-composed-keymap osm-prefix-map special-mode-map) - "<home>" #'osm-home - "+" #'osm-zoom-in - "-" #'osm-zoom-out - "SPC" #'osm-zoom-in - "S-SPC" #'osm-zoom-out - "<mouse-1>" #'osm-mouse-pin - "<mouse-2>" 'org-store-link - "<mouse-3>" #'osm-bookmark-set - "S-<down-mouse-1>" #'ignore - "S-<mouse-1>" #'osm-mouse-track - "<down-mouse-1>" #'osm-mouse-drag - "<down-mouse-2>" #'osm-mouse-drag - "<down-mouse-3>" #'osm-mouse-drag - "<drag-mouse-1>" #'ignore - "<drag-mouse-2>" #'ignore - "<drag-mouse-3>" #'ignore - "<up>" #'osm-up - "<down>" #'osm-down - "<left>" #'osm-left - "<right>" #'osm-right - "C-<up>" #'osm-up-up - "C-<down>" #'osm-down-down - "C-<left>" #'osm-left-left - "C-<right>" #'osm-right-right - "M-<up>" #'osm-up-up - "M-<down>" #'osm-down-down - "M-<left>" #'osm-left-left - "M-<right>" #'osm-right-right - "S-<up>" #'osm-up-up - "S-<down>" #'osm-down-down - "S-<left>" #'osm-left-left - "S-<right>" #'osm-right-right - "n" #'osm-rename - "d" #'osm-delete - "DEL" #'osm-delete - "<deletechar>" #'osm-delete - "c" #'osm-center - "o" #'clone-buffer - "u" #'osm-save-url - "l" 'org-store-link - "b" #'osm-bookmark-set - "X" #'osm-gpx-hide - "<remap> <scroll-down-command>" #'osm-down - "<remap> <scroll-up-command>" #'osm-up - "<" nil - ">" nil) - -(dolist (pin osm-pin-colors) - (setq pin (vector (car pin))) - (define-key key-translation-map pin #'osm--mouse-ignore-wheel) - (define-key osm-mode-map pin #'osm-mouse-select)) - -(easy-menu-define osm-mode-menu osm-mode-map - "Menu for `osm-mode'." - '("OSM" - ["Go home" osm-home] - ["Center" osm-center] - ["Go to coordinates" osm-goto] - ["Jump to pin" osm-jump] - ["Search by name" osm-search] - ["Change tile server" osm-server] - "--" - ["Org Link" org-store-link] - ["Geo Url" osm-save-url] - ["Elisp Link" (osm-save-url t)] - ("Bookmark" - ["Set" osm-bookmark-set] - ["Jump" osm-bookmark-jump] - ["Rename" osm-bookmark-rename] - ["Delete" osm-bookmark-delete]) - "--" - ["Show GPX file" osm-gpx-show] - ["Hide GPX file" osm-gpx-hide] - "--" - ["Clone buffer" clone-buffer] - ["Revert buffer" revert-buffer] - "--" - ["Manual" (info "(osm)")] - ["Customize" (customize-group 'osm)])) - -(defconst osm--placeholder - '(:type svg :width 256 :height 256 - :data "<svg width='256' height='256' version='1.1' xmlns='http://www.w3.org/2000/svg'> - <defs> - <pattern id='grid' width='16' height='16' patternUnits='userSpaceOnUse'> - <path d='m 0 0 l 0 16 16 0' fill='none' stroke='#888888'/> - </pattern> - </defs> - <rect width='256' height='256' fill='url(#grid)'/> -</svg>") - "Placeholder image for tiles.") - -(defvar osm--search-history nil - "Minibuffer history used by command `osm-search'.") - -(defvar osm--jump-history nil - "Minibuffer history used by command `osm-jump'.") - -(defvar osm--server-history nil - "Minibuffer history used by command `osm-server'.") - -(defvar osm--purge-directory 0 - "Last time the tile cache was cleaned.") - -(defvar osm--tile-cache nil - "Global tile memory cache.") - -(defvar osm--tile-age 0 - "Tile age, incremented on every update.") - -(defvar osm--gpx-files nil - "Global list of loaded tracks.") - -(defvar osm--track nil - "List of track coordinates.") - -(defvar osm--download-processes nil - "Globally active download processes.") - -(defvar osm--download-active nil - "Globally active download jobs.") - -(defvar osm--download-subdomain nil - "Subdomain indices to query the servers in a round-robin fashion.") - -(defvar-local osm--download-queue nil - "Buffer-local tile download queue.") - -(defvar-local osm--wx 0 - "Half window width in pixel.") - -(defvar-local osm--wy 0 - "Half window height in pixel.") - -(defvar-local osm--nx 0 - "Number of tiles in x direction.") - -(defvar-local osm--ny 0 - "Number of tiles in y direction.") - -(defvar-local osm--zoom nil - "Zoom level of the map.") - -(defvar-local osm--lat nil - "Latitude coordinate.") - -(defvar-local osm--lon nil - "Longitude coordinate.") - -(defvar-local osm--overlays nil - "Overlay hash table. -Local per buffer since the overlays depend on the zoom level.") - -(defvar-local osm--pin nil - "Currently selected pin.") - -(defmacro osm--each (&rest body) - "Execute BODY in each `osm-mode' buffer." - (cl-with-gensyms (buf) - `(dolist (,buf (buffer-list)) - (when (eq (buffer-local-value 'major-mode ,buf) #'osm-mode) - (with-current-buffer ,buf - ,@body))))) - -(defun osm--server-menu () - "Generate server menu." - (let (menu last-group) - (dolist (server osm-server-list) - (let* ((plist (cdr server)) - (group (plist-get plist :group))) - (unless (equal last-group group) - (push (format "─── %s ───" group) menu) - (setq last-group group)) - (push - `[,(plist-get plist :name) - (osm-server ',(car server)) - :style toggle - :selected (eq osm-server ',(car server))] - menu))) - (easy-menu-create-menu "Server" (nreverse menu)))) - -(defsubst osm--lon-to-normalized-x (lon) - "Convert LON to normalized x coordinate." - (/ (+ lon 180.0) 360.0)) - -(defsubst osm--lat-to-normalized-y (lat) - "Convert LAT to normalized y coordinate." - (setq lat (* lat (/ float-pi 180.0))) - (- 0.5 (/ (log (+ (tan lat) (/ 1.0 (cos lat)))) float-pi 2))) - -(defun osm--boundingbox-to-zoom (lat1 lat2 lon1 lon2) - "Compute zoom level from boundingbox LAT1 to LAT2 and LON1 to LON2." - (let ((w (/ (frame-pixel-width) 256)) - (h (/ (frame-pixel-height) 256))) - (max (osm--server-property :min-zoom) - (min - (osm--server-property :max-zoom) - (min (logb (/ w (abs (- (osm--lon-to-normalized-x lon1) (osm--lon-to-normalized-x lon2))))) - (logb (/ h (abs (- (osm--lat-to-normalized-y lat1) (osm--lat-to-normalized-y lat2)))))))))) - -(defun osm--x-to-lon (x zoom) - "Return longitude in degrees for X/ZOOM." - (- (/ (* x 360.0) 256.0 (expt 2.0 zoom)) 180.0)) - -(defun osm--y-to-lat (y zoom) - "Return latitude in degrees for Y/ZOOM." - (setq y (* float-pi (- 1 (* 2 (/ y 256.0 (expt 2.0 zoom)))))) - (/ (* 180 (atan (/ (- (exp y) (exp (- y))) 2))) float-pi)) - -(defsubst osm--lon-to-x (lon zoom) - "Convert LON/ZOOM to x coordinate in pixel." - (floor (* 256 (expt 2.0 zoom) (osm--lon-to-normalized-x lon)))) - -(defsubst osm--lat-to-y (lat zoom) - "Convert LAT/ZOOM to y coordinate in pixel." - (floor (* 256 (expt 2.0 zoom) (osm--lat-to-normalized-y lat)))) - -(defsubst osm--x () - "Return longitude in pixel of map center." - (osm--lon-to-x osm--lon osm--zoom)) - -(defsubst osm--y () - "Return latitude in pixel of map center." - (osm--lat-to-y osm--lat osm--zoom)) - -(defsubst osm--x0 () - "Return longitude in pixel of top left corner." - (- (osm--x) osm--wx)) - -(defsubst osm--y0 () - "Return latitude in pixel of top left corner." - (- (osm--y) osm--wy)) - -(defun osm--server-property (prop &optional server) - "Return server property PROP for SERVER." - (or (plist-get (alist-get (or server osm-server) osm-server-list) prop) - (plist-get osm-server-defaults prop))) - -(defun osm--tile-url (x y zoom) - "Return tile url for coordinate X, Y and ZOOM." - (let ((url (osm--server-property :url)) - (sub (osm--server-property :subdomains)) - (key (osm--server-property :key))) - (when (and (string-search "%k" url) (not key)) - (require 'auth-source) - (declare-function auth-source-search "auth-source") - (let ((host (string-join - (last (split-string (cadr (split-string url "/" t)) "\\.") 2) - "."))) - (setq key (plist-get - (car (auth-source-search :require '(:user :host :secret) - :host host - :user "apikey")) - :secret)) - (unless key - (warn "No auth source secret found for apikey@%s" host) - (setq key "")) - (setf (plist-get (alist-get osm-server osm-server-list) :key) key))) - (format-spec - url `((?z . ,zoom) (?x . ,x) (?y . ,y) - (?k . ,(if (functionp key) (funcall key) key)) - (?s . ,(nth (mod (alist-get osm-server osm--download-subdomain 0) - (length sub)) - sub)))))) - -(defun osm--tile-file (x y zoom) - "Return tile file name for coordinate X, Y and ZOOM." - (file-name-concat - (expand-file-name osm-tile-directory) - (symbol-name osm-server) - (format "%d-%d-%d.%s" - zoom x y - (or (osm--server-property :ext) - (file-name-extension - (url-file-nondirectory - (osm--server-property :url))))))) - -(defun osm--enqueue-download (x y) - "Enqueue tile X/Y for download." - (when (let ((n (expt 2 osm--zoom))) (and (>= x 0) (>= y 0) (< x n) (< y n))) - (let ((job (list osm-server osm--zoom x y))) - (unless (or (member job osm--download-queue) (member job osm--download-active)) - (setq osm--download-queue (nconc osm--download-queue (list job))))))) - -(defun osm--download-filter (output) - "Filter function for the download process which receives OUTPUT." - (while (string-match - "\\`\\([0-9]+\\) \\(.*?/\\([^/]+\\)/\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\.[^\r\n]+\\)\r?\n" - output) - (let ((status (match-string 1 output)) - (file (match-string 2 output)) - (server (intern-soft (match-string 3 output))) - (zoom (string-to-number (match-string 4 output))) - (x (string-to-number (match-string 5 output))) - (y (string-to-number (match-string 6 output)))) - (setq output (substring output (match-end 0))) - (when (equal status "200") - (ignore-errors (rename-file file (string-remove-suffix ".tmp" file) t)) - (osm--each - (when (and (= osm--zoom zoom) (eq osm-server server)) - (osm--display-tile x y (osm--get-tile x y))))) - (cl-callf2 delete (list server zoom x y) osm--download-active) - (delete-file file))) - output) - -(defun osm--download-command () - "Build download command." - (let* ((count 0) - (batch (osm--server-property :download-batch)) - (subs (length (osm--server-property :subdomains))) - (parallel (* subs (osm--server-property :max-connections))) - args jobs job) - (while (and (< count batch) - (setq job (nth (* count parallel) osm--download-queue))) - (pcase-let ((`(,_server ,zoom ,x ,y) job)) - (setq args `(,(osm--tile-url x y zoom) - ,(concat (osm--tile-file x y zoom) ".tmp") - "--output" - ,@args)) - (push job jobs) - (push job osm--download-active) - (cl-incf count))) - (osm--each - (dolist (job jobs) - (cl-callf2 delq job osm--download-queue))) - (cl-callf (lambda (s) (mod (1+ s) subs)) - (alist-get osm-server osm--download-subdomain 0)) - (cons `("curl" "--write-out" "%{http_code} %{filename_effective}\n" - ,@(split-string-and-unquote osm-curl-options) ,@(nreverse args)) - jobs))) - -(defun osm--download () - "Download next tiles from the queue." - (when (and (< (length (alist-get osm-server osm--download-processes)) - (* (length (osm--server-property :subdomains)) - (osm--server-property :max-connections))) - osm--download-queue) - (pcase-let ((`(,command . ,jobs) (osm--download-command)) - (dir (file-name-concat (expand-file-name osm-tile-directory) - (symbol-name osm-server))) - (server osm-server)) - (make-directory dir t) - (push - (make-process - :name "*osm curl*" - :connection-type 'pipe - :noquery t - :command command - :filter - (let ((output "")) - (lambda (_proc out) - (setq output (osm--download-filter (concat output out))) - (force-mode-line-update t))) - :sentinel - (lambda (proc _status) - (dolist (job jobs) - (cl-callf2 delq job osm--download-active)) - (cl-callf2 delq proc (alist-get server osm--download-processes nil t)) - (force-mode-line-update t) - (osm--download))) - (alist-get server osm--download-processes)) - (force-mode-line-update t) - (osm--download)))) - -(defun osm-mouse-drag (event) - "Handle drag EVENT." - (declare (completion ignore)) - (interactive "@e") - (pcase-let* ((`(,sx . ,sy) (posn-x-y (event-start event))) - (win (selected-window)) - (map (define-keymap - "<mouse-movement>" - (lambda (event) - (interactive "e") - (setq event (event-start event)) - (when (eq win (posn-window event)) - (pcase-let ((`(,ex . ,ey) (posn-x-y event))) - (osm--move (- sx ex) (- sy ey)) - (setq sx ex sy ey) - (osm--update))))))) - (setq track-mouse 'dragging) - (set-transient-map map - (lambda () (eq (car-safe last-input-event) 'mouse-movement)) - (lambda () (setq track-mouse nil))))) - -(defun osm--zoom-in-wheel (_n) - "Zoom in with the mouse wheel." - (pcase-let ((`(,x . ,y) (posn-x-y (event-start last-input-event)))) - (when (< osm--zoom (osm--server-property :max-zoom)) - (osm--move (/ (- x osm--wx) 2) (/ (- y osm--wy) 2)) - (osm-zoom-in)))) - -(defun osm--zoom-out-wheel (_n) - "Zoom out with the mouse wheel." - (pcase-let ((`(,x . ,y) (posn-x-y (event-start last-input-event)))) - (when (> osm--zoom (osm--server-property :min-zoom)) - (osm--move (- osm--wx x) (- osm--wy y)) - (osm-zoom-out)))) - -(defun osm-center () - "Center to location of selected pin." - (interactive nil osm-mode) - (osm--barf-unless-osm) - (pcase osm--pin - (`(,lat ,lon ,_id ,name) - (setq osm--lat lat osm--lon lon) - (message "%s" name) - (osm--update)))) - -(defun osm--haversine (lat1 lon1 lat2 lon2) - "Compute distance between LAT1/LON1 and LAT2/LON2 in km." - ;; https://en.wikipedia.org/wiki/Haversine_formula - (let* ((rad (/ float-pi 180)) - (y (sin (* 0.5 rad (- lat2 lat1)))) - (x (sin (* 0.5 rad (- lon2 lon1)))) - (h (+ (* x x) (* (cos (* rad lat1)) (cos (* rad lat2)) y y)))) - (* 2 6371 (atan (sqrt h) (sqrt (- 1 h)))))) - -(defun osm-mouse-track (event) - "Set track pin at location of the click EVENT." - (declare (completion ignore)) - (interactive "@e") - (pcase osm--pin - ((and (guard (not osm--track)) `(,lat ,lon ,_id ,_name)) - (push (list lat lon "WP1") osm--track))) - (osm--set-pin-event event 'osm-track - (format "WP%s" (1+ (length osm--track))) 'quiet) - (pcase-let ((`(,lat ,lon ,_id ,name) osm--pin)) - (push (list lat lon name) osm--track)) - (osm--revert) - (osm--track-length)) - -(defun osm--track-length () - "Echo track length." - (when (cdr osm--track) - (pcase-let* ((len1 0) - (len2 0) - (p osm--track) - (`(,sel-lat ,sel-lon ,_ ,sel-name) osm--pin)) - (while (and (cdr p) (not (and (equal (caar p) sel-lat) - (equal (cadar p) sel-lon)))) - (cl-incf len2 (osm--haversine (caar p) (cadar p) - (caadr p) (cadadr p))) - (pop p)) - (while (cdr p) - (cl-incf len1 (osm--haversine (caar p) (cadar p) - (caadr p) (cadadr p))) - (pop p)) - (message "%s way points, length %.2fkm, %s" - (length osm--track) (+ len1 len2) - (if (or (= len1 0) (= len2 0)) - sel-name - (format "%.2fkm → %s → %.2fkm" - len1 sel-name len2)))))) - -(defun osm--pin-at (event &optional type) - "Get pin of TYPE at EVENT." - (let* ((xy (posn-x-y (event-start event))) - (x (+ (osm--x0) (car xy))) - (y (+ (osm--y0) (cdr xy))) - (min most-positive-fixnum) - found) - (dolist (pin (car (osm--get-overlays (/ x 256) (/ y 256)))) - (pcase-let ((`(,p ,q ,_lat ,_lon ,id ,_name) pin)) - (when (or (not type) (eq type id)) - (let ((d (+ (* (- p x) (- p x)) (* (- q y) (- q y))))) - (when (and (>= q y) (< q (+ y 50)) (>= p (- x 20)) (< p (+ x 20)) (< d min)) - (setq min d found pin)))))) - (cddr found))) - -(defun osm-mouse-pin (event) - "Create location pin at the click EVENT." - (declare (completion ignore)) - (interactive "@e") - (osm--set-pin-event event) - (osm--update)) - -(defun osm-mouse-select (event) - "Select pin at position of click EVENT." - (declare (completion ignore)) - (interactive "@e") - (when (memq (event-basic-type event) '(mouse-1 mouse-2 mouse-3)) - (pcase (osm--pin-at event) - (`(,lat ,lon ,id ,name) - (osm--set-pin id lat lon name (eq id 'osm-track)) - (when (eq id 'osm-track) (osm--track-length)) - (osm--update))))) - -(defun osm-zoom-in (&optional n) - "Zoom N times into the map." - (interactive "p" osm-mode) - (osm--barf-unless-osm) - (setq osm--zoom (max (osm--server-property :min-zoom) - (min (osm--server-property :max-zoom) - (+ osm--zoom (or n 1))))) - (osm--update)) - -(defun osm-zoom-out (&optional n) - "Zoom N times out of the map." - (interactive "p" osm-mode) - (osm-zoom-in (- (or n 1)))) - -(defun osm--move (dx dy) - "Move by DX/DY." - (osm--barf-unless-osm) - (setq osm--lon (osm--x-to-lon (+ (osm--x) dx) osm--zoom) - osm--lat (osm--y-to-lat (+ (osm--y) dy) osm--zoom))) - -(defun osm-right (&optional n) - "Move N small steps to the right." - (interactive "p" osm-mode) - (osm--move (* (or n 1) osm-small-step) 0) - (osm--update)) - -(defun osm-down (&optional n) - "Move N small steps down." - (interactive "p" osm-mode) - (osm--move 0 (* (or n 1) osm-small-step)) - (osm--update)) - -(defun osm-up (&optional n) - "Move N small steps up." - (interactive "p" osm-mode) - (osm-down (- (or n 1)))) - -(defun osm-left (&optional n) - "Move N small steps to the left." - (interactive "p" osm-mode) - (osm-right (- (or n 1)))) - -(defun osm-right-right (&optional n) - "Move N large steps to the right." - (interactive "p" osm-mode) - (osm--move (* (or n 1) osm-large-step) 0) - (osm--update)) - -(defun osm-down-down (&optional n) - "Move N large steps down." - (interactive "p" osm-mode) - (osm--move 0 (* (or n 1) osm-large-step)) - (osm--update)) - -(defun osm-up-up (&optional n) - "Move N large steps up." - (interactive "p" osm-mode) - (osm-down-down (- (or n 1)))) - -(defun osm-left-left (&optional n) - "Move N large steps to the left." - (interactive "p" osm-mode) - (osm-right-right (- (or n 1)))) - -(defun osm--purge-directory () - "Clean tile directory." - (when (and (integerp osm-max-age) - (> (- (float-time) osm--purge-directory) (* 60 60 24))) - (setq osm--purge-directory (float-time)) - (run-with-idle-timer - 30 nil - (lambda () - (dolist (dir (directory-files osm-tile-directory t "\\`[^.]+\\'" t)) - (dolist (file (directory-files - dir t "\\.\\(?:png\\|jpe?g\\)\\(?:\\.tmp\\)?\\'" t)) - (when (> (float-time (time-since - (file-attribute-modification-time - (file-attributes file)))) - (* 60 60 24 osm-max-age)) - (delete-file file))) - (when (directory-empty-p dir) - (ignore-errors (delete-directory dir)))))))) - -(defun osm--check-libraries () - "Check that Emacs is compiled with the necessary libraries." - (let (req) - (unless (display-graphic-p) - (push "graphical display" req)) - (dolist (type '(svg jpeg png)) - (unless (image-type-available-p type) - (push (format "%s support" type) req))) - (unless (libxml-available-p) - (push "libxml" req)) - (unless (json-available-p) - (push "libjansson" req)) - (when req - (error "Osm: Please compile Emacs with the required libraries, %s needed to proceed" - (string-join req ", "))))) - -(define-derived-mode osm-mode special-mode "Osm" - "OpenStreetMap viewer mode." - :interactive nil :abbrev-table nil :syntax-table nil - (osm--check-libraries) - (setq-local osm-server osm-server - line-spacing nil - cursor-type nil - cursor-in-non-selected-windows nil - left-fringe-width 1 - right-fringe-width 1 - left-margin-width 0 - right-margin-width 0 - truncate-lines t - show-trailing-whitespace nil - display-line-numbers nil - buffer-read-only t - fringe-indicator-alist '((truncation . nil)) - revert-buffer-function #'osm--revert - mode-line-process '(:eval (osm--download-queue-info)) - mode-line-position nil - mode-line-modified nil - mode-line-mule-info nil - mode-line-remote nil - default-directory (expand-file-name "~/") - eldoc-documentation-functions nil - mouse-wheel-progressive-speed nil - mwheel-scroll-up-function #'osm--zoom-out-wheel - mwheel-scroll-down-function #'osm--zoom-in-wheel - mwheel-scroll-left-function #'osm--zoom-out-wheel - mwheel-scroll-right-function #'osm--zoom-in-wheel - bookmark-make-record-function #'osm--bookmark-record-default) - (when (boundp 'mwheel-coalesce-scroll-events) - (setq-local mwheel-coalesce-scroll-events t)) - (when (boundp 'pixel-scroll-precision-mode) - (setq-local pixel-scroll-precision-mode nil)) - (add-hook 'change-major-mode-hook #'osm--barf-change-mode nil 'local) - (add-hook 'write-contents-functions #'osm--barf-write nil 'local) - (add-hook 'window-size-change-functions #'osm--resize nil 'local)) - -(defun osm--barf-write () - "Barf for write operation." - (set-buffer-modified-p nil) - (setq buffer-read-only t) - (set-visited-file-name nil) - (error "Writing the buffer to a file is not supported")) - -(defun osm--barf-change-mode () - "Barf for change mode operation." - (error "Changing the major mode is not supported")) - -(defun osm--barf-unless-osm () - "Barf if not an `osm-mode' buffer." - (unless (eq major-mode #'osm-mode) - (error "Not an `osm-mode' buffer"))) - -(defun osm--each-pin (fun) - "Call FUN for each pin on the map." - (pcase osm-home - (`(,lat ,lon ,zoom) - (funcall fun 'osm-home lat lon zoom "Home"))) - (bookmark-maybe-load-default-file) - (cl-loop for bm in bookmark-alist - if (eq (bookmark-prop-get bm 'handler) #'osm-bookmark-jump) do - (pcase-let ((`(,lat ,lon ,zoom) (bookmark-prop-get bm 'coordinates))) - (funcall fun 'osm-bookmark lat lon zoom (car bm)))) - (dolist (file osm--gpx-files) - (cl-loop for (lat lon name) in (cddr file) do - (funcall fun 'osm-poi lat lon 15 name))) - (cl-loop for (lat lon name) in osm--track do - (funcall fun 'osm-track lat lon 15 name))) - -(defun osm--pin-inside-p (x y lat lon) - "Return non-nil if pin at LAT/LON is inside tile X/Y." - (let ((p (/ (osm--lon-to-x lon osm--zoom) 256.0)) - (q (/ (osm--lat-to-y lat osm--zoom) 256.0))) - (and (>= p (- x 0.125)) (< p (+ x 1.125)) - (>= q y) (< q (+ y 1.25))))) - -(defun osm--add-pin (pins id lat lon _zoom name) - "Add pin at LAT/LON with NAME and ID to the PINS hash table." - (let* ((x (osm--lon-to-x lon osm--zoom)) - (y (osm--lat-to-y lat osm--zoom)) - (x0 (/ x 256)) - (y0 (/ y 256)) - (pin (list x y lat lon id name))) - (push pin (gethash (cons x0 y0) pins)) - (cl-loop - for i from -1 to 1 do - (cl-loop - for j from -1 to 0 do - (let ((x1 (/ (+ x (* 32 i)) 256)) - (y1 (/ (+ y (* 64 j)) 256))) - (unless (and (= x0 x1) (= y0 y1)) - (push pin (gethash (cons x1 y1) pins)))))))) - -;; TODO: The Bresenham algorithm used here to add the line segments to the tiles -;; has the issue that lines which go along a tile border may be drawn only -;; partially. Use a more precise algorithm instead. -(defun osm--add-track (tracks seg) - "Add track segment SEG to TRACKS hash table." - (when seg - (let ((p0 (cons (osm--lon-to-x (or (car-safe (cdar seg)) (cdar seg)) osm--zoom) - (osm--lat-to-y (caar seg) osm--zoom)))) - (dolist (pt (cdr seg)) - (let* ((px1 (cdr pt)) - (px1 (osm--lon-to-x (if (consp px1) (car px1) px1) osm--zoom)) - (py1 (osm--lat-to-y (car pt) osm--zoom)) - (pdx (- px1 (car p0))) - (pdy (- py1 (cdr p0)))) - ;; Ignore point if too close to last point - (unless (< (+ (* pdx pdx) (* pdy pdy)) 50) - (let* ((p1 (cons px1 py1)) - (line (cons p0 p1)) - (x0 (/ (car p0) 256)) - (y0 (/ (cdr p0) 256)) - (x1 (/ px1 256)) - (y1 (/ py1 256)) - (sx (if (< x0 x1) 1 -1)) - (sy (if (< y0 y1) 1 -1)) - (dx (* sx (- x1 x0))) - (dy (* sy (- y0 y1))) - (err (+ dx dy))) - ;; Bresenham - (while - (let ((ey (> (* err 2) dy)) - (ex (< (* err 2) dx))) - (push line (gethash (cons x0 y0) tracks)) - (unless (and (= x0 x1) (= y0 y1)) - (when (and ey ex) - (push line (gethash (cons x0 (+ y0 sy)) tracks)) - (push line (gethash (cons (+ x0 sx) y0) tracks))) - (when ey - (cl-incf err dy) - (cl-incf x0 sx)) - (when ex - (cl-incf err dx) - (cl-incf y0 sy)) - t))) - (setq p0 p1)))))))) - -(defun osm--get-overlays (x y) - "Compute overlays and return the overlays in tile X/Y." - (unless (eq (car osm--overlays) osm--zoom) - ;; TODO: Do not compute overlays for the entire map, only for a reasonable - ;; view port around the current center, depending on the size of the - ;; window. Otherwise the spatial hash map for the tracks gets very large if - ;; a line segment spans many tiles. - (let ((pins (make-hash-table :test #'equal)) - (tracks (make-hash-table :test #'equal))) - (osm--each-pin (apply-partially #'osm--add-pin pins)) - (dolist (file osm--gpx-files) - (dolist (seg (cadr file)) - (osm--add-track tracks seg))) - (osm--add-track tracks osm--track) - (setq osm--overlays (list osm--zoom pins tracks)))) - (let ((pins (gethash (cons x y) (cadr osm--overlays))) - (tracks (gethash (cons x y) (caddr osm--overlays)))) - (and (or pins tracks) (cons pins tracks)))) - -(autoload 'svg--image-data "svg") -(defun osm--draw-tile (x y tpin) - "Make tile at X/Y from FILE. -TPIN is an optional pin." - (let ((file (osm--tile-file x y osm--zoom)) - overlays) - (when (file-exists-p file) - (if (or (setq overlays (osm--get-overlays x y)) (eq osm-tile-border t) tpin) - (let* ((areas nil) - (x0 (* 256 x)) - (y0 (* 256 y)) - (svg-pin - (lambda (pin) - (pcase-let* ((`(,p ,q ,_lat ,_lon ,id ,name) pin) - (bg (cdr (assq id osm-pin-colors)))) - (setq p (- p x0) q (- q y0)) - (push `((poly . [,p ,q ,(- p 20) ,(- q 40) ,p ,(- q 50) ,(+ p 20) ,(- q 40) ]) - ,id (help-echo ,(truncate-string-to-width name 40 0 nil t))) - areas) - ;; https://commons.wikimedia.org/wiki/File:Simpleicons_Places_map-marker-1.svg - (format " -<g fill='%s' stroke='#000' stroke-width='9' transform='translate(%s %s) scale(0.09) translate(-256 -512)'> -<path d='M256 0C167.641 0 96 71.625 96 160c0 24.75 5.625 48.219 15.672 -69.125C112.234 230.313 256 512 256 512l142.594-279.375 -C409.719 210.844 416 186.156 416 160C416 71.625 344.375 -0 256 0z M256 256c-53.016 0-96-43-96-96s42.984-96 96-96 -c53 0 96 43 96 96S309 256 256 256z'/> -</g>" bg p q)))) - (svg-text - (concat "<svg width='256' height='256' version='1.1' -xmlns='http://www.w3.org/2000/svg' xmlns:xlink='http://www.w3.org/1999/xlink'> -<image xlink:href='" - (file-name-nondirectory file) - "' height='256' width='256'/>" - (when-let (track (cdr overlays)) - (format - "<path style='%s' d='%s'/>" - osm-track-style - (let (last) - (mapconcat - (pcase-lambda (`(,beg . ,end)) - (prog1 - (if (equal beg last) - (format "L%s %s" (- (car end) x0) (- (cdr end) y0)) - (format "M%s %sL%s %s" - (- (car beg) x0) (- (cdr beg) y0) - (- (car end) x0) (- (cdr end) y0))) - (setq last end))) - track "")))) - (pcase-exhaustive osm-tile-border - ('nil nil) - ('debug "<path d='M 1 1 L 1 255 255 255 255 1 Z' stroke='#000' stroke-width='2' fill='none'/>") - ('t "<path d='M 0 0 L 0 256 256 256' stroke='#000' fill='none'/>")) - (mapconcat svg-pin (car overlays) "") - (and tpin (funcall svg-pin tpin)) - "</svg>"))) - (list 'image :width 256 :height 256 :type 'svg :base-uri file :data svg-text :map areas)) - (list 'image :width 256 :height 256 :file file :type - (if (member (file-name-extension file) '("jpg" "jpeg")) - 'jpeg 'png)))))) - -(defun osm--get-tile (x y) - "Get tile at X/Y." - (pcase osm--pin - ((and `(,lat ,lon ,_id ,name) - (guard (osm--pin-inside-p x y lat lon))) - (osm--draw-tile x y (list (osm--lon-to-x lon osm--zoom) - (osm--lat-to-y lat osm--zoom) - lat lon 'osm-selected name))) - (_ - (let* ((key `(,osm-server ,osm--zoom ,x . ,y)) - (tile (and osm--tile-cache (gethash key osm--tile-cache)))) - (if tile - (progn (setcar tile osm--tile-age) (cdr tile)) - (setq tile (osm--draw-tile x y nil)) - (when tile - (when osm-max-tiles - (unless osm--tile-cache - (setq osm--tile-cache (make-hash-table :test #'equal :size osm-max-tiles))) - (puthash key (cons osm--tile-age tile) osm--tile-cache)) - tile)))))) - -(defun osm--display-tile (x y tile) - "Display TILE at X/Y." - (let ((i (- x (/ (osm--x0) 256))) - (j (- y (/ (osm--y0) 256)))) - (when (and (>= i 0) (< i osm--nx) (>= j 0) (< j osm--ny)) - (let* ((mx (if (= 0 i) (mod (osm--x0) 256) 0)) - (my (if (= 0 j) (mod (osm--y0) 256) 0)) - (pos (+ (point-min) (* j (1+ osm--nx)) i))) - (unless tile - (setq tile (cons 'image osm--placeholder))) - (with-silent-modifications - (put-text-property - pos (1+ pos) 'display - (if (or (/= 0 mx) (/= 0 my)) - `((slice ,mx ,my ,(- 256 mx) ,(- 256 my)) ,tile) - tile))))))) - -;;;###autoload -(defun osm-home () - "Go to home coordinates." - (interactive) - (pcase osm-home - (`(,lat ,lon ,zoom) - (osm--goto lat lon zoom nil 'osm-home "Home")))) - -(defun osm--download-queue-info () - "Return queue info string." - (when osm--download-processes - (format "[%s/%s/%s]" - (cl-loop for (_ . p) in osm--download-processes sum (length p)) - (length osm--download-active) - (length osm--download-queue)))) - -(defun osm--revert (&rest _) - "Revert osm buffers." - (clear-image-cache t) ;; Make absolutely sure that the tiles are redrawn. - (setq osm--tile-cache nil) - (osm--each - (setq osm--overlays nil) - (osm--update))) - -(defun osm--resize (&rest _) - "Resize buffer." - (when (eq major-mode #'osm-mode) - (osm--update))) - -(defun osm--header-button (text action) - "Format header line button with TEXT and ACTION." - (propertize text - 'keymap (define-keymap "<header-line> <mouse-1>" - (if (commandp action) - (lambda () - (interactive "@") - (call-interactively action)) - action)) - 'face '(:box (:line-width -2 :style released-button)) - 'mouse-face '(:box (:line-width -2 :style pressed-button)))) - -(defun osm--update-header () - "Update header line." - (let* ((meter-per-pixel (/ (* 156543.03 (cos (/ osm--lat (/ 180.0 float-pi)))) (expt 2 osm--zoom))) - (server (osm--server-property :name)) - (meter 1) (idx 0) - (factor '(2 2.5 2)) - (sep #(" " 0 1 (display (space :width (1)))))) - (while (and (< idx 20) (< (/ (* meter (nth (mod idx 3) factor)) meter-per-pixel) 150)) - (setq meter (round (* meter (nth (mod idx 3) factor)))) - (cl-incf idx)) - (setq-local - header-line-format - (list - (osm--header-button " ☰ " (osm--menu-item osm-mode-menu)) sep - (osm--header-button (format " %s " server) - (osm--menu-item #'osm--server-menu)) sep - (osm--header-button " + " #'osm-zoom-in) sep - (osm--header-button " - " #'osm-zoom-out) - (format " Z%-2d " osm--zoom) - #(" " 0 1 (display (space :align-to (- center 15)))) - (format #(" %7.2f° %7.2f°" 0 14 (face bold)) osm--lat osm--lon) - #(" " 0 1 (display (space :align-to (- right 20)))) - (format "%3s " (if (>= meter 1000) (/ meter 1000) meter)) - (if (>= meter 1000) "km " "m ") - #(" " 0 1 (face (:inverse-video t) display (space :width (3)))) - (propertize " " 'face '(:strike-through t) - 'display `(space :width (,(floor (/ meter meter-per-pixel))))) - #(" " 0 1 (face (:inverse-video t) display (space :width (3)))))))) - -(defun osm--update () - "Update map display." - (osm--barf-unless-osm) - (osm--purge-tile-cache) - (osm--purge-directory) - (osm--rename-buffer) - (osm--update-sizes) - (osm--update-header) - (osm--update-buffer) - (osm--update-copyright) - (osm--process-download-queue)) - -(defun osm--update-sizes () - "Update window sizes." - (let* ((windows (or (get-buffer-window-list) (list (frame-root-window)))) - (win-width (cl-loop for w in windows maximize (window-pixel-width w))) - (win-height (cl-loop for w in windows maximize (window-pixel-height w)))) - (setq osm--wx (/ win-width 2) - osm--wy (/ win-height 2) - osm--nx (1+ (ceiling win-width 256)) - osm--ny (1+ (ceiling win-height 256))))) - -(defun osm--copyright-link (text url) - "Format link with TEXT to URL." - (propertize text - 'face 'button - 'mouse-face 'highlight - 'help-echo - (format "Go to %s" url) - 'keymap - (define-keymap "<tab-line> <mouse-1>" - (lambda () - (interactive) - (browse-url url))))) - -(defun osm--update-copyright () - "Update copyright info." - (let ((copyright (and osm-copyright (osm--server-property :copyright)))) - (if (not copyright) - (when (eq 'osm-copyright (car-safe tab-line-format)) - (kill-local-variable 'tab-line-format)) - (setq copyright (replace-regexp-in-string - "{\\(.*?\\)|\\(.*?\\)}" - (lambda (str) - (osm--copyright-link - (match-string 1 str) - (match-string 2 str))) - (concat - " " - (string-join (ensure-list copyright) " | ") - #(" " 0 1 (display (space :align-to (+ 42 right))))))) - (add-face-text-property - 0 (length copyright) - '(:inherit (header-line variable-pitch) :height 0.65) - t copyright) - (setq-local tab-line-format (list 'osm-copyright copyright))))) - -(defun osm--update-buffer () - "Update buffer display." - (with-silent-modifications - (erase-buffer) - (dotimes (_j osm--ny) - (insert (make-string osm--nx ?\s) "\n")) - (put-text-property (point-min) (point-max) 'pointer 'arrow) - (goto-char (point-min)) - (let ((tx (/ (osm--x0) 256)) - (ty (/ (osm--y0) 256))) - (dotimes (j osm--ny) - (dotimes (i osm--nx) - (let* ((x (+ i tx)) - (y (+ j ty)) - (tile (osm--get-tile x y))) - (osm--display-tile x y tile) - (unless tile (osm--enqueue-download x y)))))))) - -(defun osm--process-download-queue () - "Process the download queue." - (setq osm--download-queue - (sort - (cl-loop with tx = (/ (osm--x0) 256) - with ty = (/ (osm--y0) 256) - for job in osm--download-queue - for (_server zoom x y) = job - if (and (= zoom osm--zoom) - (>= x tx) (< x (+ tx osm--nx)) - (>= y ty) (< y (+ ty osm--ny))) - collect job) - (let ((tx (/ (osm--x) 256)) - (ty (/ (osm--y) 256))) - (pcase-lambda (`(,_s1 ,_z1 ,x1 ,y1) `(,_s2 ,_z2 ,x2 ,y2)) - (setq x1 (- x1 tx) y1 (- y1 ty) x2 (- x2 tx) y2 (- y2 ty)) - (< (+ (* x1 x1) (* y1 y1)) (+ (* x2 x2) (* y2 y2))))))) - (osm--download)) - -(defun osm--purge-tile-cache () - "Purge old tiles from the tile cache." - (cl-incf osm--tile-age) - (when (and osm--tile-cache (> (hash-table-count osm--tile-cache) osm-max-tiles)) - (let (items) - (maphash (lambda (k v) (push (list (car v) (cdr v) k) items)) osm--tile-cache) - (setq items (sort items #'car-less-than-car)) - (cl-loop repeat (- (hash-table-count osm--tile-cache) osm-max-tiles) - for (_age tile key) in items do - (image-flush tile t) - (remhash key osm--tile-cache))))) - -(defun osm--bookmark-record-default () - "Make osm bookmark record." - (osm--bookmark-record (osm--bookmark-name osm--lat osm--lon nil) - osm--lat osm--lon nil)) - -(defun osm--bookmark-record (name lat lon loc) - "Make osm bookmark record with NAME and LOC description at LAT/LON." - (setq bookmark-current-bookmark nil) ;; Reset bookmark to use new name - `(,name - (location . ,(osm--location-name lat lon loc 6)) - (coordinates ,lat ,lon ,osm--zoom) - (server . ,osm-server) - (handler . ,#'osm-bookmark-jump))) - -(defun osm--org-link-props () - "Return Org link properties." - (pcase-let* ((`(,lat ,lon ,loc) (osm--fetch-location-data "New Org Link")) - (name (osm--location-name lat lon loc 2))) - (list :type "geo" - :description - (if (eq osm-server (default-value 'osm-server)) - (string-remove-suffix (concat " " (osm--server-property :name)) - name) - name) - :link - (format "geo:%.6f,%.6f;z=%s%s" - lat lon osm--zoom - (if (eq osm-server (default-value 'osm-server)) "" - (format ";s=%s" osm-server)))))) - -(defun osm--rename-buffer () - "Rename current buffer." - (setq list-buffers-directory (osm--location-name osm--lat osm--lon nil 6)) - (rename-buffer - (format "*osm: %s*" (osm--location-name osm--lat osm--lon nil 2)) - 'unique)) - -(defun osm--location-name (lat lon loc prec) - "Format location string LAT/LON with optional LOC description. -The coordinates are formatted with precision PREC." - (format (format "%%s%%.%df° %%.%df° Z%%s %%s" prec prec) - (if loc (concat loc ", ") "") - lat lon osm--zoom (osm--server-property :name))) - -(defun osm--bookmark-name (lat lon loc) - "Return bookmark name for LAT/LON/LOC." - (concat "osm: " (osm--location-name lat lon loc 2))) - -(defun osm--goto (lat lon zoom server id name) - "Go to LAT/LON/ZOOM, change SERVER. -Optionally place pin with ID and NAME." - ;; Server not found - (when (and server (not (assq server osm-server-list))) (setq server nil)) - (with-current-buffer - (or - (and (eq major-mode #'osm-mode) (current-buffer)) - (let ((def-server (or server osm-server)) - (def-lat (or lat (nth 0 osm-home))) - (def-lon (or lon (nth 1 osm-home))) - (def-zoom (or zoom (nth 2 osm-home)))) - ;; Search for existing buffer - (cl-loop - for buf in (buffer-list) thereis - (and (equal (buffer-local-value 'major-mode buf) #'osm-mode) - (equal (buffer-local-value 'osm-server buf) def-server) - (equal (buffer-local-value 'osm--zoom buf) def-zoom) - (equal (buffer-local-value 'osm--lat buf) def-lat) - (equal (buffer-local-value 'osm--lon buf) def-lon) - buf))) - (generate-new-buffer "*osm*")) - (unless (eq major-mode #'osm-mode) - (osm-mode)) - (when (and server (not (eq osm-server server))) - (setq-local osm-server server - osm--download-queue nil)) - (when (or (not (and osm--lon osm--lat)) lat) - (setq osm--lat (or lat (nth 0 osm-home)) - osm--lon (or lon (nth 1 osm-home)) - osm--zoom (or zoom (nth 2 osm-home))) - (when id - (osm--set-pin id osm--lat osm--lon name))) - (prog1 (pop-to-buffer (current-buffer)) - (osm--update)))) - -(defun osm--set-pin (id lat lon name &optional quiet) - "Set pin at LAT/LON with ID and NAME. -Print NAME if not QUIET." - (setq name (or name (format "Location %.6f° %.6f°" lat lon))) - (setq osm--pin (list lat lon (or id 'osm-selected) name)) - (unless quiet (message "%s" name))) - -(defun osm--set-pin-event (event &optional id name quiet) - "Set selection pin with ID and NAME at location of EVENT. -Print NAME if not QUIET." - (pcase-let ((`(,x . ,y) (posn-x-y (event-start event)))) - (osm--set-pin id - (osm--y-to-lat (+ (osm--y0) y) osm--zoom) - (osm--x-to-lon (+ (osm--x0) x) osm--zoom) - name quiet))) - -;;;###autoload -(defun osm-goto (lat lon zoom) - "Go to LAT/LON/ZOOM." - (interactive - (pcase-let ((`(,lat ,lon ,zoom) - (mapcar #'string-to-number - (split-string (read-string "Lat Lon (Zoom): ") nil t)))) - (setq zoom (or zoom osm--zoom 11)) - (unless (and (numberp lat) (numberp lon) (numberp zoom)) - (error "Invalid coordinate")) - (list lat lon zoom))) - (osm--goto lat lon zoom nil 'osm-selected nil) - nil) - -;;;###autoload -(defun osm (&rest link) - "Go to LINK. -When called interactively, call the function `osm-home'." - (interactive (list 'home)) - (pcase link - ('(home) - (osm-home)) - (`(,lat ,lon ,zoom . ,server) - (setq server (car server)) - (unless (and server (symbolp server)) (setq server nil)) ;; Ignore comment - (osm--goto lat lon zoom server 'osm-selected "Elisp Link")) - ((and `(,url . ,_) (guard (stringp url))) - (if (string-match - "\\`geo:\\([0-9.-]+\\),\\([0-9.-]+\\)\\(?:,[0-9.-]+\\)?\\(;.+\\'\\|\\'\\)" url) - (let* ((lat (string-to-number (match-string 1 url))) - (lon (string-to-number (match-string 2 url))) - (args (url-parse-args (match-string 3 url) "")) - (zoom (cdr (assoc "z" args))) - (server (cdr (assoc "s" args)))) - (osm--goto lat lon - (and zoom (string-to-number zoom)) - (and server (intern-soft server)) - 'osm-selected "Geo Link")) - (osm-search (string-remove-prefix "geo:" url)))) - (_ (error "Invalid osm link")))) - -;;;###autoload -(defun osm-bookmark-jump (bm) - "Jump to osm bookmark BM." - (interactive (list (osm--bookmark-read))) - (pcase-let ((`(,lat ,lon ,zoom) (bookmark-prop-get bm 'coordinates))) - (set-buffer (osm--goto lat lon zoom - (bookmark-prop-get bm 'server) - 'osm-bookmark (car bm))))) -(put 'osm-bookmark-jump 'bookmark-handler-type "Osm") - -;;;###autoload -(defun osm-bookmark-delete (bm) - "Delete osm bookmark BM." - (interactive (list (osm--bookmark-read))) - (when (y-or-n-p (format "Delete bookmark `%s'? " bm)) - (bookmark-delete bm) - (setq osm--pin nil) - (osm--revert))) - -;;;###autoload -(defun osm-bookmark-rename (old-name) - "Rename osm bookmark OLD-NAME." - (interactive (list (car (osm--bookmark-read)))) - (let ((new-name (read-from-minibuffer "New name: " old-name nil nil - 'bookmark-history old-name))) - (when osm--pin (setf (cadddr osm--pin) new-name)) - (bookmark-rename old-name new-name) - (osm--revert))) - -(defun osm--bookmark-read () - "Read bookmark name." - (bookmark-maybe-load-default-file) - (or (assoc - (pcase osm--pin - (`(,_lat ,_lon osm-bookmark ,name) name) - (_ (completing-read - "Bookmark: " - (or (cl-loop for bm in bookmark-alist - if (eq (bookmark-prop-get bm 'handler) #'osm-bookmark-jump) - collect (car bm)) - (error "No bookmarks found")) - nil t nil 'bookmark-history))) - bookmark-alist) - (error "No bookmark selected"))) - -(defun osm-bookmark-set () - "Create osm bookmark." - (interactive nil osm-mode) - (osm--barf-unless-osm) - (unwind-protect - (pcase-let* ((`(,lat ,lon ,loc) (osm--fetch-location-data "New Bookmark")) - (def (osm--bookmark-name lat lon loc)) - (name (read-from-minibuffer "Bookmark name: " def nil nil 'bookmark-history def)) - (bookmark-make-record-function - (lambda () (osm--bookmark-record name lat lon loc)))) - (bookmark-set name) - (message "Stored bookmark: %s" name) - (setf (caddr osm--pin) 'osm-bookmark)) - (osm--revert))) - -(defun osm--fetch-location-data (name) - "Fetch location info for NAME." - (when (mouse-event-p last-input-event) - (osm--set-pin-event last-input-event 'osm-selected name)) - (let ((lat (or (car osm--pin) osm--lat)) - (lon (or (cadr osm--pin) osm--lon))) - (osm--set-pin 'osm-selected lat lon name 'quiet) - (message "%s: Fetching name of %.2f° %.2f° from %s..." name lat lon osm-search-server) - ;; Redisplay before slow fetching - (osm--update) - (redisplay) - (list lat lon - (ignore-errors - (alist-get - 'display_name - (osm--fetch-json - (format "%s/reverse?format=json&accept-language=%s&zoom=%s&lat=%s&lon=%s" - osm-search-server osm-search-language - (min 18 (max 3 osm--zoom)) lat lon))))))) - -(defun osm--track-index () - "Return index of selected track way point." - (cl-loop for idx from 0 for (lat lon _) in osm--track - if (and (equal lat (car osm--pin)) (equal lon (cadr osm--pin))) - return idx)) - -(defun osm--track-delete () - "Delete track way point." - (when-let ((idx (osm--track-index))) - ;; Delete pin - (cl-callf2 delq (nth idx osm--track) osm--track) - (setq osm--pin nil - idx (min idx (1- (length osm--track)))) - ;; Select next pin - (pcase (nth idx osm--track) - (`(,lat ,lon ,name) - (osm--set-pin 'osm-track lat lon name 'quiet))) - ;; Rename pins after deletion - (cl-loop for idx from (length osm--track) downto 1 - for pt in osm--track - if (string-match-p "\\`WP[0-9]+\\'" (caddr pt)) do - (setf (caddr pt) (format "WP%s" idx))) - (osm--track-length) - (osm--revert))) - -(defun osm--track-rename () - "Rename track way point." - (when-let ((pt (nth (osm--track-index) osm--track)) - (old-name (caddr pt)) - (new-name (read-from-minibuffer "New name: " old-name nil nil nil old-name))) - (setf (caddr pt) new-name - (cadddr osm--pin) new-name) - (osm--revert))) - -(defun osm-delete () - "Delete selected pin (bookmark or way point)." - (interactive nil osm-mode) - (osm--barf-unless-osm) - (pcase (caddr osm--pin) - ('nil nil) - ('osm-bookmark (osm-bookmark-delete (cadddr osm--pin))) - ('osm-track (osm--track-delete)) - (_ (setq osm--pin nil) (osm--update)))) - -(defun osm-rename () - "Rename selected pin (bookmark or way point)." - (interactive nil osm-mode) - (osm--barf-unless-osm) - (pcase (caddr osm--pin) - ('osm-bookmark (osm-bookmark-rename (cadddr osm--pin))) - ('osm-track (osm--track-rename)))) - -;;;###autoload -(defun osm-jump () - "Jump to named pin." - (interactive) - (let (pins) - (osm--each-pin (lambda (id lat lon zoom name) - (push (list name (capitalize (substring (symbol-name id) 4)) - id lat lon zoom) - pins))) - (pcase (assoc (completing-read - "Jump: " - (lambda (str pred action) - (if (eq action 'metadata) - `(metadata - (group-function - . ,(lambda (pin transform) - (if transform pin - (cadr (assoc pin pins)))))) - (complete-with-action action pins str pred))) - nil t nil 'osm--jump-history) - pins) - (`(,name ,_group ,id ,lat ,lon ,zoom) (osm--goto lat lon zoom nil id name)) - (_ (user-error "No pin selected"))))) - -(defun osm--fetch-json (url) - "Get json from URL." - (osm--check-libraries) - (with-temp-buffer - (let* ((default-process-coding-system '(utf-8-unix . utf-8-unix)) - (status (apply #'call-process "curl" nil (current-buffer) nil - `(,@(split-string-and-unquote osm-curl-options) ,url)))) - (unless (eq status 0) - (error "Fetching %s exited with status %s" url status))) - (goto-char (point-min)) - (json-parse-buffer :array-type 'list :object-type 'alist))) - -(defun osm--search (needle) - "Globally search for NEEDLE and return the list of results." - (message "Contacting %s" osm-search-server) - (mapcar - (lambda (x) - (let ((lat (string-to-number (alist-get 'lat x))) - (lon (string-to-number (alist-get 'lon x)))) - `(,(format "%s (%.6f° %.6f°)" - (alist-get 'display_name x) - lat lon) - ,lat ,lon - ,@(mapcar #'string-to-number (alist-get 'boundingbox x))))) - (osm--fetch-json - (format "%s/search?format=json&accept-language=%s&q=%s" - osm-search-server osm-search-language - (url-encode-url needle))))) - -;;;###autoload -(defun osm-search (needle &optional lucky) - "Globally search for NEEDLE on `osm-search-server' and display the map. -If the prefix argument LUCKY is non-nil take the first result and jump there. -See `osm-search-server' and `osm-search-language' for customization." - (interactive - (list - (minibuffer-with-setup-hook - (lambda () - (when (and (eq completing-read-function #'completing-read-default) - (not (bound-and-true-p vertico-mode))) - ;; Override dreaded `minibuffer-complete-word' for default - ;; completion. When will this keybinding finally get removed from - ;; default completion? - (use-local-map (make-composed-keymap - (define-keymap "SPC" nil) - (current-local-map))))) - (completing-read "Location: " - (osm--sorted-table osm--search-history) - nil nil nil 'osm--search-history)) - current-prefix-arg)) - ;; TODO: Add search bounded to current viewbox, bounded=1, viewbox=x1,y1,x2,y2 - (let* ((results (or (osm--search needle) (error "No results for `%s'" needle))) - (selected - (or - (and (or lucky (not (cdr results))) (car results)) - (assoc - (minibuffer-with-setup-hook - (lambda () - (when (and (eq completing-read-function #'completing-read-default) - (not (bound-and-true-p vertico-mode)) - (not (bound-and-true-p icomplete-mode))) - (let ((message-log-max nil) - (inhibit-message t)) - ;; Show matches immediately for default completion. - (minibuffer-completion-help)))) - (completing-read - (format "Matches for '%s': " needle) - (osm--sorted-table results) - nil t nil t)) - results) - (error "No selection")))) - (osm--goto (cadr selected) (caddr selected) - (apply #'osm--boundingbox-to-zoom (cdddr selected)) - nil 'osm-selected (car selected)))) - -(defun osm--sorted-table (coll) - "Sorted completion table from COLL." - (lambda (str pred action) - (if (eq action 'metadata) - '(metadata (display-sort-function . identity) - (cycle-sort-function . identity)) - (complete-with-action action coll str pred)))) - -;;;###autoload -(defun osm-gpx-show (file) - "Show the tracks of gpx FILE in an `osm-mode' buffer." - (interactive "fGPX file: ") - (osm--check-libraries) - (let ((dom (with-temp-buffer - (insert-file-contents file) - (libxml-parse-xml-region (point-min) (point-max)))) - (min-lat 90) (max-lat -90) (min-lon 180) (max-lon -180)) - (setf (alist-get (abbreviate-file-name file) osm--gpx-files nil nil #'equal) - (cons - (cl-loop - for trk in (dom-children dom) - if (eq (dom-tag trk) 'trk) nconc - (cl-loop - for seg in (dom-children trk) - if (eq (dom-tag seg) 'trkseg) collect - (cl-loop - for pt in (dom-children seg) - if (eq (dom-tag pt) 'trkpt) collect - (let ((lat (string-to-number (dom-attr pt 'lat))) - (lon (string-to-number (dom-attr pt 'lon)))) - (setq min-lat (min lat min-lat) - max-lat (max lat max-lat) - min-lon (min lon min-lon) - max-lon (max lon max-lon)) - (cons lat lon))))) - (cl-loop - for pt in (dom-children dom) - if (eq (dom-tag pt) 'wpt) collect - (let ((lat (string-to-number (dom-attr pt 'lat))) - (lon (string-to-number (dom-attr pt 'lon)))) - (setq min-lat (min lat min-lat) - max-lat (max lat max-lat) - min-lon (min lon min-lon) - max-lon (max lon max-lon)) - (list lat lon (dom-text (dom-child-by-tag pt 'name))))))) - (osm--revert) - (osm--goto (/ (+ min-lat max-lat) 2) (/ (+ min-lon max-lon) 2) - (osm--boundingbox-to-zoom min-lat max-lat min-lon max-lon) - nil nil nil))) - -(defun osm-gpx-hide (file) - "Show the tracks of gpx FILE in an `osm-mode' buffer." - (interactive (list (completing-read "GPX file: " - (or osm--gpx-files - (error "No GPX files shown")) - nil t nil 'file-name-history))) - (cl-callf2 assoc-delete-all file osm--gpx-files) - (osm--revert)) - -(defun osm--server-annotation (cand) - "Annotation for server CAND." - (when-let ((copyright (osm--server-property :copyright (get-text-property 0 'osm--server cand))) - (str - (replace-regexp-in-string - "{\\(.*?\\)|.*?}" - (lambda (str) (match-string 1 str)) - (string-join (ensure-list copyright) " | ") copyright))) - (concat (propertize " " 'display `(space :align-to (- right ,(length str) 2))) - " " - str))) - -(defun osm--server-group (cand transform) - "Group function for server CAND with candidate TRANSFORM." - (if transform - cand - (osm--server-property :group (get-text-property 0 'osm--server cand)))) - -;;;###autoload -(defun osm-server (server) - "Select tile SERVER." - (interactive - (let* ((max-name (cl-loop for (_ . x) in osm-server-list - maximize (length (plist-get x :name)))) - (fmt (concat - (propertize (format "%%-%ds " max-name) - 'face 'font-lock-comment-face) - " %s")) - (servers - (mapcar - (lambda (x) - (propertize - (format fmt - (plist-get (cdr x) :name) - (or (plist-get (cdr x) :description) "")) - 'osm--server (car x))) - osm-server-list)) - (selected (completing-read - "Server: " - (lambda (str pred action) - (if (eq action 'metadata) - `(metadata - (annotation-function - . ,(and osm-copyright #'osm--server-annotation)) - (group-function . ,#'osm--server-group)) - (complete-with-action action servers str pred))) - nil t nil 'osm--server-history - (format fmt - (osm--server-property :name) - (or (osm--server-property :description) ""))))) - (list - (get-text-property 0 'osm--server - (or (car (member selected servers)) - (error "No server selected")))))) - (osm--goto nil nil nil server nil nil)) - -(defun osm-save-url (&optional arg) - "Save coordinates as url in the kill ring. -If prefix ARG is given, store url as Elisp expression." - (interactive "P" osm-mode) - (osm--barf-unless-osm) - (pcase-let* ((`(,lat ,lon ,loc) (osm--fetch-location-data "New Link")) - (server (and (not (eq osm-server (default-value 'osm-server))) osm-server)) - (url (if arg - (format "(osm %.6f %.6f %s%s%s)" - lat lon osm--zoom - (if server (format " '%s" osm-server) "") - (if loc (format " %S" loc) "")) - (format "geo:%.6f,%.6f;z=%s%s%s" - lat lon osm--zoom - (if server (format ";s=%s" osm-server) "") - (if loc (format " (%s)" loc) ""))))) - (kill-new url) - (message "Saved in the kill ring: %s" url))) - -(cl-defun osm-add-server (server - &rest properties - &key name description group url ext max-connections - max-zoom min-zoom download-batch subdomains copyright) - "Add SERVER with PROPERTIES to `osm-server-list'. -The properties are checked as keyword arguments. See -`osm-server-list' for documentation of the keywords." - (declare (indent 1)) - (ignore name description group url max-connections max-zoom - min-zoom download-batch subdomains copyright) - (dolist (sym '(:name :description :group :url)) - (unless (stringp (plist-get properties sym)) - (error "Server property %s is required" sym))) - (unless (and server (symbolp server)) - (error "Server id must be a symbol")) - (setf (alist-get server osm-server-list) properties) - nil) - -;;;###autoload -(add-to-list 'browse-url-default-handlers '("\\`geo:" . osm)) - -;;;###autoload -(eval-after-load 'ol - (lambda () - (declare-function org-link-set-parameters "ol") - (declare-function osm--org-link-props "ext:osm") - (org-link-set-parameters - "geo" - :follow (lambda (link _) (osm (concat "geo:" link))) - :store (lambda () - (when (eq major-mode 'osm-mode) - (apply 'org-link-store-props (osm--org-link-props))))))) - -(provide 'osm) -;;; osm.el ends here diff --git a/emacs/elpa/osm-20241105.2132/osm.elc b/emacs/elpa/osm-20241105.2132/osm.elc Binary files differ. diff --git a/emacs/elpa/osm-20241105.2132/osm-autoloads.el b/emacs/elpa/osm-20241119.2137/osm-autoloads.el diff --git a/emacs/elpa/osm-20241119.2137/osm-pkg.el b/emacs/elpa/osm-20241119.2137/osm-pkg.el @@ -0,0 +1,11 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "osm" "20241119.2137" + "OpenStreetMap viewer." + '((emacs "28.1") + (compat "30")) + :url "https://github.com/minad/osm" + :commit "ab76f8a9e79e0ec6330071b4aed974270b6f2a15" + :revdesc "ab76f8a9e79e" + :keywords '("network" "multimedia" "hypermedia" "mouse") + :authors '(("Daniel Mendler" . "mail@daniel-mendler.de")) + :maintainers '(("Daniel Mendler" . "mail@daniel-mendler.de"))) diff --git a/emacs/elpa/osm-20241119.2137/osm.el b/emacs/elpa/osm-20241119.2137/osm.el @@ -0,0 +1,1839 @@ +;;; osm.el --- OpenStreetMap viewer -*- lexical-binding: t -*- + +;; Copyright (C) 2022-2024 Free Software Foundation, Inc. + +;; Author: Daniel Mendler <mail@daniel-mendler.de> +;; Maintainer: Daniel Mendler <mail@daniel-mendler.de> +;; Created: 2022 +;; Package-Version: 20241119.2137 +;; Package-Revision: ab76f8a9e79e +;; Package-Requires: ((emacs "28.1") (compat "30")) +;; URL: https://github.com/minad/osm +;; Keywords: network, multimedia, hypermedia, mouse + +;; This file is 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 this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Osm.el is a tile-based map viewer, with a responsive movable and +;; zoomable display. The map can be controlled with the keyboard or with +;; the mouse. The viewer fetches the map tiles in parallel from tile +;; servers via the `curl' program. The package comes with a list of +;; multiple preconfigured tile servers. You can bookmark your favorite +;; locations using regular Emacs bookmarks or create links from Org files +;; to locations. Furthermore the package provides commands to measure +;; distances, search for locations by name and to open and display GPX +;; tracks. + +;; osm.el requires Emacs 28 and depends on the external `curl' program. +;; Emacs must be built with libxml, libjansson, librsvg, libjpeg and +;; libpng support. + +;;; Code: + +(require 'compat) +(require 'bookmark) +(require 'dom) +(eval-when-compile + (require 'cl-lib) + (require 'subr-x)) + +(defgroup osm nil + "OpenStreetMap viewer." + :link '(info-link :tag "Info Manual" "(osm)") + :link '(url-link :tag "Website" "https://github.com/minad/osm") + :link '(url-link :tag "Wiki" "https://github.com/minad/osm/wiki") + :link '(emacs-library-link :tag "Library Source" "osm.el") + :group 'web + :prefix "osm-") + +(defcustom osm-curl-options + "--disable --fail --location --silent --max-time 30" + "Curl command line options." + :type 'string) + +(defcustom osm-search-language "en" + "Language used for search results. +Use RFC 1766 abbreviations, e.g.: `en' for English, `de' for German. +A comma-separated specifies descending order of preference. See also +`url-mime-language-string'." + :type 'string) + +(defcustom osm-search-server + "https://nominatim.openstreetmap.org" + "Server used to search for location names. +The server must offer the nominatim.org API." + :type 'string) + +(defcustom osm-server-defaults + '(:min-zoom 2 + :max-zoom 19 + :download-batch 4 + :max-connections 2 + :subdomains ("a" "b" "c")) + "Default server properties. +See also `osm-server-list'." + :type 'plist) + +(defcustom osm-server-list + '((default + :name "Carto" + :description "Standard Carto map provided by OpenStreetMap" + :url "https://%s.tile.openstreetmap.org/%z/%x/%y.png" + :group "Standard" + :copyright ("Map data © {OpenStreetMap|https://www.openstreetmap.org/copyright} contributors" + "Map style © {OpenStreetMap Standard|https://www.openstreetmap.org/copyright}")) + (de + :name "Carto(de)" + :description "Localized Carto map provided by OpenStreetMap Germany" + :url "https://%s.tile.openstreetmap.de/%z/%x/%y.png" + :group "Standard" + :copyright ("Map data © {OpenStreetMap|https://www.openstreetmap.org/copyright} contributors" + "Map style © {OpenStreetMap Deutschland|https://www.openstreetmap.de/germanstyle.html}")) + (fr + :name "Carto(fr)" + :description "Localized Carto map by OpenStreetMap France" + :url "https://%s.tile.openstreetmap.fr/osmfr/%z/%x/%y.png" + :group "Standard" + :copyright ("Map data © {OpenStreetMap|https://www.openstreetmap.org/copyright} contributors" + "Map style © {OpenStreetMap France|https://www.openstreetmap.fr/mentions-legales/}")) + (humanitarian + :name "Humanitarian" + :description "Humanitarian map provided by OpenStreetMap France" + :url "https://%s.tile.openstreetmap.fr/hot/%z/%x/%y.png" + :group "Special Purpose" + :copyright ("Map data © {OpenStreetMap|https://www.openstreetmap.org/copyright} contributors" + "Map style © {Humanitarian OpenStreetMap Team|https://www.hotosm.org/updates/2013-09-29_a_new_window_on_openstreetmap_data}")) + (cyclosm + :name "CyclOSM" + :description "Bicycle-oriented map provided by OpenStreetMap France" + :url "https://%s.tile-cyclosm.openstreetmap.fr/cyclosm/%z/%x/%y.png" + :group "Transportation" + :copyright ("Map data © {OpenStreetMap|https://www.openstreetmap.org/copyright} contributors" + "Map style © {CyclOSM|https://www.cyclosm.org/} contributors")) + (openriverboatmap + :name "OpenRiverBoatMap" + :description "Waterways map provided by OpenStreetMap France" + :url "https://%s.tile.openstreetmap.fr/openriverboatmap/%z/%x/%y.png" + :group "Transportation" + :copyright ("Map data © {OpenStreetMap|https://www.openstreetmap.org/copyright} contributors" + "Map style © {OpenRiverBoatMap|https://github.com/tilery/OpenRiverboatMap}")) + (opentopomap + :name "OpenTopoMap" + :description "Topographical map provided by OpenTopoMap" + :url "https://%s.tile.opentopomap.org/%z/%x/%y.png" + :group "Topographical" + :copyright ("Map data © {OpenStreetMap|https://www.openstreetmap.org/copyright} contributors" + "Map style © {OpenTopoMap|https://www.opentopomap.org} ({CC-BY-SA|https://creativecommons.org/licenses/by-sa/3.0/})" + "Elevation data: {SRTM|https://www2.jpl.nasa.gov/srtm/}")) + (opvn + :name "ÖPNV" :max-zoom 18 + :description "Base layer with public transport information" + :url "http://%s.tile.memomaps.de/tilegen/%z/%x/%y.png" + :group "Transportation" + :copyright ("Map data © {OpenStreetMap|https://www.openstreetmap.org/copyright} contributors" + "Map style © {ÖPNVKarte|https://www.öpnvkarte.de}"))) + "List of tile servers. + +Allowed keys: + :name Server name + :description Server description + :copyright Copyright information + :group Name of server groups for related servers + :url Url with placeholders + :ext File name extension + :min-zoom Minimum zoom level + :max-zoom Maximum zoom level + :download-batch Number of tiles downloaded via a single connection + :max-connections Maximum number of parallel connections + :subdomains Subdomains used for the %s placeholder + +See also `osm-server-defaults' for default values used for a +server if the property is missing. + +The :url of each server should specify %x, %y, %z and %s placeholders +for the map coordinates. It can optionally use an %s placeholder +for the subdomain and a %k placeholder for an apikey. The apikey +will be retrieved via `auth-source-search' with the :host set to +the domain name and the :user to the string \"apikey\"." + :type '(alist :key-type symbol :value-type plist)) + +(defcustom osm-copyright t + "Display the copyright information above the map." + :type 'boolean) + +(defcustom osm-pin-colors + '((osm-selected . "#e20") + (osm-bookmark . "#f80") + (osm-poi . "#88f") + (osm-home . "#80f") + (osm-track . "#00a")) + "Colors of pins." + :type '(alist :key-type symbol :value-type string)) + +(defcustom osm-track-style + "stroke:#00a;stroke-width:5;stroke-linejoin:round;stroke-linecap:round;opacity:0.4;" + "SVG style used to draw tracks." + :type 'string) + +(defcustom osm-home + (let ((lat (bound-and-true-p calendar-latitude)) + (lon (bound-and-true-p calendar-longitude))) + (if (and lat lon) + (list lat lon 12) + (list 0 0 3))) + "Home coordinates, latitude, longitude and zoom level." + :type '(list :tag "Coordinates" + (number :tag "Latitude ") + (number :tag "Longitude ") + (number :tag "Zoom "))) + +(defcustom osm-large-step 256 + "Scroll step in pixel." + :type 'natnum) + +(defcustom osm-tile-border nil + "Set to t to display thin tile borders. +For debugging set the value to `debug', such that a border is +shown around SVG tiles." + :type '(choice boolean (const debug))) + +(defcustom osm-small-step 16 + "Scroll step in pixel." + :type 'natnum) + +(defcustom osm-server 'default + "Tile server name." + :type 'symbol) + +(defcustom osm-tile-directory + (expand-file-name "var/osm/" user-emacs-directory) + "Tile cache directory." + :type 'string) + +(defcustom osm-max-age 14 + "Maximum tile age in days. +Should be at least 7 days according to the server usage policies." + :type '(choice (const nil) natnum)) + +(defcustom osm-max-tiles 256 + "Number of tiles to keep in the memory cache." + :type '(choice (const nil) natnum)) + +(defun osm--menu-item (menu) + "Generate menu item from MENU." + `(menu-item + "" nil :filter + ,(lambda (&optional _) + (select-window + (posn-window + (event-start last-input-event))) + (if (functionp menu) + (funcall menu) + menu)))) + +(defun osm--mouse-ignore-wheel (_prompt) + "Ignore mouse wheel events during key translation." + (pcase (this-single-command-raw-keys) + ((and `[,e] + (let y (event-basic-type e)) + (guard (symbolp y)) + (guard (string-search "wheel-" (symbol-name y)))) + []) + (k k))) + +(defvar-keymap osm-prefix-map + :doc "Global prefix map of OSM entry points." + "h" #'osm-home + "s" #'osm-search + "v" #'osm-server + "t" #'osm-goto + "j" #'osm-jump + "x" #'osm-gpx-show + "X" #'osm-gpx-hide) + +;;;###autoload (autoload 'osm-prefix-map "osm" nil t 'keymap) +(defalias 'osm-prefix-map osm-prefix-map) + +(defvar-keymap osm-mode-map + :doc "Keymap used by `osm-mode'." + :parent (make-composed-keymap osm-prefix-map special-mode-map) + "<home>" #'osm-home + "+" #'osm-zoom-in + "-" #'osm-zoom-out + "SPC" #'osm-zoom-in + "S-SPC" #'osm-zoom-out + "<mouse-1>" #'osm-mouse-pin + "<mouse-2>" 'org-store-link + "<mouse-3>" #'osm-bookmark-set + "S-<down-mouse-1>" #'ignore + "S-<mouse-1>" #'osm-mouse-track + "<down-mouse-1>" #'osm-mouse-drag + "<down-mouse-2>" #'osm-mouse-drag + "<down-mouse-3>" #'osm-mouse-drag + "<drag-mouse-1>" #'ignore + "<drag-mouse-2>" #'ignore + "<drag-mouse-3>" #'ignore + "<up>" #'osm-up + "<down>" #'osm-down + "<left>" #'osm-left + "<right>" #'osm-right + "C-<up>" #'osm-up-up + "C-<down>" #'osm-down-down + "C-<left>" #'osm-left-left + "C-<right>" #'osm-right-right + "M-<up>" #'osm-up-up + "M-<down>" #'osm-down-down + "M-<left>" #'osm-left-left + "M-<right>" #'osm-right-right + "S-<up>" #'osm-up-up + "S-<down>" #'osm-down-down + "S-<left>" #'osm-left-left + "S-<right>" #'osm-right-right + "n" #'osm-rename + "d" #'osm-delete + "DEL" #'osm-delete + "<deletechar>" #'osm-delete + "c" #'osm-center + "o" #'clone-buffer + "u" #'osm-save-url + "l" 'org-store-link + "b" #'osm-bookmark-set + "X" #'osm-gpx-hide + "<remap> <scroll-down-command>" #'osm-down + "<remap> <scroll-up-command>" #'osm-up + "<" nil + ">" nil) + +(dolist (pin osm-pin-colors) + (setq pin (vector (car pin))) + (define-key key-translation-map pin #'osm--mouse-ignore-wheel) + (define-key osm-mode-map pin #'osm-mouse-select)) + +(easy-menu-define osm-mode-menu osm-mode-map + "Menu for `osm-mode'." + '("OSM" + ["Go home" osm-home] + ["Center" osm-center] + ["Go to coordinates" osm-goto] + ["Jump to pin" osm-jump] + ["Search by name" osm-search] + ["Change tile server" osm-server] + "--" + ["Org Link" org-store-link] + ["Geo Url" osm-save-url] + ["Elisp Link" (osm-save-url t)] + ("Bookmark" + ["Set" osm-bookmark-set] + ["Jump" osm-bookmark-jump] + ["Rename" osm-bookmark-rename] + ["Delete" osm-bookmark-delete]) + "--" + ["Show GPX file" osm-gpx-show] + ["Hide GPX file" osm-gpx-hide] + "--" + ["Clone buffer" clone-buffer] + ["Revert buffer" revert-buffer] + "--" + ["Manual" (info "(osm)")] + ["Customize" (customize-group 'osm)])) + +(defconst osm--placeholder + '(:type svg :width 256 :height 256 + :data "<svg width='256' height='256' version='1.1' xmlns='http://www.w3.org/2000/svg'> + <defs> + <pattern id='grid' width='16' height='16' patternUnits='userSpaceOnUse'> + <path d='m 0 0 l 0 16 16 0' fill='none' stroke='#888888'/> + </pattern> + </defs> + <rect width='256' height='256' fill='url(#grid)'/> +</svg>") + "Placeholder image for tiles.") + +(defvar osm--search-history nil + "Minibuffer history used by command `osm-search'.") + +(defvar osm--jump-history nil + "Minibuffer history used by command `osm-jump'.") + +(defvar osm--server-history nil + "Minibuffer history used by command `osm-server'.") + +(defvar osm--purge-directory 0 + "Last time the tile cache was cleaned.") + +(defvar osm--tile-cache nil + "Global tile memory cache.") + +(defvar osm--tile-age 0 + "Tile age, incremented on every update.") + +(defvar osm--gpx-files nil + "Global list of loaded tracks.") + +(defvar osm--track nil + "List of track coordinates.") + +(defvar osm--download-processes nil + "Globally active download processes.") + +(defvar osm--download-active nil + "Globally active download jobs.") + +(defvar osm--download-subdomain nil + "Subdomain indices to query the servers in a round-robin fashion.") + +(defvar-local osm--download-queue nil + "Buffer-local tile download queue.") + +(defvar-local osm--wx 0 + "Half window width in pixel.") + +(defvar-local osm--wy 0 + "Half window height in pixel.") + +(defvar-local osm--nx 0 + "Number of tiles in x direction.") + +(defvar-local osm--ny 0 + "Number of tiles in y direction.") + +(defvar-local osm--zoom nil + "Zoom level of the map.") + +(defvar-local osm--lat nil + "Latitude coordinate.") + +(defvar-local osm--lon nil + "Longitude coordinate.") + +(defvar-local osm--overlays nil + "Overlay hash table. +Local per buffer since the overlays depend on the zoom level.") + +(defvar-local osm--pin nil + "Currently selected pin.") + +(defmacro osm--each (&rest body) + "Execute BODY in each `osm-mode' buffer." + (cl-with-gensyms (buf) + `(dolist (,buf (buffer-list)) + (when (eq (buffer-local-value 'major-mode ,buf) #'osm-mode) + (with-current-buffer ,buf + ,@body))))) + +(defun osm--server-menu () + "Generate server menu." + (let (menu last-group) + (dolist (server osm-server-list) + (let* ((plist (cdr server)) + (group (plist-get plist :group))) + (unless (equal last-group group) + (push (format "─── %s ───" group) menu) + (setq last-group group)) + (push + `[,(plist-get plist :name) + (osm-server ',(car server)) + :style toggle + :selected (eq osm-server ',(car server))] + menu))) + (easy-menu-create-menu "Server" (nreverse menu)))) + +(defsubst osm--lon-to-normalized-x (lon) + "Convert LON to normalized x coordinate." + (/ (+ lon 180.0) 360.0)) + +(defsubst osm--lat-to-normalized-y (lat) + "Convert LAT to normalized y coordinate." + (setq lat (* lat (/ float-pi 180.0))) + (- 0.5 (/ (log (+ (tan lat) (/ 1.0 (cos lat)))) float-pi 2))) + +(defun osm--boundingbox-to-zoom (lat1 lat2 lon1 lon2) + "Compute zoom level from boundingbox LAT1 to LAT2 and LON1 to LON2." + (let ((w (/ (frame-pixel-width) 256)) + (h (/ (frame-pixel-height) 256))) + (max (osm--server-property :min-zoom) + (min + (osm--server-property :max-zoom) + (min (logb (/ w (abs (- (osm--lon-to-normalized-x lon1) (osm--lon-to-normalized-x lon2))))) + (logb (/ h (abs (- (osm--lat-to-normalized-y lat1) (osm--lat-to-normalized-y lat2)))))))))) + +(defun osm--x-to-lon (x zoom) + "Return longitude in degrees for X/ZOOM." + (- (/ (* x 360.0) 256.0 (expt 2.0 zoom)) 180.0)) + +(defun osm--y-to-lat (y zoom) + "Return latitude in degrees for Y/ZOOM." + (setq y (* float-pi (- 1 (* 2 (/ y 256.0 (expt 2.0 zoom)))))) + (/ (* 180 (atan (/ (- (exp y) (exp (- y))) 2))) float-pi)) + +(defsubst osm--lon-to-x (lon zoom) + "Convert LON/ZOOM to x coordinate in pixel." + (floor (* 256 (expt 2.0 zoom) (osm--lon-to-normalized-x lon)))) + +(defsubst osm--lat-to-y (lat zoom) + "Convert LAT/ZOOM to y coordinate in pixel." + (floor (* 256 (expt 2.0 zoom) (osm--lat-to-normalized-y lat)))) + +(defsubst osm--x () + "Return longitude in pixel of map center." + (osm--lon-to-x osm--lon osm--zoom)) + +(defsubst osm--y () + "Return latitude in pixel of map center." + (osm--lat-to-y osm--lat osm--zoom)) + +(defsubst osm--x0 () + "Return longitude in pixel of top left corner." + (- (osm--x) osm--wx)) + +(defsubst osm--y0 () + "Return latitude in pixel of top left corner." + (- (osm--y) osm--wy)) + +(defun osm--server-property (prop &optional server) + "Return server property PROP for SERVER." + (or (plist-get (alist-get (or server osm-server) osm-server-list) prop) + (plist-get osm-server-defaults prop))) + +(defun osm--tile-url (x y zoom) + "Return tile url for coordinate X, Y and ZOOM." + (let ((url (osm--server-property :url)) + (sub (osm--server-property :subdomains)) + (key (osm--server-property :key))) + (when (and (string-search "%k" url) (not key)) + (require 'auth-source) + (declare-function auth-source-search "auth-source") + (let ((host (string-join + (last (split-string (cadr (split-string url "/" t)) "\\.") 2) + "."))) + (setq key (plist-get + (car (auth-source-search :require '(:user :host :secret) + :host host + :user "apikey")) + :secret)) + (unless key + (warn "No auth source secret found for apikey@%s" host) + (setq key "")) + (setf (plist-get (alist-get osm-server osm-server-list) :key) key))) + (format-spec + url `((?z . ,zoom) (?x . ,x) (?y . ,y) + (?k . ,(if (functionp key) (funcall key) key)) + (?s . ,(nth (mod (alist-get osm-server osm--download-subdomain 0) + (length sub)) + sub)))))) + +(defun osm--tile-file (x y zoom) + "Return tile file name for coordinate X, Y and ZOOM." + (file-name-concat + (expand-file-name osm-tile-directory) + (symbol-name osm-server) + (format "%d-%d-%d.%s" + zoom x y + (or (osm--server-property :ext) + (file-name-extension + (url-file-nondirectory + (osm--server-property :url))))))) + +(defun osm--enqueue-download (x y) + "Enqueue tile X/Y for download." + (when (let ((n (expt 2 osm--zoom))) (and (>= x 0) (>= y 0) (< x n) (< y n))) + (let ((job (list osm-server osm--zoom x y))) + (unless (or (member job osm--download-queue) (member job osm--download-active)) + (setq osm--download-queue (nconc osm--download-queue (list job))))))) + +(defun osm--download-filter (output) + "Filter function for the download process which receives OUTPUT." + (while (string-match + "\\`\\([0-9]+\\) \\(.*?/\\([^/]+\\)/\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)\\.[^\r\n]+\\)\r?\n" + output) + (let ((status (match-string 1 output)) + (file (match-string 2 output)) + (server (intern-soft (match-string 3 output))) + (zoom (string-to-number (match-string 4 output))) + (x (string-to-number (match-string 5 output))) + (y (string-to-number (match-string 6 output)))) + (setq output (substring output (match-end 0))) + (when (equal status "200") + (ignore-errors (rename-file file (string-remove-suffix ".tmp" file) t)) + (osm--each + (when (and (= osm--zoom zoom) (eq osm-server server)) + (osm--display-tile x y (osm--get-tile x y))))) + (cl-callf2 delete (list server zoom x y) osm--download-active) + (delete-file file))) + output) + +(defun osm--download-command () + "Build download command." + (let* ((count 0) + (batch (osm--server-property :download-batch)) + (subs (length (osm--server-property :subdomains))) + (parallel (* subs (osm--server-property :max-connections))) + args jobs job) + (while (and (< count batch) + (setq job (nth (* count parallel) osm--download-queue))) + (pcase-let ((`(,_server ,zoom ,x ,y) job)) + (setq args `(,(osm--tile-url x y zoom) + ,(concat (osm--tile-file x y zoom) ".tmp") + "--output" + ,@args)) + (push job jobs) + (push job osm--download-active) + (cl-incf count))) + (osm--each + (dolist (job jobs) + (cl-callf2 delq job osm--download-queue))) + (cl-callf (lambda (s) (mod (1+ s) subs)) + (alist-get osm-server osm--download-subdomain 0)) + (cons `("curl" "--write-out" "%{http_code} %{filename_effective}\n" + ,@(split-string-and-unquote osm-curl-options) ,@(nreverse args)) + jobs))) + +(defun osm--download () + "Download next tiles from the queue." + (when (and (< (length (alist-get osm-server osm--download-processes)) + (* (length (osm--server-property :subdomains)) + (osm--server-property :max-connections))) + osm--download-queue) + (pcase-let ((`(,command . ,jobs) (osm--download-command)) + (dir (file-name-concat (expand-file-name osm-tile-directory) + (symbol-name osm-server))) + (server osm-server)) + (make-directory dir t) + (push + (make-process + :name "*osm curl*" + :connection-type 'pipe + :noquery t + :command command + :filter + (let ((output "")) + (lambda (_proc out) + (setq output (osm--download-filter (concat output out))) + (force-mode-line-update t))) + :sentinel + (lambda (proc _status) + (dolist (job jobs) + (cl-callf2 delq job osm--download-active)) + (cl-callf2 delq proc (alist-get server osm--download-processes nil t)) + (force-mode-line-update t) + (osm--download))) + (alist-get server osm--download-processes)) + (force-mode-line-update t) + (osm--download)))) + +(defun osm-mouse-drag (event) + "Handle drag EVENT." + (declare (completion ignore)) + (interactive "@e") + (pcase-let* ((`(,sx . ,sy) (posn-x-y (event-start event))) + (win (selected-window)) + (map (define-keymap + "<mouse-movement>" + (lambda (event) + (interactive "e") + (setq event (event-start event)) + (when (eq win (posn-window event)) + (pcase-let ((`(,ex . ,ey) (posn-x-y event))) + (osm--move (- sx ex) (- sy ey)) + (setq sx ex sy ey) + (osm--update))))))) + (setq track-mouse 'dragging) + (set-transient-map map + (lambda () (eq (car-safe last-input-event) 'mouse-movement)) + (lambda () (setq track-mouse nil))))) + +(defun osm--zoom-in-wheel (_n) + "Zoom in with the mouse wheel." + (pcase-let ((`(,x . ,y) (posn-x-y (event-start last-input-event)))) + (when (< osm--zoom (osm--server-property :max-zoom)) + (osm--move (/ (- x osm--wx) 2) (/ (- y osm--wy) 2)) + (osm-zoom-in)))) + +(defun osm--zoom-out-wheel (_n) + "Zoom out with the mouse wheel." + (pcase-let ((`(,x . ,y) (posn-x-y (event-start last-input-event)))) + (when (> osm--zoom (osm--server-property :min-zoom)) + (osm--move (- osm--wx x) (- osm--wy y)) + (osm-zoom-out)))) + +(defun osm-center () + "Center to location of selected pin." + (interactive nil osm-mode) + (osm--barf-unless-osm) + (pcase osm--pin + (`(,lat ,lon ,_id ,name) + (setq osm--lat lat osm--lon lon) + (message "%s" name) + (osm--update)))) + +(defun osm--haversine (lat1 lon1 lat2 lon2) + "Compute distance between LAT1/LON1 and LAT2/LON2 in km." + ;; https://en.wikipedia.org/wiki/Haversine_formula + (let* ((rad (/ float-pi 180)) + (y (sin (* 0.5 rad (- lat2 lat1)))) + (x (sin (* 0.5 rad (- lon2 lon1)))) + (h (+ (* x x) (* (cos (* rad lat1)) (cos (* rad lat2)) y y)))) + (* 2 6371 (atan (sqrt h) (sqrt (- 1 h)))))) + +(defun osm-mouse-track (event) + "Set track pin at location of the click EVENT." + (declare (completion ignore)) + (interactive "@e") + (pcase osm--pin + ((and (guard (not osm--track)) `(,lat ,lon ,_id ,_name)) + (push (list lat lon "WP1") osm--track))) + (osm--set-pin-event event 'osm-track + (format "WP%s" (1+ (length osm--track))) 'quiet) + (pcase-let ((`(,lat ,lon ,_id ,name) osm--pin)) + (push (list lat lon name) osm--track)) + (osm--revert) + (osm--track-length)) + +(defun osm--track-length () + "Echo track length." + (when (cdr osm--track) + (pcase-let* ((len1 0) + (len2 0) + (p osm--track) + (`(,sel-lat ,sel-lon ,_ ,sel-name) osm--pin)) + (while (and (cdr p) (not (and (equal (caar p) sel-lat) + (equal (cadar p) sel-lon)))) + (cl-incf len2 (osm--haversine (caar p) (cadar p) + (caadr p) (cadadr p))) + (pop p)) + (while (cdr p) + (cl-incf len1 (osm--haversine (caar p) (cadar p) + (caadr p) (cadadr p))) + (pop p)) + (message "%s way points, length %.2fkm, %s" + (length osm--track) (+ len1 len2) + (if (or (= len1 0) (= len2 0)) + sel-name + (format "%.2fkm → %s → %.2fkm" + len1 sel-name len2)))))) + +(defun osm--pin-at (event &optional type) + "Get pin of TYPE at EVENT." + (let* ((xy (posn-x-y (event-start event))) + (x (+ (osm--x0) (car xy))) + (y (+ (osm--y0) (cdr xy))) + (min most-positive-fixnum) + found) + (dolist (pin (car (osm--get-overlays (/ x 256) (/ y 256)))) + (pcase-let ((`(,p ,q ,_lat ,_lon ,id ,_name) pin)) + (when (or (not type) (eq type id)) + (let ((d (+ (* (- p x) (- p x)) (* (- q y) (- q y))))) + (when (and (>= q y) (< q (+ y 50)) (>= p (- x 20)) (< p (+ x 20)) (< d min)) + (setq min d found pin)))))) + (cddr found))) + +(defun osm-mouse-pin (event) + "Create location pin at the click EVENT." + (declare (completion ignore)) + (interactive "@e") + (osm--set-pin-event event) + (osm--update)) + +(defun osm-mouse-select (event) + "Select pin at position of click EVENT." + (declare (completion ignore)) + (interactive "@e") + (when (memq (event-basic-type event) '(mouse-1 mouse-2 mouse-3)) + (pcase (osm--pin-at event) + (`(,lat ,lon ,id ,name) + (osm--set-pin id lat lon name (eq id 'osm-track)) + (when (eq id 'osm-track) (osm--track-length)) + (osm--update))))) + +(defun osm-zoom-in (&optional n) + "Zoom N times into the map." + (interactive "p" osm-mode) + (osm--barf-unless-osm) + (setq osm--zoom (max (osm--server-property :min-zoom) + (min (osm--server-property :max-zoom) + (+ osm--zoom (or n 1))))) + (osm--update)) + +(defun osm-zoom-out (&optional n) + "Zoom N times out of the map." + (interactive "p" osm-mode) + (osm-zoom-in (- (or n 1)))) + +(defun osm--move (dx dy) + "Move by DX/DY." + (osm--barf-unless-osm) + (setq osm--lon (osm--x-to-lon (+ (osm--x) dx) osm--zoom) + osm--lat (osm--y-to-lat (+ (osm--y) dy) osm--zoom))) + +(defun osm-right (&optional n) + "Move N small steps to the right." + (interactive "p" osm-mode) + (osm--move (* (or n 1) osm-small-step) 0) + (osm--update)) + +(defun osm-down (&optional n) + "Move N small steps down." + (interactive "p" osm-mode) + (osm--move 0 (* (or n 1) osm-small-step)) + (osm--update)) + +(defun osm-up (&optional n) + "Move N small steps up." + (interactive "p" osm-mode) + (osm-down (- (or n 1)))) + +(defun osm-left (&optional n) + "Move N small steps to the left." + (interactive "p" osm-mode) + (osm-right (- (or n 1)))) + +(defun osm-right-right (&optional n) + "Move N large steps to the right." + (interactive "p" osm-mode) + (osm--move (* (or n 1) osm-large-step) 0) + (osm--update)) + +(defun osm-down-down (&optional n) + "Move N large steps down." + (interactive "p" osm-mode) + (osm--move 0 (* (or n 1) osm-large-step)) + (osm--update)) + +(defun osm-up-up (&optional n) + "Move N large steps up." + (interactive "p" osm-mode) + (osm-down-down (- (or n 1)))) + +(defun osm-left-left (&optional n) + "Move N large steps to the left." + (interactive "p" osm-mode) + (osm-right-right (- (or n 1)))) + +(defun osm--purge-directory () + "Clean tile directory." + (when (and (integerp osm-max-age) + (> (- (float-time) osm--purge-directory) (* 60 60 24))) + (setq osm--purge-directory (float-time)) + (run-with-idle-timer + 30 nil + (lambda () + (dolist (dir (directory-files osm-tile-directory t "\\`[^.]+\\'" t)) + (dolist (file (directory-files + dir t "\\.\\(?:png\\|jpe?g\\)\\(?:\\.tmp\\)?\\'" t)) + (when (> (float-time (time-since + (file-attribute-modification-time + (file-attributes file)))) + (* 60 60 24 osm-max-age)) + (delete-file file))) + (when (directory-empty-p dir) + (ignore-errors (delete-directory dir)))))))) + +(defun osm--check-libraries () + "Check that Emacs is compiled with the necessary libraries." + (let (req) + (unless (display-graphic-p) + (push "graphical display" req)) + (dolist (type '(svg jpeg png)) + (unless (image-type-available-p type) + (push (format "%s support" type) req))) + (unless (libxml-available-p) + (push "libxml" req)) + (unless (json-available-p) + (push "libjansson" req)) + (when req + (error "Osm: Please compile Emacs with the required libraries, %s needed to proceed" + (string-join req ", "))))) + +(define-derived-mode osm-mode special-mode "Osm" + "OpenStreetMap viewer mode." + :interactive nil :abbrev-table nil :syntax-table nil + (osm--check-libraries) + (setq-local osm-server osm-server + line-spacing nil + cursor-type nil + cursor-in-non-selected-windows nil + left-fringe-width 1 + right-fringe-width 1 + left-margin-width 0 + right-margin-width 0 + truncate-lines t + show-trailing-whitespace nil + display-line-numbers nil + buffer-read-only t + fringe-indicator-alist '((truncation . nil)) + revert-buffer-function #'osm--revert + mode-line-process '(:eval (osm--download-queue-info)) + mode-line-position nil + mode-line-modified nil + mode-line-mule-info nil + mode-line-remote nil + default-directory (expand-file-name "~/") + eldoc-documentation-functions nil + mouse-wheel-progressive-speed nil + mwheel-scroll-up-function #'osm--zoom-out-wheel + mwheel-scroll-down-function #'osm--zoom-in-wheel + mwheel-scroll-left-function #'osm--zoom-out-wheel + mwheel-scroll-right-function #'osm--zoom-in-wheel + bookmark-make-record-function #'osm--bookmark-record-default) + (when (boundp 'mwheel-coalesce-scroll-events) + (setq-local mwheel-coalesce-scroll-events t)) + (when (boundp 'pixel-scroll-precision-mode) + (setq-local pixel-scroll-precision-mode nil)) + (add-hook 'change-major-mode-hook #'osm--barf-change-mode nil 'local) + (add-hook 'write-contents-functions #'osm--barf-write nil 'local) + (add-hook 'window-size-change-functions #'osm--resize nil 'local)) + +(defun osm--barf-write () + "Barf for write operation." + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (set-visited-file-name nil) + (error "Writing the buffer to a file is not supported")) + +(defun osm--barf-change-mode () + "Barf for change mode operation." + (error "Changing the major mode is not supported")) + +(defun osm--barf-unless-osm () + "Barf if not an `osm-mode' buffer." + (unless (eq major-mode #'osm-mode) + (error "Not an `osm-mode' buffer"))) + +(defun osm--each-pin (fun) + "Call FUN for each pin on the map." + (pcase osm-home + (`(,lat ,lon ,zoom) + (funcall fun 'osm-home lat lon zoom "Home"))) + (bookmark-maybe-load-default-file) + (cl-loop for bm in bookmark-alist + if (eq (bookmark-prop-get bm 'handler) #'osm-bookmark-jump) do + (pcase-let ((`(,lat ,lon ,zoom) (bookmark-prop-get bm 'coordinates))) + (funcall fun 'osm-bookmark lat lon zoom (car bm)))) + (dolist (file osm--gpx-files) + (cl-loop for (lat lon name) in (cddr file) do + (funcall fun 'osm-poi lat lon 15 name))) + (cl-loop for (lat lon name) in osm--track do + (funcall fun 'osm-track lat lon 15 name))) + +(defun osm--pin-inside-p (x y lat lon) + "Return non-nil if pin at LAT/LON is inside tile X/Y." + (let ((p (/ (osm--lon-to-x lon osm--zoom) 256.0)) + (q (/ (osm--lat-to-y lat osm--zoom) 256.0))) + (and (>= p (- x 0.125)) (< p (+ x 1.125)) + (>= q y) (< q (+ y 1.25))))) + +(defun osm--add-pin (pins id lat lon _zoom name) + "Add pin at LAT/LON with NAME and ID to the PINS hash table." + (let* ((x (osm--lon-to-x lon osm--zoom)) + (y (osm--lat-to-y lat osm--zoom)) + (x0 (/ x 256)) + (y0 (/ y 256)) + (pin (list x y lat lon id name))) + (push pin (gethash (cons x0 y0) pins)) + (cl-loop + for i from -1 to 1 do + (cl-loop + for j from -1 to 0 do + (let ((x1 (/ (+ x (* 32 i)) 256)) + (y1 (/ (+ y (* 64 j)) 256))) + (unless (and (= x0 x1) (= y0 y1)) + (push pin (gethash (cons x1 y1) pins)))))))) + +;; TODO: The Bresenham algorithm used here to add the line segments to the tiles +;; has the issue that lines which go along a tile border may be drawn only +;; partially. Use a more precise algorithm instead. +(defun osm--add-track (tracks seg) + "Add track segment SEG to TRACKS hash table." + (when seg + (let ((p0 (cons (osm--lon-to-x (or (car-safe (cdar seg)) (cdar seg)) osm--zoom) + (osm--lat-to-y (caar seg) osm--zoom)))) + (dolist (pt (cdr seg)) + (let* ((px1 (cdr pt)) + (px1 (osm--lon-to-x (if (consp px1) (car px1) px1) osm--zoom)) + (py1 (osm--lat-to-y (car pt) osm--zoom)) + (pdx (- px1 (car p0))) + (pdy (- py1 (cdr p0)))) + ;; Ignore point if too close to last point + (unless (< (+ (* pdx pdx) (* pdy pdy)) 50) + (let* ((p1 (cons px1 py1)) + (line (cons p0 p1)) + (x0 (/ (car p0) 256)) + (y0 (/ (cdr p0) 256)) + (x1 (/ px1 256)) + (y1 (/ py1 256)) + (sx (if (< x0 x1) 1 -1)) + (sy (if (< y0 y1) 1 -1)) + (dx (* sx (- x1 x0))) + (dy (* sy (- y0 y1))) + (err (+ dx dy))) + ;; Bresenham + (while + (let ((ey (> (* err 2) dy)) + (ex (< (* err 2) dx))) + (push line (gethash (cons x0 y0) tracks)) + (unless (and (= x0 x1) (= y0 y1)) + (when (and ey ex) + (push line (gethash (cons x0 (+ y0 sy)) tracks)) + (push line (gethash (cons (+ x0 sx) y0) tracks))) + (when ey + (cl-incf err dy) + (cl-incf x0 sx)) + (when ex + (cl-incf err dx) + (cl-incf y0 sy)) + t))) + (setq p0 p1)))))))) + +(defun osm--get-overlays (x y) + "Compute overlays and return the overlays in tile X/Y." + (unless (eq (car osm--overlays) osm--zoom) + ;; TODO: Do not compute overlays for the entire map, only for a reasonable + ;; view port around the current center, depending on the size of the + ;; window. Otherwise the spatial hash map for the tracks gets very large if + ;; a line segment spans many tiles. + (let ((pins (make-hash-table :test #'equal)) + (tracks (make-hash-table :test #'equal))) + (osm--each-pin (apply-partially #'osm--add-pin pins)) + (dolist (file osm--gpx-files) + (dolist (seg (cadr file)) + (osm--add-track tracks seg))) + (osm--add-track tracks osm--track) + (setq osm--overlays (list osm--zoom pins tracks)))) + (let ((pins (gethash (cons x y) (cadr osm--overlays))) + (tracks (gethash (cons x y) (caddr osm--overlays)))) + (and (or pins tracks) (cons pins tracks)))) + +(autoload 'svg--image-data "svg") +(defun osm--draw-tile (x y tpin) + "Make tile at X/Y from FILE. +TPIN is an optional pin." + (let ((file (osm--tile-file x y osm--zoom)) + overlays) + (when (file-exists-p file) + (if (or (setq overlays (osm--get-overlays x y)) (eq osm-tile-border t) tpin) + (let* ((areas nil) + (x0 (* 256 x)) + (y0 (* 256 y)) + (svg-pin + (lambda (pin) + (pcase-let* ((`(,p ,q ,_lat ,_lon ,id ,name) pin) + (bg (cdr (assq id osm-pin-colors)))) + (setq p (- p x0) q (- q y0)) + (push `((poly . [,p ,q ,(- p 20) ,(- q 40) ,p ,(- q 50) ,(+ p 20) ,(- q 40) ]) + ,id (help-echo ,(truncate-string-to-width name 40 0 nil t))) + areas) + ;; https://commons.wikimedia.org/wiki/File:Simpleicons_Places_map-marker-1.svg + (format " +<g fill='%s' stroke='#000' stroke-width='9' transform='translate(%s %s) scale(0.09) translate(-256 -512)'> +<path d='M256 0C167.641 0 96 71.625 96 160c0 24.75 5.625 48.219 15.672 +69.125C112.234 230.313 256 512 256 512l142.594-279.375 +C409.719 210.844 416 186.156 416 160C416 71.625 344.375 +0 256 0z M256 256c-53.016 0-96-43-96-96s42.984-96 96-96 +c53 0 96 43 96 96S309 256 256 256z'/> +</g>" bg p q)))) + (svg-text + (concat "<svg width='256' height='256' version='1.1' +xmlns='http://www.w3.org/2000/svg' xmlns:xlink='http://www.w3.org/1999/xlink'> +<image xlink:href='" + (file-name-nondirectory file) + "' height='256' width='256'/>" + (when-let (track (cdr overlays)) + (format + "<path style='%s' d='%s'/>" + osm-track-style + (let (last) + (mapconcat + (pcase-lambda (`(,beg . ,end)) + (prog1 + (if (equal beg last) + (format "L%s %s" (- (car end) x0) (- (cdr end) y0)) + (format "M%s %sL%s %s" + (- (car beg) x0) (- (cdr beg) y0) + (- (car end) x0) (- (cdr end) y0))) + (setq last end))) + track "")))) + (pcase-exhaustive osm-tile-border + ('nil nil) + ('debug "<path d='M 1 1 L 1 255 255 255 255 1 Z' stroke='#000' stroke-width='2' fill='none'/>") + ('t "<path d='M 0 0 L 0 256 256 256' stroke='#000' fill='none'/>")) + (mapconcat svg-pin (car overlays) "") + (and tpin (funcall svg-pin tpin)) + "</svg>"))) + (list 'image :width 256 :height 256 :type 'svg :base-uri file :data svg-text :map areas)) + (list 'image :width 256 :height 256 :file file :type + (if (member (file-name-extension file) '("jpg" "jpeg")) + 'jpeg 'png)))))) + +(defun osm--get-tile (x y) + "Get tile at X/Y." + (pcase osm--pin + ((and `(,lat ,lon ,_id ,name) + (guard (osm--pin-inside-p x y lat lon))) + (osm--draw-tile x y (list (osm--lon-to-x lon osm--zoom) + (osm--lat-to-y lat osm--zoom) + lat lon 'osm-selected name))) + (_ + (let* ((key `(,osm-server ,osm--zoom ,x . ,y)) + (tile (and osm--tile-cache (gethash key osm--tile-cache)))) + (if tile + (progn (setcar tile osm--tile-age) (cdr tile)) + (setq tile (osm--draw-tile x y nil)) + (when tile + (when osm-max-tiles + (unless osm--tile-cache + (setq osm--tile-cache (make-hash-table :test #'equal :size osm-max-tiles))) + (puthash key (cons osm--tile-age tile) osm--tile-cache)) + tile)))))) + +(defun osm--display-tile (x y tile) + "Display TILE at X/Y." + (let ((i (- x (/ (osm--x0) 256))) + (j (- y (/ (osm--y0) 256)))) + (when (and (>= i 0) (< i osm--nx) (>= j 0) (< j osm--ny)) + (let* ((mx (if (= 0 i) (mod (osm--x0) 256) 0)) + (my (if (= 0 j) (mod (osm--y0) 256) 0)) + (pos (+ (point-min) (* j (1+ osm--nx)) i))) + (unless tile + (setq tile (cons 'image osm--placeholder))) + (with-silent-modifications + (put-text-property + pos (1+ pos) 'display + (if (or (/= 0 mx) (/= 0 my)) + `((slice ,mx ,my ,(- 256 mx) ,(- 256 my)) ,tile) + tile))))))) + +;;;###autoload +(defun osm-home () + "Go to home coordinates." + (interactive) + (pcase osm-home + (`(,lat ,lon ,zoom) + (osm--goto lat lon zoom nil 'osm-home "Home")))) + +(defun osm--download-queue-info () + "Return queue info string." + (when osm--download-processes + (format "[%s/%s/%s]" + (cl-loop for (_ . p) in osm--download-processes sum (length p)) + (length osm--download-active) + (length osm--download-queue)))) + +(defun osm--revert (&rest _) + "Revert osm buffers." + (clear-image-cache t) ;; Make absolutely sure that the tiles are redrawn. + (setq osm--tile-cache nil) + (osm--each + (setq osm--overlays nil) + (osm--update))) + +(defun osm--resize (&rest _) + "Resize buffer." + (when (eq major-mode #'osm-mode) + (osm--update))) + +(defun osm--header-button (text action) + "Format header line button with TEXT and ACTION." + (propertize text + 'keymap (define-keymap "<header-line> <mouse-1>" + (if (commandp action) + (lambda () + (interactive "@") + (call-interactively action)) + action)) + 'face '(:box (:line-width -2 :style released-button)) + 'mouse-face '(:box (:line-width -2 :style pressed-button)))) + +(defun osm--update-header () + "Update header line." + (let* ((meter-per-pixel (/ (* 156543.03 (cos (/ osm--lat (/ 180.0 float-pi)))) (expt 2 osm--zoom))) + (server (osm--server-property :name)) + (meter 1) (idx 0) + (factor '(2 2.5 2)) + (sep #(" " 0 1 (display (space :width (1)))))) + (while (and (< idx 20) (< (/ (* meter (nth (mod idx 3) factor)) meter-per-pixel) 150)) + (setq meter (round (* meter (nth (mod idx 3) factor)))) + (cl-incf idx)) + (setq-local + header-line-format + (list + (osm--header-button " ☰ " (osm--menu-item osm-mode-menu)) sep + (osm--header-button (format " %s " server) + (osm--menu-item #'osm--server-menu)) sep + (osm--header-button " + " #'osm-zoom-in) sep + (osm--header-button " - " #'osm-zoom-out) + (format " Z%-2d " osm--zoom) + #(" " 0 1 (display (space :align-to (- center 15)))) + (format #(" %7.2f° %7.2f°" 0 14 (face bold)) osm--lat osm--lon) + #(" " 0 1 (display (space :align-to (- right 20)))) + (format "%3s " (if (>= meter 1000) (/ meter 1000) meter)) + (if (>= meter 1000) "km " "m ") + #(" " 0 1 (face (:inverse-video t) display (space :width (3)))) + (propertize " " 'face '(:strike-through t) + 'display `(space :width (,(floor (/ meter meter-per-pixel))))) + #(" " 0 1 (face (:inverse-video t) display (space :width (3)))))))) + +(defun osm--update () + "Update map display." + (osm--barf-unless-osm) + (osm--purge-tile-cache) + (osm--purge-directory) + (osm--rename-buffer) + (osm--update-sizes) + (osm--update-header) + (osm--update-buffer) + (osm--update-copyright) + (osm--process-download-queue)) + +(defun osm--update-sizes () + "Update window sizes." + (let* ((windows (or (get-buffer-window-list) (list (frame-root-window)))) + (win-width (cl-loop for w in windows maximize (window-pixel-width w))) + (win-height (cl-loop for w in windows maximize (window-pixel-height w)))) + (setq osm--wx (/ win-width 2) + osm--wy (/ win-height 2) + osm--nx (1+ (ceiling win-width 256)) + osm--ny (1+ (ceiling win-height 256))))) + +(defun osm--copyright-link (text url) + "Format link with TEXT to URL." + (propertize text + 'face 'button + 'mouse-face 'highlight + 'help-echo + (format "Go to %s" url) + 'keymap + (define-keymap "<tab-line> <mouse-1>" + (lambda () + (interactive) + (browse-url url))))) + +(defun osm--update-copyright () + "Update copyright info." + (let ((copyright (and osm-copyright (osm--server-property :copyright)))) + (if (not copyright) + (when (eq 'osm-copyright (car-safe tab-line-format)) + (kill-local-variable 'tab-line-format)) + (setq copyright (replace-regexp-in-string + "{\\(.*?\\)|\\(.*?\\)}" + (lambda (str) + (osm--copyright-link + (match-string 1 str) + (match-string 2 str))) + (concat + " " + (string-join (ensure-list copyright) " | ") + #(" " 0 1 (display (space :align-to (+ 42 right))))))) + (add-face-text-property + 0 (length copyright) + '(:inherit (header-line variable-pitch) :height 0.65) + t copyright) + (setq-local tab-line-format (list 'osm-copyright copyright))))) + +(defun osm--update-buffer () + "Update buffer display." + (with-silent-modifications + (erase-buffer) + (dotimes (_j osm--ny) + (insert (make-string osm--nx ?\s) "\n")) + (put-text-property (point-min) (point-max) 'pointer 'arrow) + (goto-char (point-min)) + (let ((tx (/ (osm--x0) 256)) + (ty (/ (osm--y0) 256))) + (dotimes (j osm--ny) + (dotimes (i osm--nx) + (let* ((x (+ i tx)) + (y (+ j ty)) + (tile (osm--get-tile x y))) + (osm--display-tile x y tile) + (unless tile (osm--enqueue-download x y)))))))) + +(defun osm--process-download-queue () + "Process the download queue." + (setq osm--download-queue + (sort + (cl-loop with tx = (/ (osm--x0) 256) + with ty = (/ (osm--y0) 256) + for job in osm--download-queue + for (_server zoom x y) = job + if (and (= zoom osm--zoom) + (>= x tx) (< x (+ tx osm--nx)) + (>= y ty) (< y (+ ty osm--ny))) + collect job) + (let ((tx (/ (osm--x) 256)) + (ty (/ (osm--y) 256))) + (pcase-lambda (`(,_s1 ,_z1 ,x1 ,y1) `(,_s2 ,_z2 ,x2 ,y2)) + (setq x1 (- x1 tx) y1 (- y1 ty) x2 (- x2 tx) y2 (- y2 ty)) + (< (+ (* x1 x1) (* y1 y1)) (+ (* x2 x2) (* y2 y2))))))) + (osm--download)) + +(defun osm--purge-tile-cache () + "Purge old tiles from the tile cache." + (cl-incf osm--tile-age) + (when (and osm--tile-cache (> (hash-table-count osm--tile-cache) osm-max-tiles)) + (let (items) + (maphash (lambda (k v) (push (list (car v) (cdr v) k) items)) osm--tile-cache) + (setq items (sort items #'car-less-than-car)) + (cl-loop repeat (- (hash-table-count osm--tile-cache) osm-max-tiles) + for (_age tile key) in items do + (image-flush tile t) + (remhash key osm--tile-cache))))) + +(defun osm--bookmark-record-default () + "Make osm bookmark record." + (osm--bookmark-record (osm--bookmark-name osm--lat osm--lon nil) + osm--lat osm--lon nil)) + +(defun osm--bookmark-record (name lat lon loc) + "Make osm bookmark record with NAME and LOC description at LAT/LON." + (setq bookmark-current-bookmark nil) ;; Reset bookmark to use new name + `(,name + (location . ,(osm--location-name lat lon loc 6)) + (coordinates ,lat ,lon ,osm--zoom) + (server . ,osm-server) + (handler . ,#'osm-bookmark-jump))) + +(defun osm--org-link-props () + "Return Org link properties." + (pcase-let* ((`(,lat ,lon ,loc) (osm--fetch-location-data "New Org Link")) + (name (osm--location-name lat lon loc 2))) + (list :type "geo" + :description + (if (eq osm-server (default-value 'osm-server)) + (string-remove-suffix (concat " " (osm--server-property :name)) + name) + name) + :link + (format "geo:%.6f,%.6f;z=%s%s" + lat lon osm--zoom + (if (eq osm-server (default-value 'osm-server)) "" + (format ";s=%s" osm-server)))))) + +(defun osm--rename-buffer () + "Rename current buffer." + (setq list-buffers-directory (osm--location-name osm--lat osm--lon nil 6)) + (rename-buffer + (format "*osm: %s*" (osm--location-name osm--lat osm--lon nil 2)) + 'unique)) + +(defun osm--location-name (lat lon loc prec) + "Format location string LAT/LON with optional LOC description. +The coordinates are formatted with precision PREC." + (format (format "%%s%%.%df° %%.%df° Z%%s %%s" prec prec) + (if loc (concat loc ", ") "") + lat lon osm--zoom (osm--server-property :name))) + +(defun osm--bookmark-name (lat lon loc) + "Return bookmark name for LAT/LON/LOC." + (concat "osm: " (osm--location-name lat lon loc 2))) + +(defun osm--goto (lat lon zoom server id name) + "Go to LAT/LON/ZOOM, change SERVER. +Optionally place pin with ID and NAME." + ;; Server not found + (when (and server (not (assq server osm-server-list))) (setq server nil)) + (with-current-buffer + (or + (and (eq major-mode #'osm-mode) (current-buffer)) + (let ((def-server (or server osm-server)) + (def-lat (or lat (nth 0 osm-home))) + (def-lon (or lon (nth 1 osm-home))) + (def-zoom (or zoom (nth 2 osm-home)))) + ;; Search for existing buffer + (cl-loop + for buf in (buffer-list) thereis + (and (equal (buffer-local-value 'major-mode buf) #'osm-mode) + (equal (buffer-local-value 'osm-server buf) def-server) + (equal (buffer-local-value 'osm--zoom buf) def-zoom) + (equal (buffer-local-value 'osm--lat buf) def-lat) + (equal (buffer-local-value 'osm--lon buf) def-lon) + buf))) + (generate-new-buffer "*osm*")) + (unless (eq major-mode #'osm-mode) + (osm-mode)) + (when (and server (not (eq osm-server server))) + (setq-local osm-server server + osm--download-queue nil)) + (when (or (not (and osm--lon osm--lat)) lat) + (setq osm--lat (or lat (nth 0 osm-home)) + osm--lon (or lon (nth 1 osm-home)) + osm--zoom (or zoom (nth 2 osm-home))) + (when id + (osm--set-pin id osm--lat osm--lon name))) + (prog1 (pop-to-buffer (current-buffer)) + (osm--update)))) + +(defun osm--set-pin (id lat lon name &optional quiet) + "Set pin at LAT/LON with ID and NAME. +Print NAME if not QUIET." + (setq name (or name (format "Location %.6f° %.6f°" lat lon))) + (setq osm--pin (list lat lon (or id 'osm-selected) name)) + (unless quiet (message "%s" name))) + +(defun osm--set-pin-event (event &optional id name quiet) + "Set selection pin with ID and NAME at location of EVENT. +Print NAME if not QUIET." + (pcase-let ((`(,x . ,y) (posn-x-y (event-start event)))) + (osm--set-pin id + (osm--y-to-lat (+ (osm--y0) y) osm--zoom) + (osm--x-to-lon (+ (osm--x0) x) osm--zoom) + name quiet))) + +;;;###autoload +(defun osm-goto (lat lon zoom) + "Go to LAT/LON/ZOOM." + (interactive + (pcase-let ((`(,lat ,lon ,zoom) + (mapcar #'string-to-number + (split-string (read-string "Lat Lon (Zoom): ") nil t)))) + (setq zoom (or zoom osm--zoom 11)) + (unless (and (numberp lat) (numberp lon) (numberp zoom)) + (error "Invalid coordinate")) + (list lat lon zoom))) + (osm--goto lat lon zoom nil 'osm-selected nil) + nil) + +;;;###autoload +(defun osm (&rest link) + "Go to LINK. +When called interactively, call the function `osm-home'." + (interactive (list 'home)) + (pcase link + ('(home) + (osm-home)) + (`(,lat ,lon ,zoom . ,server) + (setq server (car server)) + (unless (and server (symbolp server)) (setq server nil)) ;; Ignore comment + (osm--goto lat lon zoom server 'osm-selected "Elisp Link")) + ((and `(,url . ,_) (guard (stringp url))) + (if (string-match + "\\`geo:\\([0-9.-]+\\),\\([0-9.-]+\\)\\(?:,[0-9.-]+\\)?\\(;.+\\'\\|\\'\\)" url) + (let* ((lat (string-to-number (match-string 1 url))) + (lon (string-to-number (match-string 2 url))) + (args (url-parse-args (match-string 3 url) "")) + (zoom (cdr (assoc "z" args))) + (server (cdr (assoc "s" args)))) + (osm--goto lat lon + (and zoom (string-to-number zoom)) + (and server (intern-soft server)) + 'osm-selected "Geo Link")) + (osm-search (string-remove-prefix "geo:" url)))) + (_ (error "Invalid osm link")))) + +;;;###autoload +(defun osm-bookmark-jump (bm) + "Jump to osm bookmark BM." + (interactive (list (osm--bookmark-read))) + (pcase-let ((`(,lat ,lon ,zoom) (bookmark-prop-get bm 'coordinates))) + (set-buffer (osm--goto lat lon zoom + (bookmark-prop-get bm 'server) + 'osm-bookmark (car bm))))) +(put 'osm-bookmark-jump 'bookmark-handler-type "Osm") + +;;;###autoload +(defun osm-bookmark-delete (bm) + "Delete osm bookmark BM." + (interactive (list (osm--bookmark-read))) + (when (y-or-n-p (format "Delete bookmark `%s'? " bm)) + (bookmark-delete bm) + (setq osm--pin nil) + (osm--revert))) + +;;;###autoload +(defun osm-bookmark-rename (old-name) + "Rename osm bookmark OLD-NAME." + (interactive (list (car (osm--bookmark-read)))) + (let ((new-name (read-from-minibuffer "New name: " old-name nil nil + 'bookmark-history old-name))) + (when osm--pin (setf (cadddr osm--pin) new-name)) + (bookmark-rename old-name new-name) + (osm--revert))) + +(defun osm--bookmark-read () + "Read bookmark name." + (bookmark-maybe-load-default-file) + (or (assoc + (pcase osm--pin + (`(,_lat ,_lon osm-bookmark ,name) name) + (_ (completing-read + "Bookmark: " + (or (cl-loop for bm in bookmark-alist + if (eq (bookmark-prop-get bm 'handler) #'osm-bookmark-jump) + collect (car bm)) + (error "No bookmarks found")) + nil t nil 'bookmark-history))) + bookmark-alist) + (error "No bookmark selected"))) + +(defun osm-bookmark-set () + "Create osm bookmark." + (interactive nil osm-mode) + (osm--barf-unless-osm) + (unwind-protect + (pcase-let* ((`(,lat ,lon ,loc) (osm--fetch-location-data "New Bookmark")) + (def (osm--bookmark-name lat lon loc)) + (name (read-from-minibuffer "Bookmark name: " def nil nil 'bookmark-history def)) + (bookmark-make-record-function + (lambda () (osm--bookmark-record name lat lon loc)))) + (bookmark-set name) + (message "Stored bookmark: %s" name) + (setf (caddr osm--pin) 'osm-bookmark)) + (osm--revert))) + +(defun osm--fetch-location-data (name) + "Fetch location info for NAME." + (when (mouse-event-p last-input-event) + (osm--set-pin-event last-input-event 'osm-selected name)) + (let ((lat (or (car osm--pin) osm--lat)) + (lon (or (cadr osm--pin) osm--lon))) + (osm--set-pin 'osm-selected lat lon name 'quiet) + (message "%s: Fetching name of %.2f° %.2f° from %s..." name lat lon osm-search-server) + ;; Redisplay before slow fetching + (osm--update) + (redisplay) + (list lat lon + (ignore-errors + (alist-get + 'display_name + (osm--fetch-json + (format "%s/reverse?format=json&accept-language=%s&zoom=%s&lat=%s&lon=%s" + osm-search-server osm-search-language + (min 18 (max 3 osm--zoom)) lat lon))))))) + +(defun osm--track-index () + "Return index of selected track way point." + (cl-loop for idx from 0 for (lat lon _) in osm--track + if (and (equal lat (car osm--pin)) (equal lon (cadr osm--pin))) + return idx)) + +(defun osm--track-delete () + "Delete track way point." + (when-let ((idx (osm--track-index))) + ;; Delete pin + (cl-callf2 delq (nth idx osm--track) osm--track) + (setq osm--pin nil + idx (min idx (1- (length osm--track)))) + ;; Select next pin + (pcase (nth idx osm--track) + (`(,lat ,lon ,name) + (osm--set-pin 'osm-track lat lon name 'quiet))) + ;; Rename pins after deletion + (cl-loop for idx from (length osm--track) downto 1 + for pt in osm--track + if (string-match-p "\\`WP[0-9]+\\'" (caddr pt)) do + (setf (caddr pt) (format "WP%s" idx))) + (osm--track-length) + (osm--revert))) + +(defun osm--track-rename () + "Rename track way point." + (when-let ((pt (nth (osm--track-index) osm--track)) + (old-name (caddr pt)) + (new-name (read-from-minibuffer "New name: " old-name nil nil nil old-name))) + (setf (caddr pt) new-name + (cadddr osm--pin) new-name) + (osm--revert))) + +(defun osm-delete () + "Delete selected pin (bookmark or way point)." + (interactive nil osm-mode) + (osm--barf-unless-osm) + (pcase (caddr osm--pin) + ('nil nil) + ('osm-bookmark (osm-bookmark-delete (cadddr osm--pin))) + ('osm-track (osm--track-delete)) + (_ (setq osm--pin nil) (osm--update)))) + +(defun osm-rename () + "Rename selected pin (bookmark or way point)." + (interactive nil osm-mode) + (osm--barf-unless-osm) + (pcase (caddr osm--pin) + ('osm-bookmark (osm-bookmark-rename (cadddr osm--pin))) + ('osm-track (osm--track-rename)))) + +;;;###autoload +(defun osm-jump () + "Jump to named pin." + (interactive) + (let (pins) + (osm--each-pin (lambda (id lat lon zoom name) + (push (list name (capitalize (substring (symbol-name id) 4)) + id lat lon zoom) + pins))) + (pcase (assoc (completing-read + "Jump: " + (lambda (str pred action) + (if (eq action 'metadata) + `(metadata + (group-function + . ,(lambda (pin transform) + (if transform pin + (cadr (assoc pin pins)))))) + (complete-with-action action pins str pred))) + nil t nil 'osm--jump-history) + pins) + (`(,name ,_group ,id ,lat ,lon ,zoom) (osm--goto lat lon zoom nil id name)) + (_ (user-error "No pin selected"))))) + +(defun osm--fetch-json (url) + "Get json from URL." + (osm--check-libraries) + (with-temp-buffer + (let* ((default-process-coding-system '(utf-8-unix . utf-8-unix)) + (status (apply #'call-process "curl" nil (current-buffer) nil + `(,@(split-string-and-unquote osm-curl-options) ,url)))) + (unless (eq status 0) + (error "Fetching %s exited with status %s" url status))) + (goto-char (point-min)) + (json-parse-buffer :array-type 'list :object-type 'alist))) + +(defun osm--search (needle) + "Globally search for NEEDLE and return the list of results." + (message "Contacting %s" osm-search-server) + (mapcar + (lambda (x) + (let ((lat (string-to-number (alist-get 'lat x))) + (lon (string-to-number (alist-get 'lon x)))) + `(,(format "%s (%.6f° %.6f°)" + (alist-get 'display_name x) + lat lon) + ,lat ,lon + ,@(mapcar #'string-to-number (alist-get 'boundingbox x))))) + (osm--fetch-json + (format "%s/search?format=json&accept-language=%s&q=%s" + osm-search-server osm-search-language + (url-encode-url needle))))) + +;;;###autoload +(defun osm-search (needle &optional lucky) + "Globally search for NEEDLE on `osm-search-server' and display the map. +If the prefix argument LUCKY is non-nil take the first result and jump there. +See `osm-search-server' and `osm-search-language' for customization." + (interactive + (list + (minibuffer-with-setup-hook + (lambda () + (when (and (eq completing-read-function #'completing-read-default) + (not (bound-and-true-p vertico-mode))) + ;; Override dreaded `minibuffer-complete-word' for default + ;; completion. When will this keybinding finally get removed from + ;; default completion? + (use-local-map (make-composed-keymap + (define-keymap "SPC" nil) + (current-local-map))))) + (completing-read "Location: " + (osm--sorted-table osm--search-history) + nil nil nil 'osm--search-history)) + current-prefix-arg)) + ;; TODO: Add search bounded to current viewbox, bounded=1, viewbox=x1,y1,x2,y2 + (let* ((results (or (osm--search needle) (error "No results for `%s'" needle))) + (selected + (or + (and (or lucky (not (cdr results))) (car results)) + (assoc + (minibuffer-with-setup-hook + (lambda () + (when (and (eq completing-read-function #'completing-read-default) + (not (bound-and-true-p vertico-mode)) + (not (bound-and-true-p icomplete-mode))) + (let ((message-log-max nil) + (inhibit-message t)) + ;; Show matches immediately for default completion. + (minibuffer-completion-help)))) + (completing-read + (format "Matches for '%s': " needle) + (osm--sorted-table results) + nil t nil t)) + results) + (error "No selection")))) + (osm--goto (cadr selected) (caddr selected) + (apply #'osm--boundingbox-to-zoom (cdddr selected)) + nil 'osm-selected (car selected)))) + +(defun osm--sorted-table (coll) + "Sorted completion table from COLL." + (lambda (str pred action) + (if (eq action 'metadata) + '(metadata (display-sort-function . identity) + (cycle-sort-function . identity)) + (complete-with-action action coll str pred)))) + +;;;###autoload +(defun osm-gpx-show (file) + "Show the tracks of gpx FILE in an `osm-mode' buffer." + (interactive "fGPX file: ") + (osm--check-libraries) + (let ((dom (with-temp-buffer + (insert-file-contents file) + (libxml-parse-xml-region (point-min) (point-max)))) + (min-lat 90) (max-lat -90) (min-lon 180) (max-lon -180)) + (unless (eq 'gpx (dom-tag dom)) + (setq dom (dom-child-by-tag dom 'gpx))) + (unless (and dom (eq 'gpx (dom-tag dom))) + (error "Not a GPX file")) + (setf (alist-get (abbreviate-file-name file) osm--gpx-files nil nil #'equal) + (cons + (cl-loop + for trk in (dom-children dom) + if (eq (dom-tag trk) 'trk) nconc + (cl-loop + for seg in (dom-children trk) + if (eq (dom-tag seg) 'trkseg) collect + (cl-loop + for pt in (dom-children seg) + if (eq (dom-tag pt) 'trkpt) collect + (let ((lat (string-to-number (dom-attr pt 'lat))) + (lon (string-to-number (dom-attr pt 'lon)))) + (setq min-lat (min lat min-lat) + max-lat (max lat max-lat) + min-lon (min lon min-lon) + max-lon (max lon max-lon)) + (cons lat lon))))) + (cl-loop + for pt in (dom-children dom) + if (eq (dom-tag pt) 'wpt) collect + (let ((lat (string-to-number (dom-attr pt 'lat))) + (lon (string-to-number (dom-attr pt 'lon)))) + (setq min-lat (min lat min-lat) + max-lat (max lat max-lat) + min-lon (min lon min-lon) + max-lon (max lon max-lon)) + (list lat lon (dom-text (dom-child-by-tag pt 'name))))))) + (osm--revert) + (osm--goto (/ (+ min-lat max-lat) 2) (/ (+ min-lon max-lon) 2) + (osm--boundingbox-to-zoom min-lat max-lat min-lon max-lon) + nil nil nil))) + +(defun osm-gpx-hide (file) + "Show the tracks of gpx FILE in an `osm-mode' buffer." + (interactive (list (completing-read "GPX file: " + (or osm--gpx-files + (error "No GPX files shown")) + nil t nil 'file-name-history))) + (cl-callf2 assoc-delete-all file osm--gpx-files) + (osm--revert)) + +(defun osm--server-annotation (cand) + "Annotation for server CAND." + (when-let ((copyright (osm--server-property :copyright (get-text-property 0 'osm--server cand))) + (str + (replace-regexp-in-string + "{\\(.*?\\)|.*?}" + (lambda (str) (match-string 1 str)) + (string-join (ensure-list copyright) " | ") copyright))) + (concat (propertize " " 'display `(space :align-to (- right ,(length str) 2))) + " " + str))) + +(defun osm--server-group (cand transform) + "Group function for server CAND with candidate TRANSFORM." + (if transform + cand + (osm--server-property :group (get-text-property 0 'osm--server cand)))) + +;;;###autoload +(defun osm-server (server) + "Select tile SERVER." + (interactive + (let* ((max-name (cl-loop for (_ . x) in osm-server-list + maximize (length (plist-get x :name)))) + (fmt (concat + (propertize (format "%%-%ds " max-name) + 'face 'font-lock-comment-face) + " %s")) + (servers + (mapcar + (lambda (x) + (propertize + (format fmt + (plist-get (cdr x) :name) + (or (plist-get (cdr x) :description) "")) + 'osm--server (car x))) + osm-server-list)) + (selected (completing-read + "Server: " + (lambda (str pred action) + (if (eq action 'metadata) + `(metadata + (annotation-function + . ,(and osm-copyright #'osm--server-annotation)) + (group-function . ,#'osm--server-group)) + (complete-with-action action servers str pred))) + nil t nil 'osm--server-history + (format fmt + (osm--server-property :name) + (or (osm--server-property :description) ""))))) + (list + (get-text-property 0 'osm--server + (or (car (member selected servers)) + (error "No server selected")))))) + (osm--goto nil nil nil server nil nil)) + +(defun osm-save-url (&optional arg) + "Save coordinates as url in the kill ring. +If prefix ARG is given, store url as Elisp expression." + (interactive "P" osm-mode) + (osm--barf-unless-osm) + (pcase-let* ((`(,lat ,lon ,loc) (osm--fetch-location-data "New Link")) + (server (and (not (eq osm-server (default-value 'osm-server))) osm-server)) + (url (if arg + (format "(osm %.6f %.6f %s%s%s)" + lat lon osm--zoom + (if server (format " '%s" osm-server) "") + (if loc (format " %S" loc) "")) + (format "geo:%.6f,%.6f;z=%s%s%s" + lat lon osm--zoom + (if server (format ";s=%s" osm-server) "") + (if loc (format " (%s)" loc) ""))))) + (kill-new url) + (message "Saved in the kill ring: %s" url))) + +(cl-defun osm-add-server (server + &rest properties + &key name description group url ext max-connections + max-zoom min-zoom download-batch subdomains copyright) + "Add SERVER with PROPERTIES to `osm-server-list'. +The properties are checked as keyword arguments. See +`osm-server-list' for documentation of the keywords." + (declare (indent 1)) + (ignore name description group url max-connections max-zoom + min-zoom download-batch subdomains copyright) + (dolist (sym '(:name :description :group :url)) + (unless (stringp (plist-get properties sym)) + (error "Server property %s is required" sym))) + (unless (and server (symbolp server)) + (error "Server id must be a symbol")) + (setf (alist-get server osm-server-list) properties) + nil) + +;;;###autoload +(add-to-list 'browse-url-default-handlers '("\\`geo:" . osm)) + +;;;###autoload +(eval-after-load 'ol + (lambda () + (declare-function org-link-set-parameters "ol") + (declare-function osm--org-link-props "ext:osm") + (org-link-set-parameters + "geo" + :follow (lambda (link _) (osm (concat "geo:" link))) + :store (lambda () + (when (eq major-mode 'osm-mode) + (apply 'org-link-store-props (osm--org-link-props))))))) + +(provide 'osm) +;;; osm.el ends here diff --git a/emacs/elpa/osm-20241119.2137/osm.elc b/emacs/elpa/osm-20241119.2137/osm.elc Binary files differ. diff --git a/emacs/elpa/pdf-tools-20240429.407/epdfinfo b/emacs/elpa/pdf-tools-20240429.407/epdfinfo Binary files differ. diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeCache.txt b/emacs/elpa/vterm-20240825.133/build/CMakeCache.txt @@ -1,355 +0,0 @@ -# This is the CMakeCache file. -# For build in directory: /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build -# It was generated by CMake: /usr/bin/cmake -# You can edit this file to change values found and used by cmake. -# If you do not want to change any of the values, simply exit the editor. -# If you do want to change a value, simply edit, save, and exit the editor. -# The syntax for the file is as follows: -# KEY:TYPE=VALUE -# KEY is the name of a variable in the cache. -# TYPE is a hint to GUIs for the type of VALUE, DO NOT EDIT TYPE!. -# VALUE is the current value for the KEY. - -######################## -# EXTERNAL cache entries -######################## - -//Path to a program. -CMAKE_ADDR2LINE:FILEPATH=/usr/bin/addr2line - -//Path to a program. -CMAKE_AR:FILEPATH=/usr/bin/ar - -//Build type (default RelWithDebInfo) -CMAKE_BUILD_TYPE:STRING=RelWithDebInfo - -//Enable/Disable color output during build. -CMAKE_COLOR_MAKEFILE:BOOL=ON - -//C compiler -CMAKE_C_COMPILER:STRING=/usr/bin/cc - -//A wrapper around 'ar' adding the appropriate '--plugin' option -// for the GCC compiler -CMAKE_C_COMPILER_AR:FILEPATH=/usr/bin/gcc-ar - -//A wrapper around 'ranlib' adding the appropriate '--plugin' option -// for the GCC compiler -CMAKE_C_COMPILER_RANLIB:FILEPATH=/usr/bin/gcc-ranlib - -//Flags used by the C compiler during all build types. -CMAKE_C_FLAGS:STRING= - -//Flags used by the C compiler during DEBUG builds. -CMAKE_C_FLAGS_DEBUG:STRING=-g - -//Flags used by the C compiler during MINSIZEREL builds. -CMAKE_C_FLAGS_MINSIZEREL:STRING=-Os -DNDEBUG - -//Flags used by the C compiler during RELEASE builds. -CMAKE_C_FLAGS_RELEASE:STRING=-O3 -DNDEBUG - -//Flags used by the C compiler during RELWITHDEBINFO builds. -CMAKE_C_FLAGS_RELWITHDEBINFO:STRING=-O2 -g -DNDEBUG - -//Path to a program. -CMAKE_DLLTOOL:FILEPATH=CMAKE_DLLTOOL-NOTFOUND - -//Flags used by the linker during all build types. -CMAKE_EXE_LINKER_FLAGS:STRING= - -//Flags used by the linker during DEBUG builds. -CMAKE_EXE_LINKER_FLAGS_DEBUG:STRING= - -//Flags used by the linker during MINSIZEREL builds. -CMAKE_EXE_LINKER_FLAGS_MINSIZEREL:STRING= - -//Flags used by the linker during RELEASE builds. -CMAKE_EXE_LINKER_FLAGS_RELEASE:STRING= - -//Flags used by the linker during RELWITHDEBINFO builds. -CMAKE_EXE_LINKER_FLAGS_RELWITHDEBINFO:STRING= - -//Enable/Disable output of compile commands during generation. -CMAKE_EXPORT_COMPILE_COMMANDS:BOOL= - -//Value Computed by CMake. -CMAKE_FIND_PACKAGE_REDIRECTS_DIR:STATIC=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/pkgRedirects - -//Install path prefix, prepended onto install directories. -CMAKE_INSTALL_PREFIX:PATH=/usr/local - -//Path to a program. -CMAKE_LINKER:FILEPATH=/usr/bin/ld - -//Path to a program. -CMAKE_MAKE_PROGRAM:FILEPATH=/usr/bin/make - -//Flags used by the linker during the creation of modules during -// all build types. -CMAKE_MODULE_LINKER_FLAGS:STRING= - -//Flags used by the linker during the creation of modules during -// DEBUG builds. -CMAKE_MODULE_LINKER_FLAGS_DEBUG:STRING= - -//Flags used by the linker during the creation of modules during -// MINSIZEREL builds. -CMAKE_MODULE_LINKER_FLAGS_MINSIZEREL:STRING= - -//Flags used by the linker during the creation of modules during -// RELEASE builds. -CMAKE_MODULE_LINKER_FLAGS_RELEASE:STRING= - -//Flags used by the linker during the creation of modules during -// RELWITHDEBINFO builds. -CMAKE_MODULE_LINKER_FLAGS_RELWITHDEBINFO:STRING= - -//Path to a program. -CMAKE_NM:FILEPATH=/usr/bin/nm - -//Path to a program. -CMAKE_OBJCOPY:FILEPATH=/usr/bin/objcopy - -//Path to a program. -CMAKE_OBJDUMP:FILEPATH=/usr/bin/objdump - -//Value Computed by CMake -CMAKE_PROJECT_DESCRIPTION:STATIC= - -//Value Computed by CMake -CMAKE_PROJECT_HOMEPAGE_URL:STATIC= - -//Value Computed by CMake -CMAKE_PROJECT_NAME:STATIC=emacs-libvterm - -//Path to a program. -CMAKE_RANLIB:FILEPATH=/usr/bin/ranlib - -//Path to a program. -CMAKE_READELF:FILEPATH=/usr/bin/readelf - -//Flags used by the linker during the creation of shared libraries -// during all build types. -CMAKE_SHARED_LINKER_FLAGS:STRING= - -//Flags used by the linker during the creation of shared libraries -// during DEBUG builds. -CMAKE_SHARED_LINKER_FLAGS_DEBUG:STRING= - -//Flags used by the linker during the creation of shared libraries -// during MINSIZEREL builds. -CMAKE_SHARED_LINKER_FLAGS_MINSIZEREL:STRING= - -//Flags used by the linker during the creation of shared libraries -// during RELEASE builds. -CMAKE_SHARED_LINKER_FLAGS_RELEASE:STRING= - -//Flags used by the linker during the creation of shared libraries -// during RELWITHDEBINFO builds. -CMAKE_SHARED_LINKER_FLAGS_RELWITHDEBINFO:STRING= - -//If set, runtime paths are not added when installing shared libraries, -// but are added when building. -CMAKE_SKIP_INSTALL_RPATH:BOOL=NO - -//If set, runtime paths are not added when using shared libraries. -CMAKE_SKIP_RPATH:BOOL=NO - -//Flags used by the linker during the creation of static libraries -// during all build types. -CMAKE_STATIC_LINKER_FLAGS:STRING= - -//Flags used by the linker during the creation of static libraries -// during DEBUG builds. -CMAKE_STATIC_LINKER_FLAGS_DEBUG:STRING= - -//Flags used by the linker during the creation of static libraries -// during MINSIZEREL builds. -CMAKE_STATIC_LINKER_FLAGS_MINSIZEREL:STRING= - -//Flags used by the linker during the creation of static libraries -// during RELEASE builds. -CMAKE_STATIC_LINKER_FLAGS_RELEASE:STRING= - -//Flags used by the linker during the creation of static libraries -// during RELWITHDEBINFO builds. -CMAKE_STATIC_LINKER_FLAGS_RELWITHDEBINFO:STRING= - -//Path to a program. -CMAKE_STRIP:FILEPATH=/usr/bin/strip - -//Path to a program. -CMAKE_TAPI:FILEPATH=CMAKE_TAPI-NOTFOUND - -//If this value is on, makefiles will be generated without the -// .SILENT directive, and all commands will be echoed to the console -// during the make. This is useful for debugging only. With Visual -// Studio IDE projects all commands are done without /nologo. -CMAKE_VERBOSE_MAKEFILE:BOOL=FALSE - -//Git command line client -GIT_EXECUTABLE:FILEPATH=/usr/bin/git - -//Path to a program. -LIBTOOL:FILEPATH=/usr/bin/libtool - -//Path to a file. -LIBVTERM_INCLUDE_DIR:PATH=LIBVTERM_INCLUDE_DIR-NOTFOUND - -//Use system libvterm instead of the vendored version. -USE_SYSTEM_LIBVTERM:BOOL=ON - -//Value Computed by CMake -emacs-libvterm_BINARY_DIR:STATIC=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build - -//Value Computed by CMake -emacs-libvterm_IS_TOP_LEVEL:STATIC=ON - -//Value Computed by CMake -emacs-libvterm_SOURCE_DIR:STATIC=/home/dwrz/.config/emacs/elpa/vterm-20240825.133 - -//Dependencies for the target -vterm-module_LIB_DEPENDS:STATIC=general;vterm; - - -######################## -# INTERNAL cache entries -######################## - -//ADVANCED property for variable: CMAKE_ADDR2LINE -CMAKE_ADDR2LINE-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_AR -CMAKE_AR-ADVANCED:INTERNAL=1 -//This is the directory where this CMakeCache.txt was created -CMAKE_CACHEFILE_DIR:INTERNAL=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build -//Major version of cmake used to create the current loaded cache -CMAKE_CACHE_MAJOR_VERSION:INTERNAL=3 -//Minor version of cmake used to create the current loaded cache -CMAKE_CACHE_MINOR_VERSION:INTERNAL=30 -//Patch version of cmake used to create the current loaded cache -CMAKE_CACHE_PATCH_VERSION:INTERNAL=3 -//ADVANCED property for variable: CMAKE_COLOR_MAKEFILE -CMAKE_COLOR_MAKEFILE-ADVANCED:INTERNAL=1 -//Path to CMake executable. -CMAKE_COMMAND:INTERNAL=/usr/bin/cmake -//Path to cpack program executable. -CMAKE_CPACK_COMMAND:INTERNAL=/usr/bin/cpack -//Path to ctest program executable. -CMAKE_CTEST_COMMAND:INTERNAL=/usr/bin/ctest -//ADVANCED property for variable: CMAKE_C_COMPILER -CMAKE_C_COMPILER-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_C_COMPILER_AR -CMAKE_C_COMPILER_AR-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_C_COMPILER_RANLIB -CMAKE_C_COMPILER_RANLIB-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_C_FLAGS -CMAKE_C_FLAGS-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_C_FLAGS_DEBUG -CMAKE_C_FLAGS_DEBUG-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_C_FLAGS_MINSIZEREL -CMAKE_C_FLAGS_MINSIZEREL-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_C_FLAGS_RELEASE -CMAKE_C_FLAGS_RELEASE-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_C_FLAGS_RELWITHDEBINFO -CMAKE_C_FLAGS_RELWITHDEBINFO-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_DLLTOOL -CMAKE_DLLTOOL-ADVANCED:INTERNAL=1 -//Path to cache edit program executable. -CMAKE_EDIT_COMMAND:INTERNAL=/usr/bin/ccmake -//Executable file format -CMAKE_EXECUTABLE_FORMAT:INTERNAL=ELF -//ADVANCED property for variable: CMAKE_EXE_LINKER_FLAGS -CMAKE_EXE_LINKER_FLAGS-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_EXE_LINKER_FLAGS_DEBUG -CMAKE_EXE_LINKER_FLAGS_DEBUG-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_EXE_LINKER_FLAGS_MINSIZEREL -CMAKE_EXE_LINKER_FLAGS_MINSIZEREL-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_EXE_LINKER_FLAGS_RELEASE -CMAKE_EXE_LINKER_FLAGS_RELEASE-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_EXE_LINKER_FLAGS_RELWITHDEBINFO -CMAKE_EXE_LINKER_FLAGS_RELWITHDEBINFO-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_EXPORT_COMPILE_COMMANDS -CMAKE_EXPORT_COMPILE_COMMANDS-ADVANCED:INTERNAL=1 -//Name of external makefile project generator. -CMAKE_EXTRA_GENERATOR:INTERNAL= -//Name of generator. -CMAKE_GENERATOR:INTERNAL=Unix Makefiles -//Generator instance identifier. -CMAKE_GENERATOR_INSTANCE:INTERNAL= -//Name of generator platform. -CMAKE_GENERATOR_PLATFORM:INTERNAL= -//Name of generator toolset. -CMAKE_GENERATOR_TOOLSET:INTERNAL= -//Source directory with the top level CMakeLists.txt file for this -// project -CMAKE_HOME_DIRECTORY:INTERNAL=/home/dwrz/.config/emacs/elpa/vterm-20240825.133 -//Install .so files without execute permission. -CMAKE_INSTALL_SO_NO_EXE:INTERNAL=0 -//ADVANCED property for variable: CMAKE_LINKER -CMAKE_LINKER-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_MAKE_PROGRAM -CMAKE_MAKE_PROGRAM-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_MODULE_LINKER_FLAGS -CMAKE_MODULE_LINKER_FLAGS-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_MODULE_LINKER_FLAGS_DEBUG -CMAKE_MODULE_LINKER_FLAGS_DEBUG-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_MODULE_LINKER_FLAGS_MINSIZEREL -CMAKE_MODULE_LINKER_FLAGS_MINSIZEREL-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_MODULE_LINKER_FLAGS_RELEASE -CMAKE_MODULE_LINKER_FLAGS_RELEASE-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_MODULE_LINKER_FLAGS_RELWITHDEBINFO -CMAKE_MODULE_LINKER_FLAGS_RELWITHDEBINFO-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_NM -CMAKE_NM-ADVANCED:INTERNAL=1 -//number of local generators -CMAKE_NUMBER_OF_MAKEFILES:INTERNAL=1 -//ADVANCED property for variable: CMAKE_OBJCOPY -CMAKE_OBJCOPY-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_OBJDUMP -CMAKE_OBJDUMP-ADVANCED:INTERNAL=1 -//Platform information initialized -CMAKE_PLATFORM_INFO_INITIALIZED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_RANLIB -CMAKE_RANLIB-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_READELF -CMAKE_READELF-ADVANCED:INTERNAL=1 -//Path to CMake installation. -CMAKE_ROOT:INTERNAL=/usr/share/cmake -//ADVANCED property for variable: CMAKE_SHARED_LINKER_FLAGS -CMAKE_SHARED_LINKER_FLAGS-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_SHARED_LINKER_FLAGS_DEBUG -CMAKE_SHARED_LINKER_FLAGS_DEBUG-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_SHARED_LINKER_FLAGS_MINSIZEREL -CMAKE_SHARED_LINKER_FLAGS_MINSIZEREL-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_SHARED_LINKER_FLAGS_RELEASE -CMAKE_SHARED_LINKER_FLAGS_RELEASE-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_SHARED_LINKER_FLAGS_RELWITHDEBINFO -CMAKE_SHARED_LINKER_FLAGS_RELWITHDEBINFO-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_SKIP_INSTALL_RPATH -CMAKE_SKIP_INSTALL_RPATH-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_SKIP_RPATH -CMAKE_SKIP_RPATH-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_STATIC_LINKER_FLAGS -CMAKE_STATIC_LINKER_FLAGS-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_STATIC_LINKER_FLAGS_DEBUG -CMAKE_STATIC_LINKER_FLAGS_DEBUG-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_STATIC_LINKER_FLAGS_MINSIZEREL -CMAKE_STATIC_LINKER_FLAGS_MINSIZEREL-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_STATIC_LINKER_FLAGS_RELEASE -CMAKE_STATIC_LINKER_FLAGS_RELEASE-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_STATIC_LINKER_FLAGS_RELWITHDEBINFO -CMAKE_STATIC_LINKER_FLAGS_RELWITHDEBINFO-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_STRIP -CMAKE_STRIP-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_TAPI -CMAKE_TAPI-ADVANCED:INTERNAL=1 -//uname command -CMAKE_UNAME:INTERNAL=/usr/bin/uname -//ADVANCED property for variable: CMAKE_VERBOSE_MAKEFILE -CMAKE_VERBOSE_MAKEFILE-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: GIT_EXECUTABLE -GIT_EXECUTABLE-ADVANCED:INTERNAL=1 -//linker supports push/pop state -_CMAKE_LINKER_PUSHPOP_STATE_SUPPORTED:INTERNAL=TRUE - diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.2/CMakeCCompiler.cmake b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.2/CMakeCCompiler.cmake @@ -1,81 +0,0 @@ -set(CMAKE_C_COMPILER "/usr/bin/cc") -set(CMAKE_C_COMPILER_ARG1 "") -set(CMAKE_C_COMPILER_ID "GNU") -set(CMAKE_C_COMPILER_VERSION "14.2.1") -set(CMAKE_C_COMPILER_VERSION_INTERNAL "") -set(CMAKE_C_COMPILER_WRAPPER "") -set(CMAKE_C_STANDARD_COMPUTED_DEFAULT "17") -set(CMAKE_C_EXTENSIONS_COMPUTED_DEFAULT "ON") -set(CMAKE_C_STANDARD_LATEST "23") -set(CMAKE_C_COMPILE_FEATURES "c_std_90;c_function_prototypes;c_std_99;c_restrict;c_variadic_macros;c_std_11;c_static_assert;c_std_17;c_std_23") -set(CMAKE_C90_COMPILE_FEATURES "c_std_90;c_function_prototypes") -set(CMAKE_C99_COMPILE_FEATURES "c_std_99;c_restrict;c_variadic_macros") -set(CMAKE_C11_COMPILE_FEATURES "c_std_11;c_static_assert") -set(CMAKE_C17_COMPILE_FEATURES "c_std_17") -set(CMAKE_C23_COMPILE_FEATURES "c_std_23") - -set(CMAKE_C_PLATFORM_ID "Linux") -set(CMAKE_C_SIMULATE_ID "") -set(CMAKE_C_COMPILER_FRONTEND_VARIANT "GNU") -set(CMAKE_C_SIMULATE_VERSION "") - - - - -set(CMAKE_AR "/usr/bin/ar") -set(CMAKE_C_COMPILER_AR "/usr/bin/gcc-ar") -set(CMAKE_RANLIB "/usr/bin/ranlib") -set(CMAKE_C_COMPILER_RANLIB "/usr/bin/gcc-ranlib") -set(CMAKE_LINKER "/usr/bin/ld") -set(CMAKE_LINKER_LINK "") -set(CMAKE_LINKER_LLD "") -set(CMAKE_C_COMPILER_LINKER "/usr/bin/ld") -set(CMAKE_C_COMPILER_LINKER_ID "GNU") -set(CMAKE_C_COMPILER_LINKER_VERSION 2.43.0) -set(CMAKE_C_COMPILER_LINKER_FRONTEND_VARIANT GNU) -set(CMAKE_MT "") -set(CMAKE_TAPI "CMAKE_TAPI-NOTFOUND") -set(CMAKE_COMPILER_IS_GNUCC 1) -set(CMAKE_C_COMPILER_LOADED 1) -set(CMAKE_C_COMPILER_WORKS TRUE) -set(CMAKE_C_ABI_COMPILED TRUE) - -set(CMAKE_C_COMPILER_ENV_VAR "CC") - -set(CMAKE_C_COMPILER_ID_RUN 1) -set(CMAKE_C_SOURCE_FILE_EXTENSIONS c;m) -set(CMAKE_C_IGNORE_EXTENSIONS h;H;o;O;obj;OBJ;def;DEF;rc;RC) -set(CMAKE_C_LINKER_PREFERENCE 10) -set(CMAKE_C_LINKER_DEPFILE_SUPPORTED FALSE) - -# Save compiler ABI information. -set(CMAKE_C_SIZEOF_DATA_PTR "8") -set(CMAKE_C_COMPILER_ABI "ELF") -set(CMAKE_C_BYTE_ORDER "LITTLE_ENDIAN") -set(CMAKE_C_LIBRARY_ARCHITECTURE "") - -if(CMAKE_C_SIZEOF_DATA_PTR) - set(CMAKE_SIZEOF_VOID_P "${CMAKE_C_SIZEOF_DATA_PTR}") -endif() - -if(CMAKE_C_COMPILER_ABI) - set(CMAKE_INTERNAL_PLATFORM_ABI "${CMAKE_C_COMPILER_ABI}") -endif() - -if(CMAKE_C_LIBRARY_ARCHITECTURE) - set(CMAKE_LIBRARY_ARCHITECTURE "") -endif() - -set(CMAKE_C_CL_SHOWINCLUDES_PREFIX "") -if(CMAKE_C_CL_SHOWINCLUDES_PREFIX) - set(CMAKE_CL_SHOWINCLUDES_PREFIX "${CMAKE_C_CL_SHOWINCLUDES_PREFIX}") -endif() - - - - - -set(CMAKE_C_IMPLICIT_INCLUDE_DIRECTORIES "/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include;/usr/local/include;/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include-fixed;/usr/include") -set(CMAKE_C_IMPLICIT_LINK_LIBRARIES "gcc;gcc_s;c;gcc;gcc_s") -set(CMAKE_C_IMPLICIT_LINK_DIRECTORIES "/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1;/usr/lib;/lib") -set(CMAKE_C_IMPLICIT_LINK_FRAMEWORK_DIRECTORIES "") diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.2/CMakeDetermineCompilerABI_C.bin b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.2/CMakeDetermineCompilerABI_C.bin Binary files differ. diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.2/CMakeSystem.cmake b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.2/CMakeSystem.cmake @@ -1,15 +0,0 @@ -set(CMAKE_HOST_SYSTEM "Linux-6.10.6-arch1-1") -set(CMAKE_HOST_SYSTEM_NAME "Linux") -set(CMAKE_HOST_SYSTEM_VERSION "6.10.6-arch1-1") -set(CMAKE_HOST_SYSTEM_PROCESSOR "x86_64") - - - -set(CMAKE_SYSTEM "Linux-6.10.6-arch1-1") -set(CMAKE_SYSTEM_NAME "Linux") -set(CMAKE_SYSTEM_VERSION "6.10.6-arch1-1") -set(CMAKE_SYSTEM_PROCESSOR "x86_64") - -set(CMAKE_CROSSCOMPILING "FALSE") - -set(CMAKE_SYSTEM_LOADED 1) diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.2/CompilerIdC/CMakeCCompilerId.c b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.2/CompilerIdC/CMakeCCompilerId.c @@ -1,904 +0,0 @@ -#ifdef __cplusplus -# error "A C++ compiler has been selected for C." -#endif - -#if defined(__18CXX) -# define ID_VOID_MAIN -#endif -#if defined(__CLASSIC_C__) -/* cv-qualifiers did not exist in K&R C */ -# define const -# define volatile -#endif - -#if !defined(__has_include) -/* If the compiler does not have __has_include, pretend the answer is - always no. */ -# define __has_include(x) 0 -#endif - - -/* Version number components: V=Version, R=Revision, P=Patch - Version date components: YYYY=Year, MM=Month, DD=Day */ - -#if defined(__INTEL_COMPILER) || defined(__ICC) -# define COMPILER_ID "Intel" -# if defined(_MSC_VER) -# define SIMULATE_ID "MSVC" -# endif -# if defined(__GNUC__) -# define SIMULATE_ID "GNU" -# endif - /* __INTEL_COMPILER = VRP prior to 2021, and then VVVV for 2021 and later, - except that a few beta releases use the old format with V=2021. */ -# if __INTEL_COMPILER < 2021 || __INTEL_COMPILER == 202110 || __INTEL_COMPILER == 202111 -# define COMPILER_VERSION_MAJOR DEC(__INTEL_COMPILER/100) -# define COMPILER_VERSION_MINOR DEC(__INTEL_COMPILER/10 % 10) -# if defined(__INTEL_COMPILER_UPDATE) -# define COMPILER_VERSION_PATCH DEC(__INTEL_COMPILER_UPDATE) -# else -# define COMPILER_VERSION_PATCH DEC(__INTEL_COMPILER % 10) -# endif -# else -# define COMPILER_VERSION_MAJOR DEC(__INTEL_COMPILER) -# define COMPILER_VERSION_MINOR DEC(__INTEL_COMPILER_UPDATE) - /* The third version component from --version is an update index, - but no macro is provided for it. */ -# define COMPILER_VERSION_PATCH DEC(0) -# endif -# if defined(__INTEL_COMPILER_BUILD_DATE) - /* __INTEL_COMPILER_BUILD_DATE = YYYYMMDD */ -# define COMPILER_VERSION_TWEAK DEC(__INTEL_COMPILER_BUILD_DATE) -# endif -# if defined(_MSC_VER) - /* _MSC_VER = VVRR */ -# define SIMULATE_VERSION_MAJOR DEC(_MSC_VER / 100) -# define SIMULATE_VERSION_MINOR DEC(_MSC_VER % 100) -# endif -# if defined(__GNUC__) -# define SIMULATE_VERSION_MAJOR DEC(__GNUC__) -# elif defined(__GNUG__) -# define SIMULATE_VERSION_MAJOR DEC(__GNUG__) -# endif -# if defined(__GNUC_MINOR__) -# define SIMULATE_VERSION_MINOR DEC(__GNUC_MINOR__) -# endif -# if defined(__GNUC_PATCHLEVEL__) -# define SIMULATE_VERSION_PATCH DEC(__GNUC_PATCHLEVEL__) -# endif - -#elif (defined(__clang__) && defined(__INTEL_CLANG_COMPILER)) || defined(__INTEL_LLVM_COMPILER) -# define COMPILER_ID "IntelLLVM" -#if defined(_MSC_VER) -# define SIMULATE_ID "MSVC" -#endif -#if defined(__GNUC__) -# define SIMULATE_ID "GNU" -#endif -/* __INTEL_LLVM_COMPILER = VVVVRP prior to 2021.2.0, VVVVRRPP for 2021.2.0 and - * later. Look for 6 digit vs. 8 digit version number to decide encoding. - * VVVV is no smaller than the current year when a version is released. - */ -#if __INTEL_LLVM_COMPILER < 1000000L -# define COMPILER_VERSION_MAJOR DEC(__INTEL_LLVM_COMPILER/100) -# define COMPILER_VERSION_MINOR DEC(__INTEL_LLVM_COMPILER/10 % 10) -# define COMPILER_VERSION_PATCH DEC(__INTEL_LLVM_COMPILER % 10) -#else -# define COMPILER_VERSION_MAJOR DEC(__INTEL_LLVM_COMPILER/10000) -# define COMPILER_VERSION_MINOR DEC(__INTEL_LLVM_COMPILER/100 % 100) -# define COMPILER_VERSION_PATCH DEC(__INTEL_LLVM_COMPILER % 100) -#endif -#if defined(_MSC_VER) - /* _MSC_VER = VVRR */ -# define SIMULATE_VERSION_MAJOR DEC(_MSC_VER / 100) -# define SIMULATE_VERSION_MINOR DEC(_MSC_VER % 100) -#endif -#if defined(__GNUC__) -# define SIMULATE_VERSION_MAJOR DEC(__GNUC__) -#elif defined(__GNUG__) -# define SIMULATE_VERSION_MAJOR DEC(__GNUG__) -#endif -#if defined(__GNUC_MINOR__) -# define SIMULATE_VERSION_MINOR DEC(__GNUC_MINOR__) -#endif -#if defined(__GNUC_PATCHLEVEL__) -# define SIMULATE_VERSION_PATCH DEC(__GNUC_PATCHLEVEL__) -#endif - -#elif defined(__PATHCC__) -# define COMPILER_ID "PathScale" -# define COMPILER_VERSION_MAJOR DEC(__PATHCC__) -# define COMPILER_VERSION_MINOR DEC(__PATHCC_MINOR__) -# if defined(__PATHCC_PATCHLEVEL__) -# define COMPILER_VERSION_PATCH DEC(__PATHCC_PATCHLEVEL__) -# endif - -#elif defined(__BORLANDC__) && defined(__CODEGEARC_VERSION__) -# define COMPILER_ID "Embarcadero" -# define COMPILER_VERSION_MAJOR HEX(__CODEGEARC_VERSION__>>24 & 0x00FF) -# define COMPILER_VERSION_MINOR HEX(__CODEGEARC_VERSION__>>16 & 0x00FF) -# define COMPILER_VERSION_PATCH DEC(__CODEGEARC_VERSION__ & 0xFFFF) - -#elif defined(__BORLANDC__) -# define COMPILER_ID "Borland" - /* __BORLANDC__ = 0xVRR */ -# define COMPILER_VERSION_MAJOR HEX(__BORLANDC__>>8) -# define COMPILER_VERSION_MINOR HEX(__BORLANDC__ & 0xFF) - -#elif defined(__WATCOMC__) && __WATCOMC__ < 1200 -# define COMPILER_ID "Watcom" - /* __WATCOMC__ = VVRR */ -# define COMPILER_VERSION_MAJOR DEC(__WATCOMC__ / 100) -# define COMPILER_VERSION_MINOR DEC((__WATCOMC__ / 10) % 10) -# if (__WATCOMC__ % 10) > 0 -# define COMPILER_VERSION_PATCH DEC(__WATCOMC__ % 10) -# endif - -#elif defined(__WATCOMC__) -# define COMPILER_ID "OpenWatcom" - /* __WATCOMC__ = VVRP + 1100 */ -# define COMPILER_VERSION_MAJOR DEC((__WATCOMC__ - 1100) / 100) -# define COMPILER_VERSION_MINOR DEC((__WATCOMC__ / 10) % 10) -# if (__WATCOMC__ % 10) > 0 -# define COMPILER_VERSION_PATCH DEC(__WATCOMC__ % 10) -# endif - -#elif defined(__SUNPRO_C) -# define COMPILER_ID "SunPro" -# if __SUNPRO_C >= 0x5100 - /* __SUNPRO_C = 0xVRRP */ -# define COMPILER_VERSION_MAJOR HEX(__SUNPRO_C>>12) -# define COMPILER_VERSION_MINOR HEX(__SUNPRO_C>>4 & 0xFF) -# define COMPILER_VERSION_PATCH HEX(__SUNPRO_C & 0xF) -# else - /* __SUNPRO_CC = 0xVRP */ -# define COMPILER_VERSION_MAJOR HEX(__SUNPRO_C>>8) -# define COMPILER_VERSION_MINOR HEX(__SUNPRO_C>>4 & 0xF) -# define COMPILER_VERSION_PATCH HEX(__SUNPRO_C & 0xF) -# endif - -#elif defined(__HP_cc) -# define COMPILER_ID "HP" - /* __HP_cc = VVRRPP */ -# define COMPILER_VERSION_MAJOR DEC(__HP_cc/10000) -# define COMPILER_VERSION_MINOR DEC(__HP_cc/100 % 100) -# define COMPILER_VERSION_PATCH DEC(__HP_cc % 100) - -#elif defined(__DECC) -# define COMPILER_ID "Compaq" - /* __DECC_VER = VVRRTPPPP */ -# define COMPILER_VERSION_MAJOR DEC(__DECC_VER/10000000) -# define COMPILER_VERSION_MINOR DEC(__DECC_VER/100000 % 100) -# define COMPILER_VERSION_PATCH DEC(__DECC_VER % 10000) - -#elif defined(__IBMC__) && defined(__COMPILER_VER__) -# define COMPILER_ID "zOS" - /* __IBMC__ = VRP */ -# define COMPILER_VERSION_MAJOR DEC(__IBMC__/100) -# define COMPILER_VERSION_MINOR DEC(__IBMC__/10 % 10) -# define COMPILER_VERSION_PATCH DEC(__IBMC__ % 10) - -#elif defined(__open_xl__) && defined(__clang__) -# define COMPILER_ID "IBMClang" -# define COMPILER_VERSION_MAJOR DEC(__open_xl_version__) -# define COMPILER_VERSION_MINOR DEC(__open_xl_release__) -# define COMPILER_VERSION_PATCH DEC(__open_xl_modification__) -# define COMPILER_VERSION_TWEAK DEC(__open_xl_ptf_fix_level__) - - -#elif defined(__ibmxl__) && defined(__clang__) -# define COMPILER_ID "XLClang" -# define COMPILER_VERSION_MAJOR DEC(__ibmxl_version__) -# define COMPILER_VERSION_MINOR DEC(__ibmxl_release__) -# define COMPILER_VERSION_PATCH DEC(__ibmxl_modification__) -# define COMPILER_VERSION_TWEAK DEC(__ibmxl_ptf_fix_level__) - - -#elif defined(__IBMC__) && !defined(__COMPILER_VER__) && __IBMC__ >= 800 -# define COMPILER_ID "XL" - /* __IBMC__ = VRP */ -# define COMPILER_VERSION_MAJOR DEC(__IBMC__/100) -# define COMPILER_VERSION_MINOR DEC(__IBMC__/10 % 10) -# define COMPILER_VERSION_PATCH DEC(__IBMC__ % 10) - -#elif defined(__IBMC__) && !defined(__COMPILER_VER__) && __IBMC__ < 800 -# define COMPILER_ID "VisualAge" - /* __IBMC__ = VRP */ -# define COMPILER_VERSION_MAJOR DEC(__IBMC__/100) -# define COMPILER_VERSION_MINOR DEC(__IBMC__/10 % 10) -# define COMPILER_VERSION_PATCH DEC(__IBMC__ % 10) - -#elif defined(__NVCOMPILER) -# define COMPILER_ID "NVHPC" -# define COMPILER_VERSION_MAJOR DEC(__NVCOMPILER_MAJOR__) -# define COMPILER_VERSION_MINOR DEC(__NVCOMPILER_MINOR__) -# if defined(__NVCOMPILER_PATCHLEVEL__) -# define COMPILER_VERSION_PATCH DEC(__NVCOMPILER_PATCHLEVEL__) -# endif - -#elif defined(__PGI) -# define COMPILER_ID "PGI" -# define COMPILER_VERSION_MAJOR DEC(__PGIC__) -# define COMPILER_VERSION_MINOR DEC(__PGIC_MINOR__) -# if defined(__PGIC_PATCHLEVEL__) -# define COMPILER_VERSION_PATCH DEC(__PGIC_PATCHLEVEL__) -# endif - -#elif defined(__clang__) && defined(__cray__) -# define COMPILER_ID "CrayClang" -# define COMPILER_VERSION_MAJOR DEC(__cray_major__) -# define COMPILER_VERSION_MINOR DEC(__cray_minor__) -# define COMPILER_VERSION_PATCH DEC(__cray_patchlevel__) -# define COMPILER_VERSION_INTERNAL_STR __clang_version__ - - -#elif defined(_CRAYC) -# define COMPILER_ID "Cray" -# define COMPILER_VERSION_MAJOR DEC(_RELEASE_MAJOR) -# define COMPILER_VERSION_MINOR DEC(_RELEASE_MINOR) - -#elif defined(__TI_COMPILER_VERSION__) -# define COMPILER_ID "TI" - /* __TI_COMPILER_VERSION__ = VVVRRRPPP */ -# define COMPILER_VERSION_MAJOR DEC(__TI_COMPILER_VERSION__/1000000) -# define COMPILER_VERSION_MINOR DEC(__TI_COMPILER_VERSION__/1000 % 1000) -# define COMPILER_VERSION_PATCH DEC(__TI_COMPILER_VERSION__ % 1000) - -#elif defined(__CLANG_FUJITSU) -# define COMPILER_ID "FujitsuClang" -# define COMPILER_VERSION_MAJOR DEC(__FCC_major__) -# define COMPILER_VERSION_MINOR DEC(__FCC_minor__) -# define COMPILER_VERSION_PATCH DEC(__FCC_patchlevel__) -# define COMPILER_VERSION_INTERNAL_STR __clang_version__ - - -#elif defined(__FUJITSU) -# define COMPILER_ID "Fujitsu" -# if defined(__FCC_version__) -# define COMPILER_VERSION __FCC_version__ -# elif defined(__FCC_major__) -# define COMPILER_VERSION_MAJOR DEC(__FCC_major__) -# define COMPILER_VERSION_MINOR DEC(__FCC_minor__) -# define COMPILER_VERSION_PATCH DEC(__FCC_patchlevel__) -# endif -# if defined(__fcc_version) -# define COMPILER_VERSION_INTERNAL DEC(__fcc_version) -# elif defined(__FCC_VERSION) -# define COMPILER_VERSION_INTERNAL DEC(__FCC_VERSION) -# endif - - -#elif defined(__ghs__) -# define COMPILER_ID "GHS" -/* __GHS_VERSION_NUMBER = VVVVRP */ -# ifdef __GHS_VERSION_NUMBER -# define COMPILER_VERSION_MAJOR DEC(__GHS_VERSION_NUMBER / 100) -# define COMPILER_VERSION_MINOR DEC(__GHS_VERSION_NUMBER / 10 % 10) -# define COMPILER_VERSION_PATCH DEC(__GHS_VERSION_NUMBER % 10) -# endif - -#elif defined(__TASKING__) -# define COMPILER_ID "Tasking" - # define COMPILER_VERSION_MAJOR DEC(__VERSION__/1000) - # define COMPILER_VERSION_MINOR DEC(__VERSION__ % 100) -# define COMPILER_VERSION_INTERNAL DEC(__VERSION__) - -#elif defined(__ORANGEC__) -# define COMPILER_ID "OrangeC" -# define COMPILER_VERSION_MAJOR DEC(__ORANGEC_MAJOR__) -# define COMPILER_VERSION_MINOR DEC(__ORANGEC_MINOR__) -# define COMPILER_VERSION_PATCH DEC(__ORANGEC_PATCHLEVEL__) - -#elif defined(__TINYC__) -# define COMPILER_ID "TinyCC" - -#elif defined(__BCC__) -# define COMPILER_ID "Bruce" - -#elif defined(__SCO_VERSION__) -# define COMPILER_ID "SCO" - -#elif defined(__ARMCC_VERSION) && !defined(__clang__) -# define COMPILER_ID "ARMCC" -#if __ARMCC_VERSION >= 1000000 - /* __ARMCC_VERSION = VRRPPPP */ - # define COMPILER_VERSION_MAJOR DEC(__ARMCC_VERSION/1000000) - # define COMPILER_VERSION_MINOR DEC(__ARMCC_VERSION/10000 % 100) - # define COMPILER_VERSION_PATCH DEC(__ARMCC_VERSION % 10000) -#else - /* __ARMCC_VERSION = VRPPPP */ - # define COMPILER_VERSION_MAJOR DEC(__ARMCC_VERSION/100000) - # define COMPILER_VERSION_MINOR DEC(__ARMCC_VERSION/10000 % 10) - # define COMPILER_VERSION_PATCH DEC(__ARMCC_VERSION % 10000) -#endif - - -#elif defined(__clang__) && defined(__apple_build_version__) -# define COMPILER_ID "AppleClang" -# if defined(_MSC_VER) -# define SIMULATE_ID "MSVC" -# endif -# define COMPILER_VERSION_MAJOR DEC(__clang_major__) -# define COMPILER_VERSION_MINOR DEC(__clang_minor__) -# define COMPILER_VERSION_PATCH DEC(__clang_patchlevel__) -# if defined(_MSC_VER) - /* _MSC_VER = VVRR */ -# define SIMULATE_VERSION_MAJOR DEC(_MSC_VER / 100) -# define SIMULATE_VERSION_MINOR DEC(_MSC_VER % 100) -# endif -# define COMPILER_VERSION_TWEAK DEC(__apple_build_version__) - -#elif defined(__clang__) && defined(__ARMCOMPILER_VERSION) -# define COMPILER_ID "ARMClang" - # define COMPILER_VERSION_MAJOR DEC(__ARMCOMPILER_VERSION/1000000) - # define COMPILER_VERSION_MINOR DEC(__ARMCOMPILER_VERSION/10000 % 100) - # define COMPILER_VERSION_PATCH DEC(__ARMCOMPILER_VERSION/100 % 100) -# define COMPILER_VERSION_INTERNAL DEC(__ARMCOMPILER_VERSION) - -#elif defined(__clang__) && defined(__ti__) -# define COMPILER_ID "TIClang" - # define COMPILER_VERSION_MAJOR DEC(__ti_major__) - # define COMPILER_VERSION_MINOR DEC(__ti_minor__) - # define COMPILER_VERSION_PATCH DEC(__ti_patchlevel__) -# define COMPILER_VERSION_INTERNAL DEC(__ti_version__) - -#elif defined(__clang__) -# define COMPILER_ID "Clang" -# if defined(_MSC_VER) -# define SIMULATE_ID "MSVC" -# endif -# define COMPILER_VERSION_MAJOR DEC(__clang_major__) -# define COMPILER_VERSION_MINOR DEC(__clang_minor__) -# define COMPILER_VERSION_PATCH DEC(__clang_patchlevel__) -# if defined(_MSC_VER) - /* _MSC_VER = VVRR */ -# define SIMULATE_VERSION_MAJOR DEC(_MSC_VER / 100) -# define SIMULATE_VERSION_MINOR DEC(_MSC_VER % 100) -# endif - -#elif defined(__LCC__) && (defined(__GNUC__) || defined(__GNUG__) || defined(__MCST__)) -# define COMPILER_ID "LCC" -# define COMPILER_VERSION_MAJOR DEC(__LCC__ / 100) -# define COMPILER_VERSION_MINOR DEC(__LCC__ % 100) -# if defined(__LCC_MINOR__) -# define COMPILER_VERSION_PATCH DEC(__LCC_MINOR__) -# endif -# if defined(__GNUC__) && defined(__GNUC_MINOR__) -# define SIMULATE_ID "GNU" -# define SIMULATE_VERSION_MAJOR DEC(__GNUC__) -# define SIMULATE_VERSION_MINOR DEC(__GNUC_MINOR__) -# if defined(__GNUC_PATCHLEVEL__) -# define SIMULATE_VERSION_PATCH DEC(__GNUC_PATCHLEVEL__) -# endif -# endif - -#elif defined(__GNUC__) -# define COMPILER_ID "GNU" -# define COMPILER_VERSION_MAJOR DEC(__GNUC__) -# if defined(__GNUC_MINOR__) -# define COMPILER_VERSION_MINOR DEC(__GNUC_MINOR__) -# endif -# if defined(__GNUC_PATCHLEVEL__) -# define COMPILER_VERSION_PATCH DEC(__GNUC_PATCHLEVEL__) -# endif - -#elif defined(_MSC_VER) -# define COMPILER_ID "MSVC" - /* _MSC_VER = VVRR */ -# define COMPILER_VERSION_MAJOR DEC(_MSC_VER / 100) -# define COMPILER_VERSION_MINOR DEC(_MSC_VER % 100) -# if defined(_MSC_FULL_VER) -# if _MSC_VER >= 1400 - /* _MSC_FULL_VER = VVRRPPPPP */ -# define COMPILER_VERSION_PATCH DEC(_MSC_FULL_VER % 100000) -# else - /* _MSC_FULL_VER = VVRRPPPP */ -# define COMPILER_VERSION_PATCH DEC(_MSC_FULL_VER % 10000) -# endif -# endif -# if defined(_MSC_BUILD) -# define COMPILER_VERSION_TWEAK DEC(_MSC_BUILD) -# endif - -#elif defined(_ADI_COMPILER) -# define COMPILER_ID "ADSP" -#if defined(__VERSIONNUM__) - /* __VERSIONNUM__ = 0xVVRRPPTT */ -# define COMPILER_VERSION_MAJOR DEC(__VERSIONNUM__ >> 24 & 0xFF) -# define COMPILER_VERSION_MINOR DEC(__VERSIONNUM__ >> 16 & 0xFF) -# define COMPILER_VERSION_PATCH DEC(__VERSIONNUM__ >> 8 & 0xFF) -# define COMPILER_VERSION_TWEAK DEC(__VERSIONNUM__ & 0xFF) -#endif - -#elif defined(__IAR_SYSTEMS_ICC__) || defined(__IAR_SYSTEMS_ICC) -# define COMPILER_ID "IAR" -# if defined(__VER__) && defined(__ICCARM__) -# define COMPILER_VERSION_MAJOR DEC((__VER__) / 1000000) -# define COMPILER_VERSION_MINOR DEC(((__VER__) / 1000) % 1000) -# define COMPILER_VERSION_PATCH DEC((__VER__) % 1000) -# define COMPILER_VERSION_INTERNAL DEC(__IAR_SYSTEMS_ICC__) -# elif defined(__VER__) && (defined(__ICCAVR__) || defined(__ICCRX__) || defined(__ICCRH850__) || defined(__ICCRL78__) || defined(__ICC430__) || defined(__ICCRISCV__) || defined(__ICCV850__) || defined(__ICC8051__) || defined(__ICCSTM8__)) -# define COMPILER_VERSION_MAJOR DEC((__VER__) / 100) -# define COMPILER_VERSION_MINOR DEC((__VER__) - (((__VER__) / 100)*100)) -# define COMPILER_VERSION_PATCH DEC(__SUBVERSION__) -# define COMPILER_VERSION_INTERNAL DEC(__IAR_SYSTEMS_ICC__) -# endif - -#elif defined(__SDCC_VERSION_MAJOR) || defined(SDCC) -# define COMPILER_ID "SDCC" -# if defined(__SDCC_VERSION_MAJOR) -# define COMPILER_VERSION_MAJOR DEC(__SDCC_VERSION_MAJOR) -# define COMPILER_VERSION_MINOR DEC(__SDCC_VERSION_MINOR) -# define COMPILER_VERSION_PATCH DEC(__SDCC_VERSION_PATCH) -# else - /* SDCC = VRP */ -# define COMPILER_VERSION_MAJOR DEC(SDCC/100) -# define COMPILER_VERSION_MINOR DEC(SDCC/10 % 10) -# define COMPILER_VERSION_PATCH DEC(SDCC % 10) -# endif - - -/* These compilers are either not known or too old to define an - identification macro. Try to identify the platform and guess that - it is the native compiler. */ -#elif defined(__hpux) || defined(__hpua) -# define COMPILER_ID "HP" - -#else /* unknown compiler */ -# define COMPILER_ID "" -#endif - -/* Construct the string literal in pieces to prevent the source from - getting matched. Store it in a pointer rather than an array - because some compilers will just produce instructions to fill the - array rather than assigning a pointer to a static array. */ -char const* info_compiler = "INFO" ":" "compiler[" COMPILER_ID "]"; -#ifdef SIMULATE_ID -char const* info_simulate = "INFO" ":" "simulate[" SIMULATE_ID "]"; -#endif - -#ifdef __QNXNTO__ -char const* qnxnto = "INFO" ":" "qnxnto[]"; -#endif - -#if defined(__CRAYXT_COMPUTE_LINUX_TARGET) -char const *info_cray = "INFO" ":" "compiler_wrapper[CrayPrgEnv]"; -#endif - -#define STRINGIFY_HELPER(X) #X -#define STRINGIFY(X) STRINGIFY_HELPER(X) - -/* Identify known platforms by name. */ -#if defined(__linux) || defined(__linux__) || defined(linux) -# define PLATFORM_ID "Linux" - -#elif defined(__MSYS__) -# define PLATFORM_ID "MSYS" - -#elif defined(__CYGWIN__) -# define PLATFORM_ID "Cygwin" - -#elif defined(__MINGW32__) -# define PLATFORM_ID "MinGW" - -#elif defined(__APPLE__) -# define PLATFORM_ID "Darwin" - -#elif defined(_WIN32) || defined(__WIN32__) || defined(WIN32) -# define PLATFORM_ID "Windows" - -#elif defined(__FreeBSD__) || defined(__FreeBSD) -# define PLATFORM_ID "FreeBSD" - -#elif defined(__NetBSD__) || defined(__NetBSD) -# define PLATFORM_ID "NetBSD" - -#elif defined(__OpenBSD__) || defined(__OPENBSD) -# define PLATFORM_ID "OpenBSD" - -#elif defined(__sun) || defined(sun) -# define PLATFORM_ID "SunOS" - -#elif defined(_AIX) || defined(__AIX) || defined(__AIX__) || defined(__aix) || defined(__aix__) -# define PLATFORM_ID "AIX" - -#elif defined(__hpux) || defined(__hpux__) -# define PLATFORM_ID "HP-UX" - -#elif defined(__HAIKU__) -# define PLATFORM_ID "Haiku" - -#elif defined(__BeOS) || defined(__BEOS__) || defined(_BEOS) -# define PLATFORM_ID "BeOS" - -#elif defined(__QNX__) || defined(__QNXNTO__) -# define PLATFORM_ID "QNX" - -#elif defined(__tru64) || defined(_tru64) || defined(__TRU64__) -# define PLATFORM_ID "Tru64" - -#elif defined(__riscos) || defined(__riscos__) -# define PLATFORM_ID "RISCos" - -#elif defined(__sinix) || defined(__sinix__) || defined(__SINIX__) -# define PLATFORM_ID "SINIX" - -#elif defined(__UNIX_SV__) -# define PLATFORM_ID "UNIX_SV" - -#elif defined(__bsdos__) -# define PLATFORM_ID "BSDOS" - -#elif defined(_MPRAS) || defined(MPRAS) -# define PLATFORM_ID "MP-RAS" - -#elif defined(__osf) || defined(__osf__) -# define PLATFORM_ID "OSF1" - -#elif defined(_SCO_SV) || defined(SCO_SV) || defined(sco_sv) -# define PLATFORM_ID "SCO_SV" - -#elif defined(__ultrix) || defined(__ultrix__) || defined(_ULTRIX) -# define PLATFORM_ID "ULTRIX" - -#elif defined(__XENIX__) || defined(_XENIX) || defined(XENIX) -# define PLATFORM_ID "Xenix" - -#elif defined(__WATCOMC__) -# if defined(__LINUX__) -# define PLATFORM_ID "Linux" - -# elif defined(__DOS__) -# define PLATFORM_ID "DOS" - -# elif defined(__OS2__) -# define PLATFORM_ID "OS2" - -# elif defined(__WINDOWS__) -# define PLATFORM_ID "Windows3x" - -# elif defined(__VXWORKS__) -# define PLATFORM_ID "VxWorks" - -# else /* unknown platform */ -# define PLATFORM_ID -# endif - -#elif defined(__INTEGRITY) -# if defined(INT_178B) -# define PLATFORM_ID "Integrity178" - -# else /* regular Integrity */ -# define PLATFORM_ID "Integrity" -# endif - -# elif defined(_ADI_COMPILER) -# define PLATFORM_ID "ADSP" - -#else /* unknown platform */ -# define PLATFORM_ID - -#endif - -/* For windows compilers MSVC and Intel we can determine - the architecture of the compiler being used. This is because - the compilers do not have flags that can change the architecture, - but rather depend on which compiler is being used -*/ -#if defined(_WIN32) && defined(_MSC_VER) -# if defined(_M_IA64) -# define ARCHITECTURE_ID "IA64" - -# elif defined(_M_ARM64EC) -# define ARCHITECTURE_ID "ARM64EC" - -# elif defined(_M_X64) || defined(_M_AMD64) -# define ARCHITECTURE_ID "x64" - -# elif defined(_M_IX86) -# define ARCHITECTURE_ID "X86" - -# elif defined(_M_ARM64) -# define ARCHITECTURE_ID "ARM64" - -# elif defined(_M_ARM) -# if _M_ARM == 4 -# define ARCHITECTURE_ID "ARMV4I" -# elif _M_ARM == 5 -# define ARCHITECTURE_ID "ARMV5I" -# else -# define ARCHITECTURE_ID "ARMV" STRINGIFY(_M_ARM) -# endif - -# elif defined(_M_MIPS) -# define ARCHITECTURE_ID "MIPS" - -# elif defined(_M_SH) -# define ARCHITECTURE_ID "SHx" - -# else /* unknown architecture */ -# define ARCHITECTURE_ID "" -# endif - -#elif defined(__WATCOMC__) -# if defined(_M_I86) -# define ARCHITECTURE_ID "I86" - -# elif defined(_M_IX86) -# define ARCHITECTURE_ID "X86" - -# else /* unknown architecture */ -# define ARCHITECTURE_ID "" -# endif - -#elif defined(__IAR_SYSTEMS_ICC__) || defined(__IAR_SYSTEMS_ICC) -# if defined(__ICCARM__) -# define ARCHITECTURE_ID "ARM" - -# elif defined(__ICCRX__) -# define ARCHITECTURE_ID "RX" - -# elif defined(__ICCRH850__) -# define ARCHITECTURE_ID "RH850" - -# elif defined(__ICCRL78__) -# define ARCHITECTURE_ID "RL78" - -# elif defined(__ICCRISCV__) -# define ARCHITECTURE_ID "RISCV" - -# elif defined(__ICCAVR__) -# define ARCHITECTURE_ID "AVR" - -# elif defined(__ICC430__) -# define ARCHITECTURE_ID "MSP430" - -# elif defined(__ICCV850__) -# define ARCHITECTURE_ID "V850" - -# elif defined(__ICC8051__) -# define ARCHITECTURE_ID "8051" - -# elif defined(__ICCSTM8__) -# define ARCHITECTURE_ID "STM8" - -# else /* unknown architecture */ -# define ARCHITECTURE_ID "" -# endif - -#elif defined(__ghs__) -# if defined(__PPC64__) -# define ARCHITECTURE_ID "PPC64" - -# elif defined(__ppc__) -# define ARCHITECTURE_ID "PPC" - -# elif defined(__ARM__) -# define ARCHITECTURE_ID "ARM" - -# elif defined(__x86_64__) -# define ARCHITECTURE_ID "x64" - -# elif defined(__i386__) -# define ARCHITECTURE_ID "X86" - -# else /* unknown architecture */ -# define ARCHITECTURE_ID "" -# endif - -#elif defined(__clang__) && defined(__ti__) -# if defined(__ARM_ARCH) -# define ARCHITECTURE_ID "Arm" - -# else /* unknown architecture */ -# define ARCHITECTURE_ID "" -# endif - -#elif defined(__TI_COMPILER_VERSION__) -# if defined(__TI_ARM__) -# define ARCHITECTURE_ID "ARM" - -# elif defined(__MSP430__) -# define ARCHITECTURE_ID "MSP430" - -# elif defined(__TMS320C28XX__) -# define ARCHITECTURE_ID "TMS320C28x" - -# elif defined(__TMS320C6X__) || defined(_TMS320C6X) -# define ARCHITECTURE_ID "TMS320C6x" - -# else /* unknown architecture */ -# define ARCHITECTURE_ID "" -# endif - -# elif defined(__ADSPSHARC__) -# define ARCHITECTURE_ID "SHARC" - -# elif defined(__ADSPBLACKFIN__) -# define ARCHITECTURE_ID "Blackfin" - -#elif defined(__TASKING__) - -# if defined(__CTC__) || defined(__CPTC__) -# define ARCHITECTURE_ID "TriCore" - -# elif defined(__CMCS__) -# define ARCHITECTURE_ID "MCS" - -# elif defined(__CARM__) -# define ARCHITECTURE_ID "ARM" - -# elif defined(__CARC__) -# define ARCHITECTURE_ID "ARC" - -# elif defined(__C51__) -# define ARCHITECTURE_ID "8051" - -# elif defined(__CPCP__) -# define ARCHITECTURE_ID "PCP" - -# else -# define ARCHITECTURE_ID "" -# endif - -#else -# define ARCHITECTURE_ID -#endif - -/* Convert integer to decimal digit literals. */ -#define DEC(n) \ - ('0' + (((n) / 10000000)%10)), \ - ('0' + (((n) / 1000000)%10)), \ - ('0' + (((n) / 100000)%10)), \ - ('0' + (((n) / 10000)%10)), \ - ('0' + (((n) / 1000)%10)), \ - ('0' + (((n) / 100)%10)), \ - ('0' + (((n) / 10)%10)), \ - ('0' + ((n) % 10)) - -/* Convert integer to hex digit literals. */ -#define HEX(n) \ - ('0' + ((n)>>28 & 0xF)), \ - ('0' + ((n)>>24 & 0xF)), \ - ('0' + ((n)>>20 & 0xF)), \ - ('0' + ((n)>>16 & 0xF)), \ - ('0' + ((n)>>12 & 0xF)), \ - ('0' + ((n)>>8 & 0xF)), \ - ('0' + ((n)>>4 & 0xF)), \ - ('0' + ((n) & 0xF)) - -/* Construct a string literal encoding the version number. */ -#ifdef COMPILER_VERSION -char const* info_version = "INFO" ":" "compiler_version[" COMPILER_VERSION "]"; - -/* Construct a string literal encoding the version number components. */ -#elif defined(COMPILER_VERSION_MAJOR) -char const info_version[] = { - 'I', 'N', 'F', 'O', ':', - 'c','o','m','p','i','l','e','r','_','v','e','r','s','i','o','n','[', - COMPILER_VERSION_MAJOR, -# ifdef COMPILER_VERSION_MINOR - '.', COMPILER_VERSION_MINOR, -# ifdef COMPILER_VERSION_PATCH - '.', COMPILER_VERSION_PATCH, -# ifdef COMPILER_VERSION_TWEAK - '.', COMPILER_VERSION_TWEAK, -# endif -# endif -# endif - ']','\0'}; -#endif - -/* Construct a string literal encoding the internal version number. */ -#ifdef COMPILER_VERSION_INTERNAL -char const info_version_internal[] = { - 'I', 'N', 'F', 'O', ':', - 'c','o','m','p','i','l','e','r','_','v','e','r','s','i','o','n','_', - 'i','n','t','e','r','n','a','l','[', - COMPILER_VERSION_INTERNAL,']','\0'}; -#elif defined(COMPILER_VERSION_INTERNAL_STR) -char const* info_version_internal = "INFO" ":" "compiler_version_internal[" COMPILER_VERSION_INTERNAL_STR "]"; -#endif - -/* Construct a string literal encoding the version number components. */ -#ifdef SIMULATE_VERSION_MAJOR -char const info_simulate_version[] = { - 'I', 'N', 'F', 'O', ':', - 's','i','m','u','l','a','t','e','_','v','e','r','s','i','o','n','[', - SIMULATE_VERSION_MAJOR, -# ifdef SIMULATE_VERSION_MINOR - '.', SIMULATE_VERSION_MINOR, -# ifdef SIMULATE_VERSION_PATCH - '.', SIMULATE_VERSION_PATCH, -# ifdef SIMULATE_VERSION_TWEAK - '.', SIMULATE_VERSION_TWEAK, -# endif -# endif -# endif - ']','\0'}; -#endif - -/* Construct the string literal in pieces to prevent the source from - getting matched. Store it in a pointer rather than an array - because some compilers will just produce instructions to fill the - array rather than assigning a pointer to a static array. */ -char const* info_platform = "INFO" ":" "platform[" PLATFORM_ID "]"; -char const* info_arch = "INFO" ":" "arch[" ARCHITECTURE_ID "]"; - - - -#define C_STD_99 199901L -#define C_STD_11 201112L -#define C_STD_17 201710L -#define C_STD_23 202311L - -#ifdef __STDC_VERSION__ -# define C_STD __STDC_VERSION__ -#endif - -#if !defined(__STDC__) && !defined(__clang__) -# if defined(_MSC_VER) || defined(__ibmxl__) || defined(__IBMC__) -# define C_VERSION "90" -# else -# define C_VERSION -# endif -#elif C_STD > C_STD_17 -# define C_VERSION "23" -#elif C_STD > C_STD_11 -# define C_VERSION "17" -#elif C_STD > C_STD_99 -# define C_VERSION "11" -#elif C_STD >= C_STD_99 -# define C_VERSION "99" -#else -# define C_VERSION "90" -#endif -const char* info_language_standard_default = - "INFO" ":" "standard_default[" C_VERSION "]"; - -const char* info_language_extensions_default = "INFO" ":" "extensions_default[" -#if (defined(__clang__) || defined(__GNUC__) || defined(__xlC__) || \ - defined(__TI_COMPILER_VERSION__)) && \ - !defined(__STRICT_ANSI__) - "ON" -#else - "OFF" -#endif -"]"; - -/*--------------------------------------------------------------------------*/ - -#ifdef ID_VOID_MAIN -void main() {} -#else -# if defined(__CLASSIC_C__) -int main(argc, argv) int argc; char *argv[]; -# else -int main(int argc, char* argv[]) -# endif -{ - int require = 0; - require += info_compiler[argc]; - require += info_platform[argc]; - require += info_arch[argc]; -#ifdef COMPILER_VERSION_MAJOR - require += info_version[argc]; -#endif -#ifdef COMPILER_VERSION_INTERNAL - require += info_version_internal[argc]; -#endif -#ifdef SIMULATE_ID - require += info_simulate[argc]; -#endif -#ifdef SIMULATE_VERSION_MAJOR - require += info_simulate_version[argc]; -#endif -#if defined(__CRAYXT_COMPUTE_LINUX_TARGET) - require += info_cray[argc]; -#endif - require += info_language_standard_default[argc]; - require += info_language_extensions_default[argc]; - (void)argv; - return require; -} -#endif diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.2/CompilerIdC/a.out b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.2/CompilerIdC/a.out Binary files differ. diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.3/CMakeCCompiler.cmake b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.3/CMakeCCompiler.cmake @@ -1,81 +0,0 @@ -set(CMAKE_C_COMPILER "/usr/bin/cc") -set(CMAKE_C_COMPILER_ARG1 "") -set(CMAKE_C_COMPILER_ID "GNU") -set(CMAKE_C_COMPILER_VERSION "14.2.1") -set(CMAKE_C_COMPILER_VERSION_INTERNAL "") -set(CMAKE_C_COMPILER_WRAPPER "") -set(CMAKE_C_STANDARD_COMPUTED_DEFAULT "17") -set(CMAKE_C_EXTENSIONS_COMPUTED_DEFAULT "ON") -set(CMAKE_C_STANDARD_LATEST "23") -set(CMAKE_C_COMPILE_FEATURES "c_std_90;c_function_prototypes;c_std_99;c_restrict;c_variadic_macros;c_std_11;c_static_assert;c_std_17;c_std_23") -set(CMAKE_C90_COMPILE_FEATURES "c_std_90;c_function_prototypes") -set(CMAKE_C99_COMPILE_FEATURES "c_std_99;c_restrict;c_variadic_macros") -set(CMAKE_C11_COMPILE_FEATURES "c_std_11;c_static_assert") -set(CMAKE_C17_COMPILE_FEATURES "c_std_17") -set(CMAKE_C23_COMPILE_FEATURES "c_std_23") - -set(CMAKE_C_PLATFORM_ID "Linux") -set(CMAKE_C_SIMULATE_ID "") -set(CMAKE_C_COMPILER_FRONTEND_VARIANT "GNU") -set(CMAKE_C_SIMULATE_VERSION "") - - - - -set(CMAKE_AR "/usr/bin/ar") -set(CMAKE_C_COMPILER_AR "/usr/bin/gcc-ar") -set(CMAKE_RANLIB "/usr/bin/ranlib") -set(CMAKE_C_COMPILER_RANLIB "/usr/bin/gcc-ranlib") -set(CMAKE_LINKER "/usr/bin/ld") -set(CMAKE_LINKER_LINK "") -set(CMAKE_LINKER_LLD "") -set(CMAKE_C_COMPILER_LINKER "/usr/bin/ld") -set(CMAKE_C_COMPILER_LINKER_ID "GNU") -set(CMAKE_C_COMPILER_LINKER_VERSION 2.43.0) -set(CMAKE_C_COMPILER_LINKER_FRONTEND_VARIANT GNU) -set(CMAKE_MT "") -set(CMAKE_TAPI "CMAKE_TAPI-NOTFOUND") -set(CMAKE_COMPILER_IS_GNUCC 1) -set(CMAKE_C_COMPILER_LOADED 1) -set(CMAKE_C_COMPILER_WORKS TRUE) -set(CMAKE_C_ABI_COMPILED TRUE) - -set(CMAKE_C_COMPILER_ENV_VAR "CC") - -set(CMAKE_C_COMPILER_ID_RUN 1) -set(CMAKE_C_SOURCE_FILE_EXTENSIONS c;m) -set(CMAKE_C_IGNORE_EXTENSIONS h;H;o;O;obj;OBJ;def;DEF;rc;RC) -set(CMAKE_C_LINKER_PREFERENCE 10) -set(CMAKE_C_LINKER_DEPFILE_SUPPORTED FALSE) - -# Save compiler ABI information. -set(CMAKE_C_SIZEOF_DATA_PTR "8") -set(CMAKE_C_COMPILER_ABI "ELF") -set(CMAKE_C_BYTE_ORDER "LITTLE_ENDIAN") -set(CMAKE_C_LIBRARY_ARCHITECTURE "") - -if(CMAKE_C_SIZEOF_DATA_PTR) - set(CMAKE_SIZEOF_VOID_P "${CMAKE_C_SIZEOF_DATA_PTR}") -endif() - -if(CMAKE_C_COMPILER_ABI) - set(CMAKE_INTERNAL_PLATFORM_ABI "${CMAKE_C_COMPILER_ABI}") -endif() - -if(CMAKE_C_LIBRARY_ARCHITECTURE) - set(CMAKE_LIBRARY_ARCHITECTURE "") -endif() - -set(CMAKE_C_CL_SHOWINCLUDES_PREFIX "") -if(CMAKE_C_CL_SHOWINCLUDES_PREFIX) - set(CMAKE_CL_SHOWINCLUDES_PREFIX "${CMAKE_C_CL_SHOWINCLUDES_PREFIX}") -endif() - - - - - -set(CMAKE_C_IMPLICIT_INCLUDE_DIRECTORIES "/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include;/usr/local/include;/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include-fixed;/usr/include") -set(CMAKE_C_IMPLICIT_LINK_LIBRARIES "gcc;gcc_s;c;gcc;gcc_s") -set(CMAKE_C_IMPLICIT_LINK_DIRECTORIES "/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1;/usr/lib;/lib") -set(CMAKE_C_IMPLICIT_LINK_FRAMEWORK_DIRECTORIES "") diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.3/CMakeDetermineCompilerABI_C.bin b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.3/CMakeDetermineCompilerABI_C.bin Binary files differ. diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.3/CMakeSystem.cmake b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.3/CMakeSystem.cmake @@ -1,15 +0,0 @@ -set(CMAKE_HOST_SYSTEM "Linux-6.10.8-arch1-1") -set(CMAKE_HOST_SYSTEM_NAME "Linux") -set(CMAKE_HOST_SYSTEM_VERSION "6.10.8-arch1-1") -set(CMAKE_HOST_SYSTEM_PROCESSOR "x86_64") - - - -set(CMAKE_SYSTEM "Linux-6.10.8-arch1-1") -set(CMAKE_SYSTEM_NAME "Linux") -set(CMAKE_SYSTEM_VERSION "6.10.8-arch1-1") -set(CMAKE_SYSTEM_PROCESSOR "x86_64") - -set(CMAKE_CROSSCOMPILING "FALSE") - -set(CMAKE_SYSTEM_LOADED 1) diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.3/CompilerIdC/CMakeCCompilerId.c b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.3/CompilerIdC/CMakeCCompilerId.c @@ -1,904 +0,0 @@ -#ifdef __cplusplus -# error "A C++ compiler has been selected for C." -#endif - -#if defined(__18CXX) -# define ID_VOID_MAIN -#endif -#if defined(__CLASSIC_C__) -/* cv-qualifiers did not exist in K&R C */ -# define const -# define volatile -#endif - -#if !defined(__has_include) -/* If the compiler does not have __has_include, pretend the answer is - always no. */ -# define __has_include(x) 0 -#endif - - -/* Version number components: V=Version, R=Revision, P=Patch - Version date components: YYYY=Year, MM=Month, DD=Day */ - -#if defined(__INTEL_COMPILER) || defined(__ICC) -# define COMPILER_ID "Intel" -# if defined(_MSC_VER) -# define SIMULATE_ID "MSVC" -# endif -# if defined(__GNUC__) -# define SIMULATE_ID "GNU" -# endif - /* __INTEL_COMPILER = VRP prior to 2021, and then VVVV for 2021 and later, - except that a few beta releases use the old format with V=2021. */ -# if __INTEL_COMPILER < 2021 || __INTEL_COMPILER == 202110 || __INTEL_COMPILER == 202111 -# define COMPILER_VERSION_MAJOR DEC(__INTEL_COMPILER/100) -# define COMPILER_VERSION_MINOR DEC(__INTEL_COMPILER/10 % 10) -# if defined(__INTEL_COMPILER_UPDATE) -# define COMPILER_VERSION_PATCH DEC(__INTEL_COMPILER_UPDATE) -# else -# define COMPILER_VERSION_PATCH DEC(__INTEL_COMPILER % 10) -# endif -# else -# define COMPILER_VERSION_MAJOR DEC(__INTEL_COMPILER) -# define COMPILER_VERSION_MINOR DEC(__INTEL_COMPILER_UPDATE) - /* The third version component from --version is an update index, - but no macro is provided for it. */ -# define COMPILER_VERSION_PATCH DEC(0) -# endif -# if defined(__INTEL_COMPILER_BUILD_DATE) - /* __INTEL_COMPILER_BUILD_DATE = YYYYMMDD */ -# define COMPILER_VERSION_TWEAK DEC(__INTEL_COMPILER_BUILD_DATE) -# endif -# if defined(_MSC_VER) - /* _MSC_VER = VVRR */ -# define SIMULATE_VERSION_MAJOR DEC(_MSC_VER / 100) -# define SIMULATE_VERSION_MINOR DEC(_MSC_VER % 100) -# endif -# if defined(__GNUC__) -# define SIMULATE_VERSION_MAJOR DEC(__GNUC__) -# elif defined(__GNUG__) -# define SIMULATE_VERSION_MAJOR DEC(__GNUG__) -# endif -# if defined(__GNUC_MINOR__) -# define SIMULATE_VERSION_MINOR DEC(__GNUC_MINOR__) -# endif -# if defined(__GNUC_PATCHLEVEL__) -# define SIMULATE_VERSION_PATCH DEC(__GNUC_PATCHLEVEL__) -# endif - -#elif (defined(__clang__) && defined(__INTEL_CLANG_COMPILER)) || defined(__INTEL_LLVM_COMPILER) -# define COMPILER_ID "IntelLLVM" -#if defined(_MSC_VER) -# define SIMULATE_ID "MSVC" -#endif -#if defined(__GNUC__) -# define SIMULATE_ID "GNU" -#endif -/* __INTEL_LLVM_COMPILER = VVVVRP prior to 2021.2.0, VVVVRRPP for 2021.2.0 and - * later. Look for 6 digit vs. 8 digit version number to decide encoding. - * VVVV is no smaller than the current year when a version is released. - */ -#if __INTEL_LLVM_COMPILER < 1000000L -# define COMPILER_VERSION_MAJOR DEC(__INTEL_LLVM_COMPILER/100) -# define COMPILER_VERSION_MINOR DEC(__INTEL_LLVM_COMPILER/10 % 10) -# define COMPILER_VERSION_PATCH DEC(__INTEL_LLVM_COMPILER % 10) -#else -# define COMPILER_VERSION_MAJOR DEC(__INTEL_LLVM_COMPILER/10000) -# define COMPILER_VERSION_MINOR DEC(__INTEL_LLVM_COMPILER/100 % 100) -# define COMPILER_VERSION_PATCH DEC(__INTEL_LLVM_COMPILER % 100) -#endif -#if defined(_MSC_VER) - /* _MSC_VER = VVRR */ -# define SIMULATE_VERSION_MAJOR DEC(_MSC_VER / 100) -# define SIMULATE_VERSION_MINOR DEC(_MSC_VER % 100) -#endif -#if defined(__GNUC__) -# define SIMULATE_VERSION_MAJOR DEC(__GNUC__) -#elif defined(__GNUG__) -# define SIMULATE_VERSION_MAJOR DEC(__GNUG__) -#endif -#if defined(__GNUC_MINOR__) -# define SIMULATE_VERSION_MINOR DEC(__GNUC_MINOR__) -#endif -#if defined(__GNUC_PATCHLEVEL__) -# define SIMULATE_VERSION_PATCH DEC(__GNUC_PATCHLEVEL__) -#endif - -#elif defined(__PATHCC__) -# define COMPILER_ID "PathScale" -# define COMPILER_VERSION_MAJOR DEC(__PATHCC__) -# define COMPILER_VERSION_MINOR DEC(__PATHCC_MINOR__) -# if defined(__PATHCC_PATCHLEVEL__) -# define COMPILER_VERSION_PATCH DEC(__PATHCC_PATCHLEVEL__) -# endif - -#elif defined(__BORLANDC__) && defined(__CODEGEARC_VERSION__) -# define COMPILER_ID "Embarcadero" -# define COMPILER_VERSION_MAJOR HEX(__CODEGEARC_VERSION__>>24 & 0x00FF) -# define COMPILER_VERSION_MINOR HEX(__CODEGEARC_VERSION__>>16 & 0x00FF) -# define COMPILER_VERSION_PATCH DEC(__CODEGEARC_VERSION__ & 0xFFFF) - -#elif defined(__BORLANDC__) -# define COMPILER_ID "Borland" - /* __BORLANDC__ = 0xVRR */ -# define COMPILER_VERSION_MAJOR HEX(__BORLANDC__>>8) -# define COMPILER_VERSION_MINOR HEX(__BORLANDC__ & 0xFF) - -#elif defined(__WATCOMC__) && __WATCOMC__ < 1200 -# define COMPILER_ID "Watcom" - /* __WATCOMC__ = VVRR */ -# define COMPILER_VERSION_MAJOR DEC(__WATCOMC__ / 100) -# define COMPILER_VERSION_MINOR DEC((__WATCOMC__ / 10) % 10) -# if (__WATCOMC__ % 10) > 0 -# define COMPILER_VERSION_PATCH DEC(__WATCOMC__ % 10) -# endif - -#elif defined(__WATCOMC__) -# define COMPILER_ID "OpenWatcom" - /* __WATCOMC__ = VVRP + 1100 */ -# define COMPILER_VERSION_MAJOR DEC((__WATCOMC__ - 1100) / 100) -# define COMPILER_VERSION_MINOR DEC((__WATCOMC__ / 10) % 10) -# if (__WATCOMC__ % 10) > 0 -# define COMPILER_VERSION_PATCH DEC(__WATCOMC__ % 10) -# endif - -#elif defined(__SUNPRO_C) -# define COMPILER_ID "SunPro" -# if __SUNPRO_C >= 0x5100 - /* __SUNPRO_C = 0xVRRP */ -# define COMPILER_VERSION_MAJOR HEX(__SUNPRO_C>>12) -# define COMPILER_VERSION_MINOR HEX(__SUNPRO_C>>4 & 0xFF) -# define COMPILER_VERSION_PATCH HEX(__SUNPRO_C & 0xF) -# else - /* __SUNPRO_CC = 0xVRP */ -# define COMPILER_VERSION_MAJOR HEX(__SUNPRO_C>>8) -# define COMPILER_VERSION_MINOR HEX(__SUNPRO_C>>4 & 0xF) -# define COMPILER_VERSION_PATCH HEX(__SUNPRO_C & 0xF) -# endif - -#elif defined(__HP_cc) -# define COMPILER_ID "HP" - /* __HP_cc = VVRRPP */ -# define COMPILER_VERSION_MAJOR DEC(__HP_cc/10000) -# define COMPILER_VERSION_MINOR DEC(__HP_cc/100 % 100) -# define COMPILER_VERSION_PATCH DEC(__HP_cc % 100) - -#elif defined(__DECC) -# define COMPILER_ID "Compaq" - /* __DECC_VER = VVRRTPPPP */ -# define COMPILER_VERSION_MAJOR DEC(__DECC_VER/10000000) -# define COMPILER_VERSION_MINOR DEC(__DECC_VER/100000 % 100) -# define COMPILER_VERSION_PATCH DEC(__DECC_VER % 10000) - -#elif defined(__IBMC__) && defined(__COMPILER_VER__) -# define COMPILER_ID "zOS" - /* __IBMC__ = VRP */ -# define COMPILER_VERSION_MAJOR DEC(__IBMC__/100) -# define COMPILER_VERSION_MINOR DEC(__IBMC__/10 % 10) -# define COMPILER_VERSION_PATCH DEC(__IBMC__ % 10) - -#elif defined(__open_xl__) && defined(__clang__) -# define COMPILER_ID "IBMClang" -# define COMPILER_VERSION_MAJOR DEC(__open_xl_version__) -# define COMPILER_VERSION_MINOR DEC(__open_xl_release__) -# define COMPILER_VERSION_PATCH DEC(__open_xl_modification__) -# define COMPILER_VERSION_TWEAK DEC(__open_xl_ptf_fix_level__) - - -#elif defined(__ibmxl__) && defined(__clang__) -# define COMPILER_ID "XLClang" -# define COMPILER_VERSION_MAJOR DEC(__ibmxl_version__) -# define COMPILER_VERSION_MINOR DEC(__ibmxl_release__) -# define COMPILER_VERSION_PATCH DEC(__ibmxl_modification__) -# define COMPILER_VERSION_TWEAK DEC(__ibmxl_ptf_fix_level__) - - -#elif defined(__IBMC__) && !defined(__COMPILER_VER__) && __IBMC__ >= 800 -# define COMPILER_ID "XL" - /* __IBMC__ = VRP */ -# define COMPILER_VERSION_MAJOR DEC(__IBMC__/100) -# define COMPILER_VERSION_MINOR DEC(__IBMC__/10 % 10) -# define COMPILER_VERSION_PATCH DEC(__IBMC__ % 10) - -#elif defined(__IBMC__) && !defined(__COMPILER_VER__) && __IBMC__ < 800 -# define COMPILER_ID "VisualAge" - /* __IBMC__ = VRP */ -# define COMPILER_VERSION_MAJOR DEC(__IBMC__/100) -# define COMPILER_VERSION_MINOR DEC(__IBMC__/10 % 10) -# define COMPILER_VERSION_PATCH DEC(__IBMC__ % 10) - -#elif defined(__NVCOMPILER) -# define COMPILER_ID "NVHPC" -# define COMPILER_VERSION_MAJOR DEC(__NVCOMPILER_MAJOR__) -# define COMPILER_VERSION_MINOR DEC(__NVCOMPILER_MINOR__) -# if defined(__NVCOMPILER_PATCHLEVEL__) -# define COMPILER_VERSION_PATCH DEC(__NVCOMPILER_PATCHLEVEL__) -# endif - -#elif defined(__PGI) -# define COMPILER_ID "PGI" -# define COMPILER_VERSION_MAJOR DEC(__PGIC__) -# define COMPILER_VERSION_MINOR DEC(__PGIC_MINOR__) -# if defined(__PGIC_PATCHLEVEL__) -# define COMPILER_VERSION_PATCH DEC(__PGIC_PATCHLEVEL__) -# endif - -#elif defined(__clang__) && defined(__cray__) -# define COMPILER_ID "CrayClang" -# define COMPILER_VERSION_MAJOR DEC(__cray_major__) -# define COMPILER_VERSION_MINOR DEC(__cray_minor__) -# define COMPILER_VERSION_PATCH DEC(__cray_patchlevel__) -# define COMPILER_VERSION_INTERNAL_STR __clang_version__ - - -#elif defined(_CRAYC) -# define COMPILER_ID "Cray" -# define COMPILER_VERSION_MAJOR DEC(_RELEASE_MAJOR) -# define COMPILER_VERSION_MINOR DEC(_RELEASE_MINOR) - -#elif defined(__TI_COMPILER_VERSION__) -# define COMPILER_ID "TI" - /* __TI_COMPILER_VERSION__ = VVVRRRPPP */ -# define COMPILER_VERSION_MAJOR DEC(__TI_COMPILER_VERSION__/1000000) -# define COMPILER_VERSION_MINOR DEC(__TI_COMPILER_VERSION__/1000 % 1000) -# define COMPILER_VERSION_PATCH DEC(__TI_COMPILER_VERSION__ % 1000) - -#elif defined(__CLANG_FUJITSU) -# define COMPILER_ID "FujitsuClang" -# define COMPILER_VERSION_MAJOR DEC(__FCC_major__) -# define COMPILER_VERSION_MINOR DEC(__FCC_minor__) -# define COMPILER_VERSION_PATCH DEC(__FCC_patchlevel__) -# define COMPILER_VERSION_INTERNAL_STR __clang_version__ - - -#elif defined(__FUJITSU) -# define COMPILER_ID "Fujitsu" -# if defined(__FCC_version__) -# define COMPILER_VERSION __FCC_version__ -# elif defined(__FCC_major__) -# define COMPILER_VERSION_MAJOR DEC(__FCC_major__) -# define COMPILER_VERSION_MINOR DEC(__FCC_minor__) -# define COMPILER_VERSION_PATCH DEC(__FCC_patchlevel__) -# endif -# if defined(__fcc_version) -# define COMPILER_VERSION_INTERNAL DEC(__fcc_version) -# elif defined(__FCC_VERSION) -# define COMPILER_VERSION_INTERNAL DEC(__FCC_VERSION) -# endif - - -#elif defined(__ghs__) -# define COMPILER_ID "GHS" -/* __GHS_VERSION_NUMBER = VVVVRP */ -# ifdef __GHS_VERSION_NUMBER -# define COMPILER_VERSION_MAJOR DEC(__GHS_VERSION_NUMBER / 100) -# define COMPILER_VERSION_MINOR DEC(__GHS_VERSION_NUMBER / 10 % 10) -# define COMPILER_VERSION_PATCH DEC(__GHS_VERSION_NUMBER % 10) -# endif - -#elif defined(__TASKING__) -# define COMPILER_ID "Tasking" - # define COMPILER_VERSION_MAJOR DEC(__VERSION__/1000) - # define COMPILER_VERSION_MINOR DEC(__VERSION__ % 100) -# define COMPILER_VERSION_INTERNAL DEC(__VERSION__) - -#elif defined(__ORANGEC__) -# define COMPILER_ID "OrangeC" -# define COMPILER_VERSION_MAJOR DEC(__ORANGEC_MAJOR__) -# define COMPILER_VERSION_MINOR DEC(__ORANGEC_MINOR__) -# define COMPILER_VERSION_PATCH DEC(__ORANGEC_PATCHLEVEL__) - -#elif defined(__TINYC__) -# define COMPILER_ID "TinyCC" - -#elif defined(__BCC__) -# define COMPILER_ID "Bruce" - -#elif defined(__SCO_VERSION__) -# define COMPILER_ID "SCO" - -#elif defined(__ARMCC_VERSION) && !defined(__clang__) -# define COMPILER_ID "ARMCC" -#if __ARMCC_VERSION >= 1000000 - /* __ARMCC_VERSION = VRRPPPP */ - # define COMPILER_VERSION_MAJOR DEC(__ARMCC_VERSION/1000000) - # define COMPILER_VERSION_MINOR DEC(__ARMCC_VERSION/10000 % 100) - # define COMPILER_VERSION_PATCH DEC(__ARMCC_VERSION % 10000) -#else - /* __ARMCC_VERSION = VRPPPP */ - # define COMPILER_VERSION_MAJOR DEC(__ARMCC_VERSION/100000) - # define COMPILER_VERSION_MINOR DEC(__ARMCC_VERSION/10000 % 10) - # define COMPILER_VERSION_PATCH DEC(__ARMCC_VERSION % 10000) -#endif - - -#elif defined(__clang__) && defined(__apple_build_version__) -# define COMPILER_ID "AppleClang" -# if defined(_MSC_VER) -# define SIMULATE_ID "MSVC" -# endif -# define COMPILER_VERSION_MAJOR DEC(__clang_major__) -# define COMPILER_VERSION_MINOR DEC(__clang_minor__) -# define COMPILER_VERSION_PATCH DEC(__clang_patchlevel__) -# if defined(_MSC_VER) - /* _MSC_VER = VVRR */ -# define SIMULATE_VERSION_MAJOR DEC(_MSC_VER / 100) -# define SIMULATE_VERSION_MINOR DEC(_MSC_VER % 100) -# endif -# define COMPILER_VERSION_TWEAK DEC(__apple_build_version__) - -#elif defined(__clang__) && defined(__ARMCOMPILER_VERSION) -# define COMPILER_ID "ARMClang" - # define COMPILER_VERSION_MAJOR DEC(__ARMCOMPILER_VERSION/1000000) - # define COMPILER_VERSION_MINOR DEC(__ARMCOMPILER_VERSION/10000 % 100) - # define COMPILER_VERSION_PATCH DEC(__ARMCOMPILER_VERSION/100 % 100) -# define COMPILER_VERSION_INTERNAL DEC(__ARMCOMPILER_VERSION) - -#elif defined(__clang__) && defined(__ti__) -# define COMPILER_ID "TIClang" - # define COMPILER_VERSION_MAJOR DEC(__ti_major__) - # define COMPILER_VERSION_MINOR DEC(__ti_minor__) - # define COMPILER_VERSION_PATCH DEC(__ti_patchlevel__) -# define COMPILER_VERSION_INTERNAL DEC(__ti_version__) - -#elif defined(__clang__) -# define COMPILER_ID "Clang" -# if defined(_MSC_VER) -# define SIMULATE_ID "MSVC" -# endif -# define COMPILER_VERSION_MAJOR DEC(__clang_major__) -# define COMPILER_VERSION_MINOR DEC(__clang_minor__) -# define COMPILER_VERSION_PATCH DEC(__clang_patchlevel__) -# if defined(_MSC_VER) - /* _MSC_VER = VVRR */ -# define SIMULATE_VERSION_MAJOR DEC(_MSC_VER / 100) -# define SIMULATE_VERSION_MINOR DEC(_MSC_VER % 100) -# endif - -#elif defined(__LCC__) && (defined(__GNUC__) || defined(__GNUG__) || defined(__MCST__)) -# define COMPILER_ID "LCC" -# define COMPILER_VERSION_MAJOR DEC(__LCC__ / 100) -# define COMPILER_VERSION_MINOR DEC(__LCC__ % 100) -# if defined(__LCC_MINOR__) -# define COMPILER_VERSION_PATCH DEC(__LCC_MINOR__) -# endif -# if defined(__GNUC__) && defined(__GNUC_MINOR__) -# define SIMULATE_ID "GNU" -# define SIMULATE_VERSION_MAJOR DEC(__GNUC__) -# define SIMULATE_VERSION_MINOR DEC(__GNUC_MINOR__) -# if defined(__GNUC_PATCHLEVEL__) -# define SIMULATE_VERSION_PATCH DEC(__GNUC_PATCHLEVEL__) -# endif -# endif - -#elif defined(__GNUC__) -# define COMPILER_ID "GNU" -# define COMPILER_VERSION_MAJOR DEC(__GNUC__) -# if defined(__GNUC_MINOR__) -# define COMPILER_VERSION_MINOR DEC(__GNUC_MINOR__) -# endif -# if defined(__GNUC_PATCHLEVEL__) -# define COMPILER_VERSION_PATCH DEC(__GNUC_PATCHLEVEL__) -# endif - -#elif defined(_MSC_VER) -# define COMPILER_ID "MSVC" - /* _MSC_VER = VVRR */ -# define COMPILER_VERSION_MAJOR DEC(_MSC_VER / 100) -# define COMPILER_VERSION_MINOR DEC(_MSC_VER % 100) -# if defined(_MSC_FULL_VER) -# if _MSC_VER >= 1400 - /* _MSC_FULL_VER = VVRRPPPPP */ -# define COMPILER_VERSION_PATCH DEC(_MSC_FULL_VER % 100000) -# else - /* _MSC_FULL_VER = VVRRPPPP */ -# define COMPILER_VERSION_PATCH DEC(_MSC_FULL_VER % 10000) -# endif -# endif -# if defined(_MSC_BUILD) -# define COMPILER_VERSION_TWEAK DEC(_MSC_BUILD) -# endif - -#elif defined(_ADI_COMPILER) -# define COMPILER_ID "ADSP" -#if defined(__VERSIONNUM__) - /* __VERSIONNUM__ = 0xVVRRPPTT */ -# define COMPILER_VERSION_MAJOR DEC(__VERSIONNUM__ >> 24 & 0xFF) -# define COMPILER_VERSION_MINOR DEC(__VERSIONNUM__ >> 16 & 0xFF) -# define COMPILER_VERSION_PATCH DEC(__VERSIONNUM__ >> 8 & 0xFF) -# define COMPILER_VERSION_TWEAK DEC(__VERSIONNUM__ & 0xFF) -#endif - -#elif defined(__IAR_SYSTEMS_ICC__) || defined(__IAR_SYSTEMS_ICC) -# define COMPILER_ID "IAR" -# if defined(__VER__) && defined(__ICCARM__) -# define COMPILER_VERSION_MAJOR DEC((__VER__) / 1000000) -# define COMPILER_VERSION_MINOR DEC(((__VER__) / 1000) % 1000) -# define COMPILER_VERSION_PATCH DEC((__VER__) % 1000) -# define COMPILER_VERSION_INTERNAL DEC(__IAR_SYSTEMS_ICC__) -# elif defined(__VER__) && (defined(__ICCAVR__) || defined(__ICCRX__) || defined(__ICCRH850__) || defined(__ICCRL78__) || defined(__ICC430__) || defined(__ICCRISCV__) || defined(__ICCV850__) || defined(__ICC8051__) || defined(__ICCSTM8__)) -# define COMPILER_VERSION_MAJOR DEC((__VER__) / 100) -# define COMPILER_VERSION_MINOR DEC((__VER__) - (((__VER__) / 100)*100)) -# define COMPILER_VERSION_PATCH DEC(__SUBVERSION__) -# define COMPILER_VERSION_INTERNAL DEC(__IAR_SYSTEMS_ICC__) -# endif - -#elif defined(__SDCC_VERSION_MAJOR) || defined(SDCC) -# define COMPILER_ID "SDCC" -# if defined(__SDCC_VERSION_MAJOR) -# define COMPILER_VERSION_MAJOR DEC(__SDCC_VERSION_MAJOR) -# define COMPILER_VERSION_MINOR DEC(__SDCC_VERSION_MINOR) -# define COMPILER_VERSION_PATCH DEC(__SDCC_VERSION_PATCH) -# else - /* SDCC = VRP */ -# define COMPILER_VERSION_MAJOR DEC(SDCC/100) -# define COMPILER_VERSION_MINOR DEC(SDCC/10 % 10) -# define COMPILER_VERSION_PATCH DEC(SDCC % 10) -# endif - - -/* These compilers are either not known or too old to define an - identification macro. Try to identify the platform and guess that - it is the native compiler. */ -#elif defined(__hpux) || defined(__hpua) -# define COMPILER_ID "HP" - -#else /* unknown compiler */ -# define COMPILER_ID "" -#endif - -/* Construct the string literal in pieces to prevent the source from - getting matched. Store it in a pointer rather than an array - because some compilers will just produce instructions to fill the - array rather than assigning a pointer to a static array. */ -char const* info_compiler = "INFO" ":" "compiler[" COMPILER_ID "]"; -#ifdef SIMULATE_ID -char const* info_simulate = "INFO" ":" "simulate[" SIMULATE_ID "]"; -#endif - -#ifdef __QNXNTO__ -char const* qnxnto = "INFO" ":" "qnxnto[]"; -#endif - -#if defined(__CRAYXT_COMPUTE_LINUX_TARGET) -char const *info_cray = "INFO" ":" "compiler_wrapper[CrayPrgEnv]"; -#endif - -#define STRINGIFY_HELPER(X) #X -#define STRINGIFY(X) STRINGIFY_HELPER(X) - -/* Identify known platforms by name. */ -#if defined(__linux) || defined(__linux__) || defined(linux) -# define PLATFORM_ID "Linux" - -#elif defined(__MSYS__) -# define PLATFORM_ID "MSYS" - -#elif defined(__CYGWIN__) -# define PLATFORM_ID "Cygwin" - -#elif defined(__MINGW32__) -# define PLATFORM_ID "MinGW" - -#elif defined(__APPLE__) -# define PLATFORM_ID "Darwin" - -#elif defined(_WIN32) || defined(__WIN32__) || defined(WIN32) -# define PLATFORM_ID "Windows" - -#elif defined(__FreeBSD__) || defined(__FreeBSD) -# define PLATFORM_ID "FreeBSD" - -#elif defined(__NetBSD__) || defined(__NetBSD) -# define PLATFORM_ID "NetBSD" - -#elif defined(__OpenBSD__) || defined(__OPENBSD) -# define PLATFORM_ID "OpenBSD" - -#elif defined(__sun) || defined(sun) -# define PLATFORM_ID "SunOS" - -#elif defined(_AIX) || defined(__AIX) || defined(__AIX__) || defined(__aix) || defined(__aix__) -# define PLATFORM_ID "AIX" - -#elif defined(__hpux) || defined(__hpux__) -# define PLATFORM_ID "HP-UX" - -#elif defined(__HAIKU__) -# define PLATFORM_ID "Haiku" - -#elif defined(__BeOS) || defined(__BEOS__) || defined(_BEOS) -# define PLATFORM_ID "BeOS" - -#elif defined(__QNX__) || defined(__QNXNTO__) -# define PLATFORM_ID "QNX" - -#elif defined(__tru64) || defined(_tru64) || defined(__TRU64__) -# define PLATFORM_ID "Tru64" - -#elif defined(__riscos) || defined(__riscos__) -# define PLATFORM_ID "RISCos" - -#elif defined(__sinix) || defined(__sinix__) || defined(__SINIX__) -# define PLATFORM_ID "SINIX" - -#elif defined(__UNIX_SV__) -# define PLATFORM_ID "UNIX_SV" - -#elif defined(__bsdos__) -# define PLATFORM_ID "BSDOS" - -#elif defined(_MPRAS) || defined(MPRAS) -# define PLATFORM_ID "MP-RAS" - -#elif defined(__osf) || defined(__osf__) -# define PLATFORM_ID "OSF1" - -#elif defined(_SCO_SV) || defined(SCO_SV) || defined(sco_sv) -# define PLATFORM_ID "SCO_SV" - -#elif defined(__ultrix) || defined(__ultrix__) || defined(_ULTRIX) -# define PLATFORM_ID "ULTRIX" - -#elif defined(__XENIX__) || defined(_XENIX) || defined(XENIX) -# define PLATFORM_ID "Xenix" - -#elif defined(__WATCOMC__) -# if defined(__LINUX__) -# define PLATFORM_ID "Linux" - -# elif defined(__DOS__) -# define PLATFORM_ID "DOS" - -# elif defined(__OS2__) -# define PLATFORM_ID "OS2" - -# elif defined(__WINDOWS__) -# define PLATFORM_ID "Windows3x" - -# elif defined(__VXWORKS__) -# define PLATFORM_ID "VxWorks" - -# else /* unknown platform */ -# define PLATFORM_ID -# endif - -#elif defined(__INTEGRITY) -# if defined(INT_178B) -# define PLATFORM_ID "Integrity178" - -# else /* regular Integrity */ -# define PLATFORM_ID "Integrity" -# endif - -# elif defined(_ADI_COMPILER) -# define PLATFORM_ID "ADSP" - -#else /* unknown platform */ -# define PLATFORM_ID - -#endif - -/* For windows compilers MSVC and Intel we can determine - the architecture of the compiler being used. This is because - the compilers do not have flags that can change the architecture, - but rather depend on which compiler is being used -*/ -#if defined(_WIN32) && defined(_MSC_VER) -# if defined(_M_IA64) -# define ARCHITECTURE_ID "IA64" - -# elif defined(_M_ARM64EC) -# define ARCHITECTURE_ID "ARM64EC" - -# elif defined(_M_X64) || defined(_M_AMD64) -# define ARCHITECTURE_ID "x64" - -# elif defined(_M_IX86) -# define ARCHITECTURE_ID "X86" - -# elif defined(_M_ARM64) -# define ARCHITECTURE_ID "ARM64" - -# elif defined(_M_ARM) -# if _M_ARM == 4 -# define ARCHITECTURE_ID "ARMV4I" -# elif _M_ARM == 5 -# define ARCHITECTURE_ID "ARMV5I" -# else -# define ARCHITECTURE_ID "ARMV" STRINGIFY(_M_ARM) -# endif - -# elif defined(_M_MIPS) -# define ARCHITECTURE_ID "MIPS" - -# elif defined(_M_SH) -# define ARCHITECTURE_ID "SHx" - -# else /* unknown architecture */ -# define ARCHITECTURE_ID "" -# endif - -#elif defined(__WATCOMC__) -# if defined(_M_I86) -# define ARCHITECTURE_ID "I86" - -# elif defined(_M_IX86) -# define ARCHITECTURE_ID "X86" - -# else /* unknown architecture */ -# define ARCHITECTURE_ID "" -# endif - -#elif defined(__IAR_SYSTEMS_ICC__) || defined(__IAR_SYSTEMS_ICC) -# if defined(__ICCARM__) -# define ARCHITECTURE_ID "ARM" - -# elif defined(__ICCRX__) -# define ARCHITECTURE_ID "RX" - -# elif defined(__ICCRH850__) -# define ARCHITECTURE_ID "RH850" - -# elif defined(__ICCRL78__) -# define ARCHITECTURE_ID "RL78" - -# elif defined(__ICCRISCV__) -# define ARCHITECTURE_ID "RISCV" - -# elif defined(__ICCAVR__) -# define ARCHITECTURE_ID "AVR" - -# elif defined(__ICC430__) -# define ARCHITECTURE_ID "MSP430" - -# elif defined(__ICCV850__) -# define ARCHITECTURE_ID "V850" - -# elif defined(__ICC8051__) -# define ARCHITECTURE_ID "8051" - -# elif defined(__ICCSTM8__) -# define ARCHITECTURE_ID "STM8" - -# else /* unknown architecture */ -# define ARCHITECTURE_ID "" -# endif - -#elif defined(__ghs__) -# if defined(__PPC64__) -# define ARCHITECTURE_ID "PPC64" - -# elif defined(__ppc__) -# define ARCHITECTURE_ID "PPC" - -# elif defined(__ARM__) -# define ARCHITECTURE_ID "ARM" - -# elif defined(__x86_64__) -# define ARCHITECTURE_ID "x64" - -# elif defined(__i386__) -# define ARCHITECTURE_ID "X86" - -# else /* unknown architecture */ -# define ARCHITECTURE_ID "" -# endif - -#elif defined(__clang__) && defined(__ti__) -# if defined(__ARM_ARCH) -# define ARCHITECTURE_ID "Arm" - -# else /* unknown architecture */ -# define ARCHITECTURE_ID "" -# endif - -#elif defined(__TI_COMPILER_VERSION__) -# if defined(__TI_ARM__) -# define ARCHITECTURE_ID "ARM" - -# elif defined(__MSP430__) -# define ARCHITECTURE_ID "MSP430" - -# elif defined(__TMS320C28XX__) -# define ARCHITECTURE_ID "TMS320C28x" - -# elif defined(__TMS320C6X__) || defined(_TMS320C6X) -# define ARCHITECTURE_ID "TMS320C6x" - -# else /* unknown architecture */ -# define ARCHITECTURE_ID "" -# endif - -# elif defined(__ADSPSHARC__) -# define ARCHITECTURE_ID "SHARC" - -# elif defined(__ADSPBLACKFIN__) -# define ARCHITECTURE_ID "Blackfin" - -#elif defined(__TASKING__) - -# if defined(__CTC__) || defined(__CPTC__) -# define ARCHITECTURE_ID "TriCore" - -# elif defined(__CMCS__) -# define ARCHITECTURE_ID "MCS" - -# elif defined(__CARM__) -# define ARCHITECTURE_ID "ARM" - -# elif defined(__CARC__) -# define ARCHITECTURE_ID "ARC" - -# elif defined(__C51__) -# define ARCHITECTURE_ID "8051" - -# elif defined(__CPCP__) -# define ARCHITECTURE_ID "PCP" - -# else -# define ARCHITECTURE_ID "" -# endif - -#else -# define ARCHITECTURE_ID -#endif - -/* Convert integer to decimal digit literals. */ -#define DEC(n) \ - ('0' + (((n) / 10000000)%10)), \ - ('0' + (((n) / 1000000)%10)), \ - ('0' + (((n) / 100000)%10)), \ - ('0' + (((n) / 10000)%10)), \ - ('0' + (((n) / 1000)%10)), \ - ('0' + (((n) / 100)%10)), \ - ('0' + (((n) / 10)%10)), \ - ('0' + ((n) % 10)) - -/* Convert integer to hex digit literals. */ -#define HEX(n) \ - ('0' + ((n)>>28 & 0xF)), \ - ('0' + ((n)>>24 & 0xF)), \ - ('0' + ((n)>>20 & 0xF)), \ - ('0' + ((n)>>16 & 0xF)), \ - ('0' + ((n)>>12 & 0xF)), \ - ('0' + ((n)>>8 & 0xF)), \ - ('0' + ((n)>>4 & 0xF)), \ - ('0' + ((n) & 0xF)) - -/* Construct a string literal encoding the version number. */ -#ifdef COMPILER_VERSION -char const* info_version = "INFO" ":" "compiler_version[" COMPILER_VERSION "]"; - -/* Construct a string literal encoding the version number components. */ -#elif defined(COMPILER_VERSION_MAJOR) -char const info_version[] = { - 'I', 'N', 'F', 'O', ':', - 'c','o','m','p','i','l','e','r','_','v','e','r','s','i','o','n','[', - COMPILER_VERSION_MAJOR, -# ifdef COMPILER_VERSION_MINOR - '.', COMPILER_VERSION_MINOR, -# ifdef COMPILER_VERSION_PATCH - '.', COMPILER_VERSION_PATCH, -# ifdef COMPILER_VERSION_TWEAK - '.', COMPILER_VERSION_TWEAK, -# endif -# endif -# endif - ']','\0'}; -#endif - -/* Construct a string literal encoding the internal version number. */ -#ifdef COMPILER_VERSION_INTERNAL -char const info_version_internal[] = { - 'I', 'N', 'F', 'O', ':', - 'c','o','m','p','i','l','e','r','_','v','e','r','s','i','o','n','_', - 'i','n','t','e','r','n','a','l','[', - COMPILER_VERSION_INTERNAL,']','\0'}; -#elif defined(COMPILER_VERSION_INTERNAL_STR) -char const* info_version_internal = "INFO" ":" "compiler_version_internal[" COMPILER_VERSION_INTERNAL_STR "]"; -#endif - -/* Construct a string literal encoding the version number components. */ -#ifdef SIMULATE_VERSION_MAJOR -char const info_simulate_version[] = { - 'I', 'N', 'F', 'O', ':', - 's','i','m','u','l','a','t','e','_','v','e','r','s','i','o','n','[', - SIMULATE_VERSION_MAJOR, -# ifdef SIMULATE_VERSION_MINOR - '.', SIMULATE_VERSION_MINOR, -# ifdef SIMULATE_VERSION_PATCH - '.', SIMULATE_VERSION_PATCH, -# ifdef SIMULATE_VERSION_TWEAK - '.', SIMULATE_VERSION_TWEAK, -# endif -# endif -# endif - ']','\0'}; -#endif - -/* Construct the string literal in pieces to prevent the source from - getting matched. Store it in a pointer rather than an array - because some compilers will just produce instructions to fill the - array rather than assigning a pointer to a static array. */ -char const* info_platform = "INFO" ":" "platform[" PLATFORM_ID "]"; -char const* info_arch = "INFO" ":" "arch[" ARCHITECTURE_ID "]"; - - - -#define C_STD_99 199901L -#define C_STD_11 201112L -#define C_STD_17 201710L -#define C_STD_23 202311L - -#ifdef __STDC_VERSION__ -# define C_STD __STDC_VERSION__ -#endif - -#if !defined(__STDC__) && !defined(__clang__) -# if defined(_MSC_VER) || defined(__ibmxl__) || defined(__IBMC__) -# define C_VERSION "90" -# else -# define C_VERSION -# endif -#elif C_STD > C_STD_17 -# define C_VERSION "23" -#elif C_STD > C_STD_11 -# define C_VERSION "17" -#elif C_STD > C_STD_99 -# define C_VERSION "11" -#elif C_STD >= C_STD_99 -# define C_VERSION "99" -#else -# define C_VERSION "90" -#endif -const char* info_language_standard_default = - "INFO" ":" "standard_default[" C_VERSION "]"; - -const char* info_language_extensions_default = "INFO" ":" "extensions_default[" -#if (defined(__clang__) || defined(__GNUC__) || defined(__xlC__) || \ - defined(__TI_COMPILER_VERSION__)) && \ - !defined(__STRICT_ANSI__) - "ON" -#else - "OFF" -#endif -"]"; - -/*--------------------------------------------------------------------------*/ - -#ifdef ID_VOID_MAIN -void main() {} -#else -# if defined(__CLASSIC_C__) -int main(argc, argv) int argc; char *argv[]; -# else -int main(int argc, char* argv[]) -# endif -{ - int require = 0; - require += info_compiler[argc]; - require += info_platform[argc]; - require += info_arch[argc]; -#ifdef COMPILER_VERSION_MAJOR - require += info_version[argc]; -#endif -#ifdef COMPILER_VERSION_INTERNAL - require += info_version_internal[argc]; -#endif -#ifdef SIMULATE_ID - require += info_simulate[argc]; -#endif -#ifdef SIMULATE_VERSION_MAJOR - require += info_simulate_version[argc]; -#endif -#if defined(__CRAYXT_COMPUTE_LINUX_TARGET) - require += info_cray[argc]; -#endif - require += info_language_standard_default[argc]; - require += info_language_extensions_default[argc]; - (void)argv; - return require; -} -#endif diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.3/CompilerIdC/a.out b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.3/CompilerIdC/a.out Binary files differ. diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeConfigureLog.yaml b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeConfigureLog.yaml @@ -1,522 +0,0 @@ - ---- -events: - - - kind: "message-v1" - backtrace: - - "/usr/share/cmake/Modules/CMakeDetermineSystem.cmake:205 (message)" - - "CMakeLists.txt:4 (project)" - message: | - The system is: Linux - 6.10.6-arch1-1 - x86_64 - - - kind: "message-v1" - backtrace: - - "/usr/share/cmake/Modules/CMakeDetermineCompilerId.cmake:17 (message)" - - "/usr/share/cmake/Modules/CMakeDetermineCompilerId.cmake:64 (__determine_compiler_id_test)" - - "/usr/share/cmake/Modules/CMakeDetermineCCompiler.cmake:123 (CMAKE_DETERMINE_COMPILER_ID)" - - "CMakeLists.txt:4 (project)" - message: | - Compiling the C compiler identification source file "CMakeCCompilerId.c" succeeded. - Compiler: /usr/bin/cc - Build flags: - Id flags: - - The output was: - 0 - - - Compilation of the C compiler identification source "CMakeCCompilerId.c" produced "a.out" - - The C compiler identification is GNU, found in: - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.2/CompilerIdC/a.out - - - - kind: "try_compile-v1" - backtrace: - - "/usr/share/cmake/Modules/CMakeDetermineCompilerABI.cmake:74 (try_compile)" - - "/usr/share/cmake/Modules/CMakeTestCCompiler.cmake:26 (CMAKE_DETERMINE_COMPILER_ABI)" - - "CMakeLists.txt:4 (project)" - checks: - - "Detecting C compiler ABI info" - directories: - source: "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeScratch/TryCompile-NxJfvi" - binary: "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeScratch/TryCompile-NxJfvi" - cmakeVariables: - CMAKE_C_FLAGS: "" - CMAKE_C_FLAGS_DEBUG: "-g" - CMAKE_EXE_LINKER_FLAGS: "" - buildResult: - variable: "CMAKE_C_ABI_COMPILED" - cached: true - stdout: | - Change Dir: '/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeScratch/TryCompile-NxJfvi' - - Run Build Command(s): /usr/bin/cmake -E env VERBOSE=1 /usr/bin/make -f Makefile cmTC_35505/fast - /usr/bin/make -f CMakeFiles/cmTC_35505.dir/build.make CMakeFiles/cmTC_35505.dir/build - make[1]: Entering directory '/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeScratch/TryCompile-NxJfvi' - Building C object CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o - /usr/bin/cc -v -o CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o -c /usr/share/cmake/Modules/CMakeCCompilerABI.c - Using built-in specs. - COLLECT_GCC=/usr/bin/cc - Target: x86_64-pc-linux-gnu - Configured with: /build/gcc/src/gcc/configure --enable-languages=ada,c,c++,d,fortran,go,lto,m2,objc,obj-c++,rust --enable-bootstrap --prefix=/usr --libdir=/usr/lib --libexecdir=/usr/lib --mandir=/usr/share/man --infodir=/usr/share/info --with-bugurl=https://gitlab.archlinux.org/archlinux/packaging/packages/gcc/-/issues --with-build-config=bootstrap-lto --with-linker-hash-style=gnu --with-system-zlib --enable-__cxa_atexit --enable-cet=auto --enable-checking=release --enable-clocale=gnu --enable-default-pie --enable-default-ssp --enable-gnu-indirect-function --enable-gnu-unique-object --enable-libstdcxx-backtrace --enable-link-serialization=1 --enable-linker-build-id --enable-lto --enable-multilib --enable-plugin --enable-shared --enable-threads=posix --disable-libssp --disable-libstdcxx-pch --disable-werror - Thread model: posix - Supported LTO compression algorithms: zlib zstd - gcc version 14.2.1 20240805 (GCC) - COLLECT_GCC_OPTIONS='-v' '-o' 'CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o' '-c' '-mtune=generic' '-march=x86-64' '-dumpdir' 'CMakeFiles/cmTC_35505.dir/' - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/cc1 -quiet -v /usr/share/cmake/Modules/CMakeCCompilerABI.c -quiet -dumpdir CMakeFiles/cmTC_35505.dir/ -dumpbase CMakeCCompilerABI.c.c -dumpbase-ext .c -mtune=generic -march=x86-64 -version -o /tmp/ccC9WcvM.s - GNU C17 (GCC) version 14.2.1 20240805 (x86_64-pc-linux-gnu) - compiled by GNU C version 14.2.1 20240805, GMP version 6.3.0, MPFR version 4.2.1, MPC version 1.3.1, isl version isl-0.26-GMP - - GGC heuristics: --param ggc-min-expand=100 --param ggc-min-heapsize=131072 - ignoring nonexistent directory "/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../x86_64-pc-linux-gnu/include" - #include "..." search starts here: - #include <...> search starts here: - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include - /usr/local/include - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include-fixed - /usr/include - End of search list. - Compiler executable checksum: faa3163d33b78b77071c76eebeab3034 - COLLECT_GCC_OPTIONS='-v' '-o' 'CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o' '-c' '-mtune=generic' '-march=x86-64' '-dumpdir' 'CMakeFiles/cmTC_35505.dir/' - as -v --64 -o CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o /tmp/ccC9WcvM.s - GNU assembler version 2.43.0 (x86_64-pc-linux-gnu) using BFD version (GNU Binutils) 2.43.0 - COMPILER_PATH=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/ - LIBRARY_PATH=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/:/lib/../lib/:/usr/lib/../lib/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../:/lib/:/usr/lib/ - COLLECT_GCC_OPTIONS='-v' '-o' 'CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o' '-c' '-mtune=generic' '-march=x86-64' '-dumpdir' 'CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.' - Linking C executable cmTC_35505 - /usr/bin/cmake -E cmake_link_script CMakeFiles/cmTC_35505.dir/link.txt --verbose=1 - /usr/bin/cc -v -Wl,-v CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o -o cmTC_35505 - Using built-in specs. - COLLECT_GCC=/usr/bin/cc - COLLECT_LTO_WRAPPER=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/lto-wrapper - Target: x86_64-pc-linux-gnu - Configured with: /build/gcc/src/gcc/configure --enable-languages=ada,c,c++,d,fortran,go,lto,m2,objc,obj-c++,rust --enable-bootstrap --prefix=/usr --libdir=/usr/lib --libexecdir=/usr/lib --mandir=/usr/share/man --infodir=/usr/share/info --with-bugurl=https://gitlab.archlinux.org/archlinux/packaging/packages/gcc/-/issues --with-build-config=bootstrap-lto --with-linker-hash-style=gnu --with-system-zlib --enable-__cxa_atexit --enable-cet=auto --enable-checking=release --enable-clocale=gnu --enable-default-pie --enable-default-ssp --enable-gnu-indirect-function --enable-gnu-unique-object --enable-libstdcxx-backtrace --enable-link-serialization=1 --enable-linker-build-id --enable-lto --enable-multilib --enable-plugin --enable-shared --enable-threads=posix --disable-libssp --disable-libstdcxx-pch --disable-werror - Thread model: posix - Supported LTO compression algorithms: zlib zstd - gcc version 14.2.1 20240805 (GCC) - COMPILER_PATH=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/ - LIBRARY_PATH=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/:/lib/../lib/:/usr/lib/../lib/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../:/lib/:/usr/lib/ - COLLECT_GCC_OPTIONS='-v' '-o' 'cmTC_35505' '-mtune=generic' '-march=x86-64' '-dumpdir' 'cmTC_35505.' - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/collect2 -plugin /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/liblto_plugin.so -plugin-opt=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/lto-wrapper -plugin-opt=-fresolution=/tmp/ccgTwKr8.res -plugin-opt=-pass-through=-lgcc -plugin-opt=-pass-through=-lgcc_s -plugin-opt=-pass-through=-lc -plugin-opt=-pass-through=-lgcc -plugin-opt=-pass-through=-lgcc_s --build-id --eh-frame-hdr --hash-style=gnu -m elf_x86_64 -dynamic-linker /lib64/ld-linux-x86-64.so.2 -pie -o cmTC_35505 /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/Scrt1.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crti.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtbeginS.o -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1 -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib -L/lib/../lib -L/usr/lib/../lib -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../.. -v CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o -lgcc --push-state --as-needed -lgcc_s --pop-state -lc -lgcc --push-state --as-needed -lgcc_s --pop-state /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtendS.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crtn.o - collect2 version 14.2.1 20240805 - /usr/bin/ld -plugin /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/liblto_plugin.so -plugin-opt=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/lto-wrapper -plugin-opt=-fresolution=/tmp/ccgTwKr8.res -plugin-opt=-pass-through=-lgcc -plugin-opt=-pass-through=-lgcc_s -plugin-opt=-pass-through=-lc -plugin-opt=-pass-through=-lgcc -plugin-opt=-pass-through=-lgcc_s --build-id --eh-frame-hdr --hash-style=gnu -m elf_x86_64 -dynamic-linker /lib64/ld-linux-x86-64.so.2 -pie -o cmTC_35505 /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/Scrt1.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crti.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtbeginS.o -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1 -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib -L/lib/../lib -L/usr/lib/../lib -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../.. -v CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o -lgcc --push-state --as-needed -lgcc_s --pop-state -lc -lgcc --push-state --as-needed -lgcc_s --pop-state /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtendS.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crtn.o - GNU ld (GNU Binutils) 2.43.0 - COLLECT_GCC_OPTIONS='-v' '-o' 'cmTC_35505' '-mtune=generic' '-march=x86-64' '-dumpdir' 'cmTC_35505.' - make[1]: Leaving directory '/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeScratch/TryCompile-NxJfvi' - - exitCode: 0 - - - kind: "message-v1" - backtrace: - - "/usr/share/cmake/Modules/CMakeDetermineCompilerABI.cmake:182 (message)" - - "/usr/share/cmake/Modules/CMakeTestCCompiler.cmake:26 (CMAKE_DETERMINE_COMPILER_ABI)" - - "CMakeLists.txt:4 (project)" - message: | - Parsed C implicit include dir info: rv=done - found start of include info - found start of implicit include info - add: [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include] - add: [/usr/local/include] - add: [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include-fixed] - add: [/usr/include] - end of search list found - collapse include dir [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include] ==> [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include] - collapse include dir [/usr/local/include] ==> [/usr/local/include] - collapse include dir [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include-fixed] ==> [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include-fixed] - collapse include dir [/usr/include] ==> [/usr/include] - implicit include dirs: [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include;/usr/local/include;/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include-fixed;/usr/include] - - - - - kind: "message-v1" - backtrace: - - "/usr/share/cmake/Modules/CMakeDetermineCompilerABI.cmake:218 (message)" - - "/usr/share/cmake/Modules/CMakeTestCCompiler.cmake:26 (CMAKE_DETERMINE_COMPILER_ABI)" - - "CMakeLists.txt:4 (project)" - message: | - Parsed C implicit link information: - link line regex: [^( *|.*[/\\])(ld[0-9]*(\\.[a-z]+)?|CMAKE_LINK_STARTFILE-NOTFOUND|([^/\\]+-)?ld|collect2)[^/\\]*( |$)] - linker tool regex: [^[ ]*(->|")?[ ]*(([^"]*[/\\])?(ld[0-9]*(\\.[a-z]+)?))("|,| |$)] - ignore line: [Change Dir: '/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeScratch/TryCompile-NxJfvi'] - ignore line: [] - ignore line: [Run Build Command(s): /usr/bin/cmake -E env VERBOSE=1 /usr/bin/make -f Makefile cmTC_35505/fast] - ignore line: [/usr/bin/make -f CMakeFiles/cmTC_35505.dir/build.make CMakeFiles/cmTC_35505.dir/build] - ignore line: [make[1]: Entering directory '/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeScratch/TryCompile-NxJfvi'] - ignore line: [Building C object CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o] - ignore line: [/usr/bin/cc -v -o CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o -c /usr/share/cmake/Modules/CMakeCCompilerABI.c] - ignore line: [Using built-in specs.] - ignore line: [COLLECT_GCC=/usr/bin/cc] - ignore line: [Target: x86_64-pc-linux-gnu] - ignore line: [Configured with: /build/gcc/src/gcc/configure --enable-languages=ada c c++ d fortran go lto m2 objc obj-c++ rust --enable-bootstrap --prefix=/usr --libdir=/usr/lib --libexecdir=/usr/lib --mandir=/usr/share/man --infodir=/usr/share/info --with-bugurl=https://gitlab.archlinux.org/archlinux/packaging/packages/gcc/-/issues --with-build-config=bootstrap-lto --with-linker-hash-style=gnu --with-system-zlib --enable-__cxa_atexit --enable-cet=auto --enable-checking=release --enable-clocale=gnu --enable-default-pie --enable-default-ssp --enable-gnu-indirect-function --enable-gnu-unique-object --enable-libstdcxx-backtrace --enable-link-serialization=1 --enable-linker-build-id --enable-lto --enable-multilib --enable-plugin --enable-shared --enable-threads=posix --disable-libssp --disable-libstdcxx-pch --disable-werror] - ignore line: [Thread model: posix] - ignore line: [Supported LTO compression algorithms: zlib zstd] - ignore line: [gcc version 14.2.1 20240805 (GCC) ] - ignore line: [COLLECT_GCC_OPTIONS='-v' '-o' 'CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o' '-c' '-mtune=generic' '-march=x86-64' '-dumpdir' 'CMakeFiles/cmTC_35505.dir/'] - ignore line: [ /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/cc1 -quiet -v /usr/share/cmake/Modules/CMakeCCompilerABI.c -quiet -dumpdir CMakeFiles/cmTC_35505.dir/ -dumpbase CMakeCCompilerABI.c.c -dumpbase-ext .c -mtune=generic -march=x86-64 -version -o /tmp/ccC9WcvM.s] - ignore line: [GNU C17 (GCC) version 14.2.1 20240805 (x86_64-pc-linux-gnu)] - ignore line: [ compiled by GNU C version 14.2.1 20240805 GMP version 6.3.0 MPFR version 4.2.1 MPC version 1.3.1 isl version isl-0.26-GMP] - ignore line: [] - ignore line: [GGC heuristics: --param ggc-min-expand=100 --param ggc-min-heapsize=131072] - ignore line: [ignoring nonexistent directory "/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../x86_64-pc-linux-gnu/include"] - ignore line: [#include "..." search starts here:] - ignore line: [#include <...> search starts here:] - ignore line: [ /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include] - ignore line: [ /usr/local/include] - ignore line: [ /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include-fixed] - ignore line: [ /usr/include] - ignore line: [End of search list.] - ignore line: [Compiler executable checksum: faa3163d33b78b77071c76eebeab3034] - ignore line: [COLLECT_GCC_OPTIONS='-v' '-o' 'CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o' '-c' '-mtune=generic' '-march=x86-64' '-dumpdir' 'CMakeFiles/cmTC_35505.dir/'] - ignore line: [ as -v --64 -o CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o /tmp/ccC9WcvM.s] - ignore line: [GNU assembler version 2.43.0 (x86_64-pc-linux-gnu) using BFD version (GNU Binutils) 2.43.0] - ignore line: [COMPILER_PATH=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/] - ignore line: [LIBRARY_PATH=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/:/lib/../lib/:/usr/lib/../lib/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../:/lib/:/usr/lib/] - ignore line: [COLLECT_GCC_OPTIONS='-v' '-o' 'CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o' '-c' '-mtune=generic' '-march=x86-64' '-dumpdir' 'CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.'] - ignore line: [Linking C executable cmTC_35505] - ignore line: [/usr/bin/cmake -E cmake_link_script CMakeFiles/cmTC_35505.dir/link.txt --verbose=1] - ignore line: [/usr/bin/cc -v -Wl -v CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o -o cmTC_35505] - ignore line: [Using built-in specs.] - ignore line: [COLLECT_GCC=/usr/bin/cc] - ignore line: [COLLECT_LTO_WRAPPER=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/lto-wrapper] - ignore line: [Target: x86_64-pc-linux-gnu] - ignore line: [Configured with: /build/gcc/src/gcc/configure --enable-languages=ada c c++ d fortran go lto m2 objc obj-c++ rust --enable-bootstrap --prefix=/usr --libdir=/usr/lib --libexecdir=/usr/lib --mandir=/usr/share/man --infodir=/usr/share/info --with-bugurl=https://gitlab.archlinux.org/archlinux/packaging/packages/gcc/-/issues --with-build-config=bootstrap-lto --with-linker-hash-style=gnu --with-system-zlib --enable-__cxa_atexit --enable-cet=auto --enable-checking=release --enable-clocale=gnu --enable-default-pie --enable-default-ssp --enable-gnu-indirect-function --enable-gnu-unique-object --enable-libstdcxx-backtrace --enable-link-serialization=1 --enable-linker-build-id --enable-lto --enable-multilib --enable-plugin --enable-shared --enable-threads=posix --disable-libssp --disable-libstdcxx-pch --disable-werror] - ignore line: [Thread model: posix] - ignore line: [Supported LTO compression algorithms: zlib zstd] - ignore line: [gcc version 14.2.1 20240805 (GCC) ] - ignore line: [COMPILER_PATH=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/] - ignore line: [LIBRARY_PATH=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/:/lib/../lib/:/usr/lib/../lib/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../:/lib/:/usr/lib/] - ignore line: [COLLECT_GCC_OPTIONS='-v' '-o' 'cmTC_35505' '-mtune=generic' '-march=x86-64' '-dumpdir' 'cmTC_35505.'] - link line: [ /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/collect2 -plugin /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/liblto_plugin.so -plugin-opt=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/lto-wrapper -plugin-opt=-fresolution=/tmp/ccgTwKr8.res -plugin-opt=-pass-through=-lgcc -plugin-opt=-pass-through=-lgcc_s -plugin-opt=-pass-through=-lc -plugin-opt=-pass-through=-lgcc -plugin-opt=-pass-through=-lgcc_s --build-id --eh-frame-hdr --hash-style=gnu -m elf_x86_64 -dynamic-linker /lib64/ld-linux-x86-64.so.2 -pie -o cmTC_35505 /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/Scrt1.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crti.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtbeginS.o -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1 -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib -L/lib/../lib -L/usr/lib/../lib -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../.. -v CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o -lgcc --push-state --as-needed -lgcc_s --pop-state -lc -lgcc --push-state --as-needed -lgcc_s --pop-state /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtendS.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crtn.o] - arg [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/collect2] ==> ignore - arg [-plugin] ==> ignore - arg [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/liblto_plugin.so] ==> ignore - arg [-plugin-opt=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/lto-wrapper] ==> ignore - arg [-plugin-opt=-fresolution=/tmp/ccgTwKr8.res] ==> ignore - arg [-plugin-opt=-pass-through=-lgcc] ==> ignore - arg [-plugin-opt=-pass-through=-lgcc_s] ==> ignore - arg [-plugin-opt=-pass-through=-lc] ==> ignore - arg [-plugin-opt=-pass-through=-lgcc] ==> ignore - arg [-plugin-opt=-pass-through=-lgcc_s] ==> ignore - arg [--build-id] ==> ignore - arg [--eh-frame-hdr] ==> ignore - arg [--hash-style=gnu] ==> ignore - arg [-m] ==> ignore - arg [elf_x86_64] ==> ignore - arg [-dynamic-linker] ==> ignore - arg [/lib64/ld-linux-x86-64.so.2] ==> ignore - arg [-pie] ==> ignore - arg [-o] ==> ignore - arg [cmTC_35505] ==> ignore - arg [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/Scrt1.o] ==> obj [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/Scrt1.o] - arg [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crti.o] ==> obj [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crti.o] - arg [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtbeginS.o] ==> obj [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtbeginS.o] - arg [-L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1] ==> dir [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1] - arg [-L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib] ==> dir [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib] - arg [-L/lib/../lib] ==> dir [/lib/../lib] - arg [-L/usr/lib/../lib] ==> dir [/usr/lib/../lib] - arg [-L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../..] ==> dir [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../..] - arg [-v] ==> ignore - arg [CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o] ==> ignore - arg [-lgcc] ==> lib [gcc] - arg [--push-state] ==> ignore - arg [--as-needed] ==> ignore - arg [-lgcc_s] ==> lib [gcc_s] - arg [--pop-state] ==> ignore - arg [-lc] ==> lib [c] - arg [-lgcc] ==> lib [gcc] - arg [--push-state] ==> ignore - arg [--as-needed] ==> ignore - arg [-lgcc_s] ==> lib [gcc_s] - arg [--pop-state] ==> ignore - arg [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtendS.o] ==> obj [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtendS.o] - arg [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crtn.o] ==> obj [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crtn.o] - ignore line: [collect2 version 14.2.1 20240805] - ignore line: [/usr/bin/ld -plugin /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/liblto_plugin.so -plugin-opt=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/lto-wrapper -plugin-opt=-fresolution=/tmp/ccgTwKr8.res -plugin-opt=-pass-through=-lgcc -plugin-opt=-pass-through=-lgcc_s -plugin-opt=-pass-through=-lc -plugin-opt=-pass-through=-lgcc -plugin-opt=-pass-through=-lgcc_s --build-id --eh-frame-hdr --hash-style=gnu -m elf_x86_64 -dynamic-linker /lib64/ld-linux-x86-64.so.2 -pie -o cmTC_35505 /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/Scrt1.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crti.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtbeginS.o -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1 -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib -L/lib/../lib -L/usr/lib/../lib -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../.. -v CMakeFiles/cmTC_35505.dir/CMakeCCompilerABI.c.o -lgcc --push-state --as-needed -lgcc_s --pop-state -lc -lgcc --push-state --as-needed -lgcc_s --pop-state /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtendS.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crtn.o] - linker tool for 'C': /usr/bin/ld - collapse obj [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/Scrt1.o] ==> [/usr/lib/Scrt1.o] - collapse obj [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crti.o] ==> [/usr/lib/crti.o] - collapse obj [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crtn.o] ==> [/usr/lib/crtn.o] - collapse library dir [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1] ==> [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1] - collapse library dir [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib] ==> [/usr/lib] - collapse library dir [/lib/../lib] ==> [/lib] - collapse library dir [/usr/lib/../lib] ==> [/usr/lib] - collapse library dir [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../..] ==> [/usr/lib] - implicit libs: [gcc;gcc_s;c;gcc;gcc_s] - implicit objs: [/usr/lib/Scrt1.o;/usr/lib/crti.o;/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtbeginS.o;/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtendS.o;/usr/lib/crtn.o] - implicit dirs: [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1;/usr/lib;/lib] - implicit fwks: [] - - - - - kind: "message-v1" - backtrace: - - "/usr/share/cmake/Modules/Internal/CMakeDetermineLinkerId.cmake:40 (message)" - - "/usr/share/cmake/Modules/CMakeDetermineCompilerABI.cmake:255 (cmake_determine_linker_id)" - - "/usr/share/cmake/Modules/CMakeTestCCompiler.cmake:26 (CMAKE_DETERMINE_COMPILER_ABI)" - - "CMakeLists.txt:4 (project)" - message: | - Running the C compiler's linker: "/usr/bin/ld" "-v" - GNU ld (GNU Binutils) 2.43.0 -... - ---- -events: - - - kind: "message-v1" - backtrace: - - "/usr/share/cmake/Modules/CMakeDetermineSystem.cmake:205 (message)" - - "CMakeLists.txt:4 (project)" - message: | - The system is: Linux - 6.10.8-arch1-1 - x86_64 - - - kind: "message-v1" - backtrace: - - "/usr/share/cmake/Modules/CMakeDetermineCompilerId.cmake:17 (message)" - - "/usr/share/cmake/Modules/CMakeDetermineCompilerId.cmake:64 (__determine_compiler_id_test)" - - "/usr/share/cmake/Modules/CMakeDetermineCCompiler.cmake:123 (CMAKE_DETERMINE_COMPILER_ID)" - - "CMakeLists.txt:4 (project)" - message: | - Compiling the C compiler identification source file "CMakeCCompilerId.c" succeeded. - Compiler: /usr/bin/cc - Build flags: - Id flags: - - The output was: - 0 - - - Compilation of the C compiler identification source "CMakeCCompilerId.c" produced "a.out" - - The C compiler identification is GNU, found in: - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/3.30.3/CompilerIdC/a.out - - - - kind: "try_compile-v1" - backtrace: - - "/usr/share/cmake/Modules/CMakeDetermineCompilerABI.cmake:74 (try_compile)" - - "/usr/share/cmake/Modules/CMakeTestCCompiler.cmake:26 (CMAKE_DETERMINE_COMPILER_ABI)" - - "CMakeLists.txt:4 (project)" - checks: - - "Detecting C compiler ABI info" - directories: - source: "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeScratch/TryCompile-OqXOtR" - binary: "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeScratch/TryCompile-OqXOtR" - cmakeVariables: - CMAKE_C_FLAGS: "" - CMAKE_C_FLAGS_DEBUG: "-g" - CMAKE_EXE_LINKER_FLAGS: "" - buildResult: - variable: "CMAKE_C_ABI_COMPILED" - cached: true - stdout: | - Change Dir: '/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeScratch/TryCompile-OqXOtR' - - Run Build Command(s): /usr/bin/cmake -E env VERBOSE=1 /usr/bin/make -f Makefile cmTC_432b1/fast - /usr/bin/make -f CMakeFiles/cmTC_432b1.dir/build.make CMakeFiles/cmTC_432b1.dir/build - make[1]: Entering directory '/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeScratch/TryCompile-OqXOtR' - Building C object CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o - /usr/bin/cc -v -o CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o -c /usr/share/cmake/Modules/CMakeCCompilerABI.c - Using built-in specs. - COLLECT_GCC=/usr/bin/cc - Target: x86_64-pc-linux-gnu - Configured with: /build/gcc/src/gcc/configure --enable-languages=ada,c,c++,d,fortran,go,lto,m2,objc,obj-c++,rust --enable-bootstrap --prefix=/usr --libdir=/usr/lib --libexecdir=/usr/lib --mandir=/usr/share/man --infodir=/usr/share/info --with-bugurl=https://gitlab.archlinux.org/archlinux/packaging/packages/gcc/-/issues --with-build-config=bootstrap-lto --with-linker-hash-style=gnu --with-system-zlib --enable-__cxa_atexit --enable-cet=auto --enable-checking=release --enable-clocale=gnu --enable-default-pie --enable-default-ssp --enable-gnu-indirect-function --enable-gnu-unique-object --enable-libstdcxx-backtrace --enable-link-serialization=1 --enable-linker-build-id --enable-lto --enable-multilib --enable-plugin --enable-shared --enable-threads=posix --disable-libssp --disable-libstdcxx-pch --disable-werror - Thread model: posix - Supported LTO compression algorithms: zlib zstd - gcc version 14.2.1 20240805 (GCC) - COLLECT_GCC_OPTIONS='-v' '-o' 'CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o' '-c' '-mtune=generic' '-march=x86-64' '-dumpdir' 'CMakeFiles/cmTC_432b1.dir/' - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/cc1 -quiet -v /usr/share/cmake/Modules/CMakeCCompilerABI.c -quiet -dumpdir CMakeFiles/cmTC_432b1.dir/ -dumpbase CMakeCCompilerABI.c.c -dumpbase-ext .c -mtune=generic -march=x86-64 -version -o /tmp/ccKaHqEO.s - GNU C17 (GCC) version 14.2.1 20240805 (x86_64-pc-linux-gnu) - compiled by GNU C version 14.2.1 20240805, GMP version 6.3.0, MPFR version 4.2.1, MPC version 1.3.1, isl version isl-0.27-GMP - - GGC heuristics: --param ggc-min-expand=100 --param ggc-min-heapsize=131072 - ignoring nonexistent directory "/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../x86_64-pc-linux-gnu/include" - #include "..." search starts here: - #include <...> search starts here: - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include - /usr/local/include - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include-fixed - /usr/include - End of search list. - Compiler executable checksum: faa3163d33b78b77071c76eebeab3034 - COLLECT_GCC_OPTIONS='-v' '-o' 'CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o' '-c' '-mtune=generic' '-march=x86-64' '-dumpdir' 'CMakeFiles/cmTC_432b1.dir/' - as -v --64 -o CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o /tmp/ccKaHqEO.s - GNU assembler version 2.43.0 (x86_64-pc-linux-gnu) using BFD version (GNU Binutils) 2.43.0 - COMPILER_PATH=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/ - LIBRARY_PATH=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/:/lib/../lib/:/usr/lib/../lib/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../:/lib/:/usr/lib/ - COLLECT_GCC_OPTIONS='-v' '-o' 'CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o' '-c' '-mtune=generic' '-march=x86-64' '-dumpdir' 'CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.' - Linking C executable cmTC_432b1 - /usr/bin/cmake -E cmake_link_script CMakeFiles/cmTC_432b1.dir/link.txt --verbose=1 - /usr/bin/cc -v -Wl,-v CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o -o cmTC_432b1 - Using built-in specs. - COLLECT_GCC=/usr/bin/cc - COLLECT_LTO_WRAPPER=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/lto-wrapper - Target: x86_64-pc-linux-gnu - Configured with: /build/gcc/src/gcc/configure --enable-languages=ada,c,c++,d,fortran,go,lto,m2,objc,obj-c++,rust --enable-bootstrap --prefix=/usr --libdir=/usr/lib --libexecdir=/usr/lib --mandir=/usr/share/man --infodir=/usr/share/info --with-bugurl=https://gitlab.archlinux.org/archlinux/packaging/packages/gcc/-/issues --with-build-config=bootstrap-lto --with-linker-hash-style=gnu --with-system-zlib --enable-__cxa_atexit --enable-cet=auto --enable-checking=release --enable-clocale=gnu --enable-default-pie --enable-default-ssp --enable-gnu-indirect-function --enable-gnu-unique-object --enable-libstdcxx-backtrace --enable-link-serialization=1 --enable-linker-build-id --enable-lto --enable-multilib --enable-plugin --enable-shared --enable-threads=posix --disable-libssp --disable-libstdcxx-pch --disable-werror - Thread model: posix - Supported LTO compression algorithms: zlib zstd - gcc version 14.2.1 20240805 (GCC) - COMPILER_PATH=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/ - LIBRARY_PATH=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/:/lib/../lib/:/usr/lib/../lib/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../:/lib/:/usr/lib/ - COLLECT_GCC_OPTIONS='-v' '-o' 'cmTC_432b1' '-mtune=generic' '-march=x86-64' '-dumpdir' 'cmTC_432b1.' - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/collect2 -plugin /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/liblto_plugin.so -plugin-opt=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/lto-wrapper -plugin-opt=-fresolution=/tmp/cc1nvUah.res -plugin-opt=-pass-through=-lgcc -plugin-opt=-pass-through=-lgcc_s -plugin-opt=-pass-through=-lc -plugin-opt=-pass-through=-lgcc -plugin-opt=-pass-through=-lgcc_s --build-id --eh-frame-hdr --hash-style=gnu -m elf_x86_64 -dynamic-linker /lib64/ld-linux-x86-64.so.2 -pie -o cmTC_432b1 /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/Scrt1.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crti.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtbeginS.o -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1 -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib -L/lib/../lib -L/usr/lib/../lib -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../.. -v CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o -lgcc --push-state --as-needed -lgcc_s --pop-state -lc -lgcc --push-state --as-needed -lgcc_s --pop-state /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtendS.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crtn.o - collect2 version 14.2.1 20240805 - /usr/bin/ld -plugin /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/liblto_plugin.so -plugin-opt=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/lto-wrapper -plugin-opt=-fresolution=/tmp/cc1nvUah.res -plugin-opt=-pass-through=-lgcc -plugin-opt=-pass-through=-lgcc_s -plugin-opt=-pass-through=-lc -plugin-opt=-pass-through=-lgcc -plugin-opt=-pass-through=-lgcc_s --build-id --eh-frame-hdr --hash-style=gnu -m elf_x86_64 -dynamic-linker /lib64/ld-linux-x86-64.so.2 -pie -o cmTC_432b1 /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/Scrt1.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crti.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtbeginS.o -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1 -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib -L/lib/../lib -L/usr/lib/../lib -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../.. -v CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o -lgcc --push-state --as-needed -lgcc_s --pop-state -lc -lgcc --push-state --as-needed -lgcc_s --pop-state /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtendS.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crtn.o - GNU ld (GNU Binutils) 2.43.0 - COLLECT_GCC_OPTIONS='-v' '-o' 'cmTC_432b1' '-mtune=generic' '-march=x86-64' '-dumpdir' 'cmTC_432b1.' - make[1]: Leaving directory '/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeScratch/TryCompile-OqXOtR' - - exitCode: 0 - - - kind: "message-v1" - backtrace: - - "/usr/share/cmake/Modules/CMakeDetermineCompilerABI.cmake:182 (message)" - - "/usr/share/cmake/Modules/CMakeTestCCompiler.cmake:26 (CMAKE_DETERMINE_COMPILER_ABI)" - - "CMakeLists.txt:4 (project)" - message: | - Parsed C implicit include dir info: rv=done - found start of include info - found start of implicit include info - add: [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include] - add: [/usr/local/include] - add: [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include-fixed] - add: [/usr/include] - end of search list found - collapse include dir [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include] ==> [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include] - collapse include dir [/usr/local/include] ==> [/usr/local/include] - collapse include dir [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include-fixed] ==> [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include-fixed] - collapse include dir [/usr/include] ==> [/usr/include] - implicit include dirs: [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include;/usr/local/include;/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include-fixed;/usr/include] - - - - - kind: "message-v1" - backtrace: - - "/usr/share/cmake/Modules/CMakeDetermineCompilerABI.cmake:218 (message)" - - "/usr/share/cmake/Modules/CMakeTestCCompiler.cmake:26 (CMAKE_DETERMINE_COMPILER_ABI)" - - "CMakeLists.txt:4 (project)" - message: | - Parsed C implicit link information: - link line regex: [^( *|.*[/\\])(ld[0-9]*(\\.[a-z]+)?|CMAKE_LINK_STARTFILE-NOTFOUND|([^/\\]+-)?ld|collect2)[^/\\]*( |$)] - linker tool regex: [^[ ]*(->|")?[ ]*(([^"]*[/\\])?(ld[0-9]*(\\.[a-z]+)?))("|,| |$)] - ignore line: [Change Dir: '/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeScratch/TryCompile-OqXOtR'] - ignore line: [] - ignore line: [Run Build Command(s): /usr/bin/cmake -E env VERBOSE=1 /usr/bin/make -f Makefile cmTC_432b1/fast] - ignore line: [/usr/bin/make -f CMakeFiles/cmTC_432b1.dir/build.make CMakeFiles/cmTC_432b1.dir/build] - ignore line: [make[1]: Entering directory '/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeScratch/TryCompile-OqXOtR'] - ignore line: [Building C object CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o] - ignore line: [/usr/bin/cc -v -o CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o -c /usr/share/cmake/Modules/CMakeCCompilerABI.c] - ignore line: [Using built-in specs.] - ignore line: [COLLECT_GCC=/usr/bin/cc] - ignore line: [Target: x86_64-pc-linux-gnu] - ignore line: [Configured with: /build/gcc/src/gcc/configure --enable-languages=ada c c++ d fortran go lto m2 objc obj-c++ rust --enable-bootstrap --prefix=/usr --libdir=/usr/lib --libexecdir=/usr/lib --mandir=/usr/share/man --infodir=/usr/share/info --with-bugurl=https://gitlab.archlinux.org/archlinux/packaging/packages/gcc/-/issues --with-build-config=bootstrap-lto --with-linker-hash-style=gnu --with-system-zlib --enable-__cxa_atexit --enable-cet=auto --enable-checking=release --enable-clocale=gnu --enable-default-pie --enable-default-ssp --enable-gnu-indirect-function --enable-gnu-unique-object --enable-libstdcxx-backtrace --enable-link-serialization=1 --enable-linker-build-id --enable-lto --enable-multilib --enable-plugin --enable-shared --enable-threads=posix --disable-libssp --disable-libstdcxx-pch --disable-werror] - ignore line: [Thread model: posix] - ignore line: [Supported LTO compression algorithms: zlib zstd] - ignore line: [gcc version 14.2.1 20240805 (GCC) ] - ignore line: [COLLECT_GCC_OPTIONS='-v' '-o' 'CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o' '-c' '-mtune=generic' '-march=x86-64' '-dumpdir' 'CMakeFiles/cmTC_432b1.dir/'] - ignore line: [ /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/cc1 -quiet -v /usr/share/cmake/Modules/CMakeCCompilerABI.c -quiet -dumpdir CMakeFiles/cmTC_432b1.dir/ -dumpbase CMakeCCompilerABI.c.c -dumpbase-ext .c -mtune=generic -march=x86-64 -version -o /tmp/ccKaHqEO.s] - ignore line: [GNU C17 (GCC) version 14.2.1 20240805 (x86_64-pc-linux-gnu)] - ignore line: [ compiled by GNU C version 14.2.1 20240805 GMP version 6.3.0 MPFR version 4.2.1 MPC version 1.3.1 isl version isl-0.27-GMP] - ignore line: [] - ignore line: [GGC heuristics: --param ggc-min-expand=100 --param ggc-min-heapsize=131072] - ignore line: [ignoring nonexistent directory "/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../x86_64-pc-linux-gnu/include"] - ignore line: [#include "..." search starts here:] - ignore line: [#include <...> search starts here:] - ignore line: [ /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include] - ignore line: [ /usr/local/include] - ignore line: [ /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include-fixed] - ignore line: [ /usr/include] - ignore line: [End of search list.] - ignore line: [Compiler executable checksum: faa3163d33b78b77071c76eebeab3034] - ignore line: [COLLECT_GCC_OPTIONS='-v' '-o' 'CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o' '-c' '-mtune=generic' '-march=x86-64' '-dumpdir' 'CMakeFiles/cmTC_432b1.dir/'] - ignore line: [ as -v --64 -o CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o /tmp/ccKaHqEO.s] - ignore line: [GNU assembler version 2.43.0 (x86_64-pc-linux-gnu) using BFD version (GNU Binutils) 2.43.0] - ignore line: [COMPILER_PATH=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/] - ignore line: [LIBRARY_PATH=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/:/lib/../lib/:/usr/lib/../lib/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../:/lib/:/usr/lib/] - ignore line: [COLLECT_GCC_OPTIONS='-v' '-o' 'CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o' '-c' '-mtune=generic' '-march=x86-64' '-dumpdir' 'CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.'] - ignore line: [Linking C executable cmTC_432b1] - ignore line: [/usr/bin/cmake -E cmake_link_script CMakeFiles/cmTC_432b1.dir/link.txt --verbose=1] - ignore line: [/usr/bin/cc -v -Wl -v CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o -o cmTC_432b1] - ignore line: [Using built-in specs.] - ignore line: [COLLECT_GCC=/usr/bin/cc] - ignore line: [COLLECT_LTO_WRAPPER=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/lto-wrapper] - ignore line: [Target: x86_64-pc-linux-gnu] - ignore line: [Configured with: /build/gcc/src/gcc/configure --enable-languages=ada c c++ d fortran go lto m2 objc obj-c++ rust --enable-bootstrap --prefix=/usr --libdir=/usr/lib --libexecdir=/usr/lib --mandir=/usr/share/man --infodir=/usr/share/info --with-bugurl=https://gitlab.archlinux.org/archlinux/packaging/packages/gcc/-/issues --with-build-config=bootstrap-lto --with-linker-hash-style=gnu --with-system-zlib --enable-__cxa_atexit --enable-cet=auto --enable-checking=release --enable-clocale=gnu --enable-default-pie --enable-default-ssp --enable-gnu-indirect-function --enable-gnu-unique-object --enable-libstdcxx-backtrace --enable-link-serialization=1 --enable-linker-build-id --enable-lto --enable-multilib --enable-plugin --enable-shared --enable-threads=posix --disable-libssp --disable-libstdcxx-pch --disable-werror] - ignore line: [Thread model: posix] - ignore line: [Supported LTO compression algorithms: zlib zstd] - ignore line: [gcc version 14.2.1 20240805 (GCC) ] - ignore line: [COMPILER_PATH=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/] - ignore line: [LIBRARY_PATH=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/:/lib/../lib/:/usr/lib/../lib/:/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../:/lib/:/usr/lib/] - ignore line: [COLLECT_GCC_OPTIONS='-v' '-o' 'cmTC_432b1' '-mtune=generic' '-march=x86-64' '-dumpdir' 'cmTC_432b1.'] - link line: [ /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/collect2 -plugin /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/liblto_plugin.so -plugin-opt=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/lto-wrapper -plugin-opt=-fresolution=/tmp/cc1nvUah.res -plugin-opt=-pass-through=-lgcc -plugin-opt=-pass-through=-lgcc_s -plugin-opt=-pass-through=-lc -plugin-opt=-pass-through=-lgcc -plugin-opt=-pass-through=-lgcc_s --build-id --eh-frame-hdr --hash-style=gnu -m elf_x86_64 -dynamic-linker /lib64/ld-linux-x86-64.so.2 -pie -o cmTC_432b1 /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/Scrt1.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crti.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtbeginS.o -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1 -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib -L/lib/../lib -L/usr/lib/../lib -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../.. -v CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o -lgcc --push-state --as-needed -lgcc_s --pop-state -lc -lgcc --push-state --as-needed -lgcc_s --pop-state /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtendS.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crtn.o] - arg [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/collect2] ==> ignore - arg [-plugin] ==> ignore - arg [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/liblto_plugin.so] ==> ignore - arg [-plugin-opt=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/lto-wrapper] ==> ignore - arg [-plugin-opt=-fresolution=/tmp/cc1nvUah.res] ==> ignore - arg [-plugin-opt=-pass-through=-lgcc] ==> ignore - arg [-plugin-opt=-pass-through=-lgcc_s] ==> ignore - arg [-plugin-opt=-pass-through=-lc] ==> ignore - arg [-plugin-opt=-pass-through=-lgcc] ==> ignore - arg [-plugin-opt=-pass-through=-lgcc_s] ==> ignore - arg [--build-id] ==> ignore - arg [--eh-frame-hdr] ==> ignore - arg [--hash-style=gnu] ==> ignore - arg [-m] ==> ignore - arg [elf_x86_64] ==> ignore - arg [-dynamic-linker] ==> ignore - arg [/lib64/ld-linux-x86-64.so.2] ==> ignore - arg [-pie] ==> ignore - arg [-o] ==> ignore - arg [cmTC_432b1] ==> ignore - arg [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/Scrt1.o] ==> obj [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/Scrt1.o] - arg [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crti.o] ==> obj [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crti.o] - arg [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtbeginS.o] ==> obj [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtbeginS.o] - arg [-L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1] ==> dir [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1] - arg [-L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib] ==> dir [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib] - arg [-L/lib/../lib] ==> dir [/lib/../lib] - arg [-L/usr/lib/../lib] ==> dir [/usr/lib/../lib] - arg [-L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../..] ==> dir [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../..] - arg [-v] ==> ignore - arg [CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o] ==> ignore - arg [-lgcc] ==> lib [gcc] - arg [--push-state] ==> ignore - arg [--as-needed] ==> ignore - arg [-lgcc_s] ==> lib [gcc_s] - arg [--pop-state] ==> ignore - arg [-lc] ==> lib [c] - arg [-lgcc] ==> lib [gcc] - arg [--push-state] ==> ignore - arg [--as-needed] ==> ignore - arg [-lgcc_s] ==> lib [gcc_s] - arg [--pop-state] ==> ignore - arg [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtendS.o] ==> obj [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtendS.o] - arg [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crtn.o] ==> obj [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crtn.o] - ignore line: [collect2 version 14.2.1 20240805] - ignore line: [/usr/bin/ld -plugin /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/liblto_plugin.so -plugin-opt=/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/lto-wrapper -plugin-opt=-fresolution=/tmp/cc1nvUah.res -plugin-opt=-pass-through=-lgcc -plugin-opt=-pass-through=-lgcc_s -plugin-opt=-pass-through=-lc -plugin-opt=-pass-through=-lgcc -plugin-opt=-pass-through=-lgcc_s --build-id --eh-frame-hdr --hash-style=gnu -m elf_x86_64 -dynamic-linker /lib64/ld-linux-x86-64.so.2 -pie -o cmTC_432b1 /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/Scrt1.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crti.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtbeginS.o -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1 -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib -L/lib/../lib -L/usr/lib/../lib -L/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../.. -v CMakeFiles/cmTC_432b1.dir/CMakeCCompilerABI.c.o -lgcc --push-state --as-needed -lgcc_s --pop-state -lc -lgcc --push-state --as-needed -lgcc_s --pop-state /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtendS.o /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crtn.o] - linker tool for 'C': /usr/bin/ld - collapse obj [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/Scrt1.o] ==> [/usr/lib/Scrt1.o] - collapse obj [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crti.o] ==> [/usr/lib/crti.o] - collapse obj [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib/crtn.o] ==> [/usr/lib/crtn.o] - collapse library dir [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1] ==> [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1] - collapse library dir [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../../../lib] ==> [/usr/lib] - collapse library dir [/lib/../lib] ==> [/lib] - collapse library dir [/usr/lib/../lib] ==> [/usr/lib] - collapse library dir [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/../../..] ==> [/usr/lib] - implicit libs: [gcc;gcc_s;c;gcc;gcc_s] - implicit objs: [/usr/lib/Scrt1.o;/usr/lib/crti.o;/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtbeginS.o;/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/crtendS.o;/usr/lib/crtn.o] - implicit dirs: [/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1;/usr/lib;/lib] - implicit fwks: [] - - - - - kind: "message-v1" - backtrace: - - "/usr/share/cmake/Modules/Internal/CMakeDetermineLinkerId.cmake:40 (message)" - - "/usr/share/cmake/Modules/CMakeDetermineCompilerABI.cmake:255 (cmake_determine_linker_id)" - - "/usr/share/cmake/Modules/CMakeTestCCompiler.cmake:26 (CMAKE_DETERMINE_COMPILER_ABI)" - - "CMakeLists.txt:4 (project)" - message: | - Running the C compiler's linker: "/usr/bin/ld" "-v" - GNU ld (GNU Binutils) 2.43.0 -... diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeDirectoryInformation.cmake b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeDirectoryInformation.cmake @@ -1,16 +0,0 @@ -# CMAKE generated file: DO NOT EDIT! -# Generated by "Unix Makefiles" Generator, CMake Version 3.30 - -# Relative path conversion top directories. -set(CMAKE_RELATIVE_PATH_TOP_SOURCE "/home/dwrz/.config/emacs/elpa/vterm-20240825.133") -set(CMAKE_RELATIVE_PATH_TOP_BINARY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build") - -# Force unix paths in dependencies. -set(CMAKE_FORCE_UNIX_PATHS 1) - - -# The C and CXX include file regular expressions for this directory. -set(CMAKE_C_INCLUDE_REGEX_SCAN "^.*$") -set(CMAKE_C_INCLUDE_REGEX_COMPLAIN "^$") -set(CMAKE_CXX_INCLUDE_REGEX_SCAN ${CMAKE_C_INCLUDE_REGEX_SCAN}) -set(CMAKE_CXX_INCLUDE_REGEX_COMPLAIN ${CMAKE_C_INCLUDE_REGEX_COMPLAIN}) diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeRuleHashes.txt b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/CMakeRuleHashes.txt @@ -1,11 +0,0 @@ -# Hashes of file build rules. -a3cbceca253066e4139eed12a67fddca CMakeFiles/libvterm -2d5cbdd97578af400f8105ef96e34c1a CMakeFiles/libvterm-complete -34c0d328971ef7c3bc40d682abaea31a CMakeFiles/run -53c618ef134d5e537ccc3cf1f5263b62 libvterm-prefix/src/libvterm-stamp/libvterm-build -8edb222a34594cdce454a742b8ecb54c libvterm-prefix/src/libvterm-stamp/libvterm-configure -871241aff9b5adc6a5cf76d55d066638 libvterm-prefix/src/libvterm-stamp/libvterm-download -34cd981c05a47cbedba3ee0c815c4f1f libvterm-prefix/src/libvterm-stamp/libvterm-install -adc8f492d78180348d5a2ad28a658498 libvterm-prefix/src/libvterm-stamp/libvterm-mkdir -70cd044166f970d4fea8a61a6740b719 libvterm-prefix/src/libvterm-stamp/libvterm-patch -a3cebb62a33475065ca1394bcf6e28b6 libvterm-prefix/src/libvterm-stamp/libvterm-update diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/Makefile.cmake b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/Makefile.cmake @@ -1,130 +0,0 @@ -# CMAKE generated file: DO NOT EDIT! -# Generated by "Unix Makefiles" Generator, CMake Version 3.30 - -# The generator used is: -set(CMAKE_DEPENDS_GENERATOR "Unix Makefiles") - -# The top level Makefile was generated from the following files: -set(CMAKE_MAKEFILE_DEPENDS - "CMakeCache.txt" - "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/CMakeLists.txt" - "CMakeFiles/3.30.3/CMakeCCompiler.cmake" - "CMakeFiles/3.30.3/CMakeSystem.cmake" - "libvterm-prefix/tmp/libvterm-mkdirs.cmake" - "/usr/share/cmake/Modules/CMakeCCompiler.cmake.in" - "/usr/share/cmake/Modules/CMakeCCompilerABI.c" - "/usr/share/cmake/Modules/CMakeCInformation.cmake" - "/usr/share/cmake/Modules/CMakeCommonLanguageInclude.cmake" - "/usr/share/cmake/Modules/CMakeCompilerIdDetection.cmake" - "/usr/share/cmake/Modules/CMakeDetermineCCompiler.cmake" - "/usr/share/cmake/Modules/CMakeDetermineCompiler.cmake" - "/usr/share/cmake/Modules/CMakeDetermineCompilerABI.cmake" - "/usr/share/cmake/Modules/CMakeDetermineCompilerId.cmake" - "/usr/share/cmake/Modules/CMakeDetermineCompilerSupport.cmake" - "/usr/share/cmake/Modules/CMakeDetermineSystem.cmake" - "/usr/share/cmake/Modules/CMakeFindBinUtils.cmake" - "/usr/share/cmake/Modules/CMakeGenericSystem.cmake" - "/usr/share/cmake/Modules/CMakeInitializeConfigs.cmake" - "/usr/share/cmake/Modules/CMakeLanguageInformation.cmake" - "/usr/share/cmake/Modules/CMakeParseImplicitIncludeInfo.cmake" - "/usr/share/cmake/Modules/CMakeParseImplicitLinkInfo.cmake" - "/usr/share/cmake/Modules/CMakeParseLibraryArchitecture.cmake" - "/usr/share/cmake/Modules/CMakeSystem.cmake.in" - "/usr/share/cmake/Modules/CMakeSystemSpecificInformation.cmake" - "/usr/share/cmake/Modules/CMakeSystemSpecificInitialize.cmake" - "/usr/share/cmake/Modules/CMakeTestCCompiler.cmake" - "/usr/share/cmake/Modules/CMakeTestCompilerCommon.cmake" - "/usr/share/cmake/Modules/Compiler/ADSP-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/ARMCC-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/ARMClang-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/AppleClang-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/Borland-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/Bruce-C-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/CMakeCommonCompilerMacros.cmake" - "/usr/share/cmake/Modules/Compiler/Clang-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/Clang-DetermineCompilerInternal.cmake" - "/usr/share/cmake/Modules/Compiler/Compaq-C-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/Cray-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/CrayClang-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/Embarcadero-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/Fujitsu-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/FujitsuClang-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/GHS-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/GNU-C-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/GNU-C.cmake" - "/usr/share/cmake/Modules/Compiler/GNU-FindBinUtils.cmake" - "/usr/share/cmake/Modules/Compiler/GNU.cmake" - "/usr/share/cmake/Modules/Compiler/HP-C-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/IAR-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/IBMCPP-C-DetermineVersionInternal.cmake" - "/usr/share/cmake/Modules/Compiler/IBMClang-C-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/Intel-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/IntelLLVM-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/LCC-C-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/MSVC-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/NVHPC-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/NVIDIA-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/OpenWatcom-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/OrangeC-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/PGI-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/PathScale-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/SCO-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/SDCC-C-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/SunPro-C-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/TI-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/TIClang-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/Tasking-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/TinyCC-C-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/VisualAge-C-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/Watcom-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/XL-C-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/XLClang-C-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/Compiler/zOS-C-DetermineCompiler.cmake" - "/usr/share/cmake/Modules/ExternalProject.cmake" - "/usr/share/cmake/Modules/ExternalProject/PatchInfo.txt.in" - "/usr/share/cmake/Modules/ExternalProject/RepositoryInfo.txt.in" - "/usr/share/cmake/Modules/ExternalProject/UpdateInfo.txt.in" - "/usr/share/cmake/Modules/ExternalProject/cfgcmd.txt.in" - "/usr/share/cmake/Modules/ExternalProject/gitclone.cmake.in" - "/usr/share/cmake/Modules/ExternalProject/gitupdate.cmake.in" - "/usr/share/cmake/Modules/ExternalProject/mkdirs.cmake.in" - "/usr/share/cmake/Modules/ExternalProject/shared_internal_commands.cmake" - "/usr/share/cmake/Modules/FindGit.cmake" - "/usr/share/cmake/Modules/FindPackageHandleStandardArgs.cmake" - "/usr/share/cmake/Modules/FindPackageMessage.cmake" - "/usr/share/cmake/Modules/Internal/CMakeDetermineLinkerId.cmake" - "/usr/share/cmake/Modules/Internal/FeatureTesting.cmake" - "/usr/share/cmake/Modules/Platform/Linux-GNU-C.cmake" - "/usr/share/cmake/Modules/Platform/Linux-GNU.cmake" - "/usr/share/cmake/Modules/Platform/Linux-Initialize.cmake" - "/usr/share/cmake/Modules/Platform/Linux.cmake" - "/usr/share/cmake/Modules/Platform/UnixPaths.cmake" - ) - -# The corresponding makefile is: -set(CMAKE_MAKEFILE_OUTPUTS - "Makefile" - "CMakeFiles/cmake.check_cache" - ) - -# Byproducts of CMake generate step: -set(CMAKE_MAKEFILE_PRODUCTS - "CMakeFiles/3.30.3/CMakeSystem.cmake" - "CMakeFiles/3.30.3/CMakeCCompiler.cmake" - "CMakeFiles/3.30.3/CMakeCCompiler.cmake" - "libvterm-prefix/tmp/libvterm-mkdirs.cmake" - "libvterm-prefix/tmp/libvterm-gitclone.cmake" - "libvterm-prefix/src/libvterm-stamp/libvterm-gitinfo.txt" - "libvterm-prefix/tmp/libvterm-gitupdate.cmake" - "libvterm-prefix/src/libvterm-stamp/libvterm-update-info.txt" - "libvterm-prefix/src/libvterm-stamp/libvterm-patch-info.txt" - "libvterm-prefix/tmp/libvterm-cfgcmd.txt" - "CMakeFiles/CMakeDirectoryInformation.cmake" - ) - -# Dependency information for all targets: -set(CMAKE_DEPEND_INFO_FILES - "CMakeFiles/vterm-module.dir/DependInfo.cmake" - "CMakeFiles/libvterm.dir/DependInfo.cmake" - "CMakeFiles/run.dir/DependInfo.cmake" - ) diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/Makefile2 b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/Makefile2 @@ -1,167 +0,0 @@ -# CMAKE generated file: DO NOT EDIT! -# Generated by "Unix Makefiles" Generator, CMake Version 3.30 - -# Default target executed when no arguments are given to make. -default_target: all -.PHONY : default_target - -#============================================================================= -# Special targets provided by cmake. - -# Disable implicit rules so canonical targets will work. -.SUFFIXES: - -# Disable VCS-based implicit rules. -% : %,v - -# Disable VCS-based implicit rules. -% : RCS/% - -# Disable VCS-based implicit rules. -% : RCS/%,v - -# Disable VCS-based implicit rules. -% : SCCS/s.% - -# Disable VCS-based implicit rules. -% : s.% - -.SUFFIXES: .hpux_make_needs_suffix_list - -# Command-line flag to silence nested $(MAKE). -$(VERBOSE)MAKESILENT = -s - -#Suppress display of executed commands. -$(VERBOSE).SILENT: - -# A target that is always out of date. -cmake_force: -.PHONY : cmake_force - -#============================================================================= -# Set environment variables for the build. - -# The shell in which to execute make rules. -SHELL = /bin/sh - -# The CMake executable. -CMAKE_COMMAND = /usr/bin/cmake - -# The command to remove a file. -RM = /usr/bin/cmake -E rm -f - -# Escaping for special characters. -EQUALS = = - -# The top-level source directory on which CMake was run. -CMAKE_SOURCE_DIR = /home/dwrz/.config/emacs/elpa/vterm-20240825.133 - -# The top-level build directory on which CMake was run. -CMAKE_BINARY_DIR = /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build - -#============================================================================= -# Directory level rules for the build root directory - -# The main recursive "all" target. -all: CMakeFiles/vterm-module.dir/all -all: CMakeFiles/libvterm.dir/all -.PHONY : all - -# The main recursive "preinstall" target. -preinstall: -.PHONY : preinstall - -# The main recursive "clean" target. -clean: CMakeFiles/vterm-module.dir/clean -clean: CMakeFiles/libvterm.dir/clean -clean: CMakeFiles/run.dir/clean -.PHONY : clean - -#============================================================================= -# Target rules for target CMakeFiles/vterm-module.dir - -# All Build rule for target. -CMakeFiles/vterm-module.dir/all: CMakeFiles/libvterm.dir/all - $(MAKE) $(MAKESILENT) -f CMakeFiles/vterm-module.dir/build.make CMakeFiles/vterm-module.dir/depend - $(MAKE) $(MAKESILENT) -f CMakeFiles/vterm-module.dir/build.make CMakeFiles/vterm-module.dir/build - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --progress-dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles --progress-num=9,10,11,12 "Built target vterm-module" -.PHONY : CMakeFiles/vterm-module.dir/all - -# Build rule for subdir invocation for target. -CMakeFiles/vterm-module.dir/rule: cmake_check_build_system - $(CMAKE_COMMAND) -E cmake_progress_start /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles 12 - $(MAKE) $(MAKESILENT) -f CMakeFiles/Makefile2 CMakeFiles/vterm-module.dir/all - $(CMAKE_COMMAND) -E cmake_progress_start /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles 0 -.PHONY : CMakeFiles/vterm-module.dir/rule - -# Convenience name for target. -vterm-module: CMakeFiles/vterm-module.dir/rule -.PHONY : vterm-module - -# clean rule for target. -CMakeFiles/vterm-module.dir/clean: - $(MAKE) $(MAKESILENT) -f CMakeFiles/vterm-module.dir/build.make CMakeFiles/vterm-module.dir/clean -.PHONY : CMakeFiles/vterm-module.dir/clean - -#============================================================================= -# Target rules for target CMakeFiles/libvterm.dir - -# All Build rule for target. -CMakeFiles/libvterm.dir/all: - $(MAKE) $(MAKESILENT) -f CMakeFiles/libvterm.dir/build.make CMakeFiles/libvterm.dir/depend - $(MAKE) $(MAKESILENT) -f CMakeFiles/libvterm.dir/build.make CMakeFiles/libvterm.dir/build - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --progress-dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles --progress-num=1,2,3,4,5,6,7,8 "Built target libvterm" -.PHONY : CMakeFiles/libvterm.dir/all - -# Build rule for subdir invocation for target. -CMakeFiles/libvterm.dir/rule: cmake_check_build_system - $(CMAKE_COMMAND) -E cmake_progress_start /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles 8 - $(MAKE) $(MAKESILENT) -f CMakeFiles/Makefile2 CMakeFiles/libvterm.dir/all - $(CMAKE_COMMAND) -E cmake_progress_start /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles 0 -.PHONY : CMakeFiles/libvterm.dir/rule - -# Convenience name for target. -libvterm: CMakeFiles/libvterm.dir/rule -.PHONY : libvterm - -# clean rule for target. -CMakeFiles/libvterm.dir/clean: - $(MAKE) $(MAKESILENT) -f CMakeFiles/libvterm.dir/build.make CMakeFiles/libvterm.dir/clean -.PHONY : CMakeFiles/libvterm.dir/clean - -#============================================================================= -# Target rules for target CMakeFiles/run.dir - -# All Build rule for target. -CMakeFiles/run.dir/all: CMakeFiles/vterm-module.dir/all - $(MAKE) $(MAKESILENT) -f CMakeFiles/run.dir/build.make CMakeFiles/run.dir/depend - $(MAKE) $(MAKESILENT) -f CMakeFiles/run.dir/build.make CMakeFiles/run.dir/build - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --progress-dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles --progress-num= "Built target run" -.PHONY : CMakeFiles/run.dir/all - -# Build rule for subdir invocation for target. -CMakeFiles/run.dir/rule: cmake_check_build_system - $(CMAKE_COMMAND) -E cmake_progress_start /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles 12 - $(MAKE) $(MAKESILENT) -f CMakeFiles/Makefile2 CMakeFiles/run.dir/all - $(CMAKE_COMMAND) -E cmake_progress_start /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles 0 -.PHONY : CMakeFiles/run.dir/rule - -# Convenience name for target. -run: CMakeFiles/run.dir/rule -.PHONY : run - -# clean rule for target. -CMakeFiles/run.dir/clean: - $(MAKE) $(MAKESILENT) -f CMakeFiles/run.dir/build.make CMakeFiles/run.dir/clean -.PHONY : CMakeFiles/run.dir/clean - -#============================================================================= -# Special targets to cleanup operation of make. - -# Special rule to run CMake to check the build system integrity. -# No rule that depends on this can have commands that come from listfiles -# because they might be regenerated. -cmake_check_build_system: - $(CMAKE_COMMAND) -S$(CMAKE_SOURCE_DIR) -B$(CMAKE_BINARY_DIR) --check-build-system CMakeFiles/Makefile.cmake 0 -.PHONY : cmake_check_build_system - diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/TargetDirectories.txt b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/TargetDirectories.txt @@ -1,5 +0,0 @@ -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/run.dir -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/edit_cache.dir -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/rebuild_cache.dir diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/cmake.check_cache b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/cmake.check_cache @@ -1 +0,0 @@ -# This file is generated by cmake for dependency checking of the CMakeCache.txt file diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm-complete b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm-complete diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir/DependInfo.cmake b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir/DependInfo.cmake @@ -1,22 +0,0 @@ - -# Consider dependencies only in project. -set(CMAKE_DEPENDS_IN_PROJECT_ONLY OFF) - -# The set of languages for which implicit dependencies are needed: -set(CMAKE_DEPENDS_LANGUAGES - ) - -# The set of dependency files which are needed: -set(CMAKE_DEPENDS_DEPENDENCY_FILES - ) - -# Targets to which this target links which contain Fortran sources. -set(CMAKE_Fortran_TARGET_LINKED_INFO_FILES - ) - -# Targets to which this target links which contain Fortran sources. -set(CMAKE_Fortran_TARGET_FORWARD_LINKED_INFO_FILES - ) - -# Fortran module output directory. -set(CMAKE_Fortran_TARGET_MODULE_DIR "") diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir/Labels.json b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir/Labels.json @@ -1,43 +0,0 @@ -{ - "sources" : - [ - { - "file" : "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm" - }, - { - "file" : "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.rule" - }, - { - "file" : "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm-complete.rule" - }, - { - "file" : "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-build.rule" - }, - { - "file" : "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-configure.rule" - }, - { - "file" : "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-download.rule" - }, - { - "file" : "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-install.rule" - }, - { - "file" : "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-mkdir.rule" - }, - { - "file" : "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-patch.rule" - }, - { - "file" : "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-update.rule" - } - ], - "target" : - { - "labels" : - [ - "libvterm" - ], - "name" : "libvterm" - } -} -\ No newline at end of file diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir/Labels.txt b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir/Labels.txt @@ -1,13 +0,0 @@ -# Target labels - libvterm -# Source files and their labels -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.rule -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm-complete.rule -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-build.rule -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-configure.rule -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-download.rule -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-install.rule -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-mkdir.rule -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-patch.rule -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-update.rule diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir/build.make b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir/build.make @@ -1,146 +0,0 @@ -# CMAKE generated file: DO NOT EDIT! -# Generated by "Unix Makefiles" Generator, CMake Version 3.30 - -# Delete rule output on recipe failure. -.DELETE_ON_ERROR: - -#============================================================================= -# Special targets provided by cmake. - -# Disable implicit rules so canonical targets will work. -.SUFFIXES: - -# Disable VCS-based implicit rules. -% : %,v - -# Disable VCS-based implicit rules. -% : RCS/% - -# Disable VCS-based implicit rules. -% : RCS/%,v - -# Disable VCS-based implicit rules. -% : SCCS/s.% - -# Disable VCS-based implicit rules. -% : s.% - -.SUFFIXES: .hpux_make_needs_suffix_list - -# Command-line flag to silence nested $(MAKE). -$(VERBOSE)MAKESILENT = -s - -#Suppress display of executed commands. -$(VERBOSE).SILENT: - -# A target that is always out of date. -cmake_force: -.PHONY : cmake_force - -#============================================================================= -# Set environment variables for the build. - -# The shell in which to execute make rules. -SHELL = /bin/sh - -# The CMake executable. -CMAKE_COMMAND = /usr/bin/cmake - -# The command to remove a file. -RM = /usr/bin/cmake -E rm -f - -# Escaping for special characters. -EQUALS = = - -# The top-level source directory on which CMake was run. -CMAKE_SOURCE_DIR = /home/dwrz/.config/emacs/elpa/vterm-20240825.133 - -# The top-level build directory on which CMake was run. -CMAKE_BINARY_DIR = /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build - -# Utility rule file for libvterm. - -# Include any custom commands dependencies for this target. -include CMakeFiles/libvterm.dir/compiler_depend.make - -# Include the progress variables for this target. -include CMakeFiles/libvterm.dir/progress.make - -CMakeFiles/libvterm: CMakeFiles/libvterm-complete - -CMakeFiles/libvterm-complete: libvterm-prefix/src/libvterm-stamp/libvterm-install -CMakeFiles/libvterm-complete: libvterm-prefix/src/libvterm-stamp/libvterm-mkdir -CMakeFiles/libvterm-complete: libvterm-prefix/src/libvterm-stamp/libvterm-download -CMakeFiles/libvterm-complete: libvterm-prefix/src/libvterm-stamp/libvterm-update -CMakeFiles/libvterm-complete: libvterm-prefix/src/libvterm-stamp/libvterm-patch -CMakeFiles/libvterm-complete: libvterm-prefix/src/libvterm-stamp/libvterm-configure -CMakeFiles/libvterm-complete: libvterm-prefix/src/libvterm-stamp/libvterm-build -CMakeFiles/libvterm-complete: libvterm-prefix/src/libvterm-stamp/libvterm-install - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --blue --bold --progress-dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles --progress-num=$(CMAKE_PROGRESS_1) "Completed 'libvterm'" - /usr/bin/cmake -E make_directory /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles - /usr/bin/cmake -E touch /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm-complete - /usr/bin/cmake -E touch /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-done - -libvterm-prefix/src/libvterm-stamp/libvterm-build: libvterm-prefix/src/libvterm-stamp/libvterm-configure - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --blue --bold --progress-dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles --progress-num=$(CMAKE_PROGRESS_2) "Performing build step for 'libvterm'" - cd /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm && make "CFLAGS='-fPIC'" "LDFLAGS='-static'" - cd /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm && /usr/bin/cmake -E touch /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-build - -libvterm-prefix/src/libvterm-stamp/libvterm-configure: libvterm-prefix/tmp/libvterm-cfgcmd.txt -libvterm-prefix/src/libvterm-stamp/libvterm-configure: libvterm-prefix/src/libvterm-stamp/libvterm-patch - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --blue --bold --progress-dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles --progress-num=$(CMAKE_PROGRESS_3) "No configure step for 'libvterm'" - cd /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm && /usr/bin/cmake -E echo_append - cd /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm && /usr/bin/cmake -E touch /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-configure - -libvterm-prefix/src/libvterm-stamp/libvterm-download: libvterm-prefix/src/libvterm-stamp/libvterm-gitinfo.txt -libvterm-prefix/src/libvterm-stamp/libvterm-download: libvterm-prefix/src/libvterm-stamp/libvterm-mkdir - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --blue --bold --progress-dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles --progress-num=$(CMAKE_PROGRESS_4) "Performing download step (git clone) for 'libvterm'" - cd /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src && /usr/bin/cmake -DCMAKE_MESSAGE_LOG_LEVEL=VERBOSE -P /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/tmp/libvterm-gitclone.cmake - cd /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src && /usr/bin/cmake -E touch /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-download - -libvterm-prefix/src/libvterm-stamp/libvterm-install: libvterm-prefix/src/libvterm-stamp/libvterm-build - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --blue --bold --progress-dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles --progress-num=$(CMAKE_PROGRESS_5) "No install step for 'libvterm'" - cd /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm && /usr/bin/cmake -E echo_append - cd /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm && /usr/bin/cmake -E touch /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-install - -libvterm-prefix/src/libvterm-stamp/libvterm-mkdir: - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --blue --bold --progress-dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles --progress-num=$(CMAKE_PROGRESS_6) "Creating directories for 'libvterm'" - /usr/bin/cmake -Dcfgdir= -P /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/tmp/libvterm-mkdirs.cmake - /usr/bin/cmake -E touch /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-mkdir - -libvterm-prefix/src/libvterm-stamp/libvterm-patch: libvterm-prefix/src/libvterm-stamp/libvterm-patch-info.txt -libvterm-prefix/src/libvterm-stamp/libvterm-patch: libvterm-prefix/src/libvterm-stamp/libvterm-update - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --blue --bold --progress-dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles --progress-num=$(CMAKE_PROGRESS_7) "No patch step for 'libvterm'" - /usr/bin/cmake -E echo_append - /usr/bin/cmake -E touch /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-patch - -libvterm-prefix/src/libvterm-stamp/libvterm-update: libvterm-prefix/tmp/libvterm-gitupdate.cmake -libvterm-prefix/src/libvterm-stamp/libvterm-update: libvterm-prefix/src/libvterm-stamp/libvterm-update-info.txt -libvterm-prefix/src/libvterm-stamp/libvterm-update: libvterm-prefix/src/libvterm-stamp/libvterm-download - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --blue --bold --progress-dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles --progress-num=$(CMAKE_PROGRESS_8) "Performing update step for 'libvterm'" - cd /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm && /usr/bin/cmake -Dcan_fetch=YES -DCMAKE_MESSAGE_LOG_LEVEL=VERBOSE -P /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/tmp/libvterm-gitupdate.cmake - -libvterm: CMakeFiles/libvterm -libvterm: CMakeFiles/libvterm-complete -libvterm: libvterm-prefix/src/libvterm-stamp/libvterm-build -libvterm: libvterm-prefix/src/libvterm-stamp/libvterm-configure -libvterm: libvterm-prefix/src/libvterm-stamp/libvterm-download -libvterm: libvterm-prefix/src/libvterm-stamp/libvterm-install -libvterm: libvterm-prefix/src/libvterm-stamp/libvterm-mkdir -libvterm: libvterm-prefix/src/libvterm-stamp/libvterm-patch -libvterm: libvterm-prefix/src/libvterm-stamp/libvterm-update -libvterm: CMakeFiles/libvterm.dir/build.make -.PHONY : libvterm - -# Rule to build all files generated by this target. -CMakeFiles/libvterm.dir/build: libvterm -.PHONY : CMakeFiles/libvterm.dir/build - -CMakeFiles/libvterm.dir/clean: - $(CMAKE_COMMAND) -P CMakeFiles/libvterm.dir/cmake_clean.cmake -.PHONY : CMakeFiles/libvterm.dir/clean - -CMakeFiles/libvterm.dir/depend: - cd /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build && $(CMAKE_COMMAND) -E cmake_depends "Unix Makefiles" /home/dwrz/.config/emacs/elpa/vterm-20240825.133 /home/dwrz/.config/emacs/elpa/vterm-20240825.133 /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir/DependInfo.cmake "--color=$(COLOR)" -.PHONY : CMakeFiles/libvterm.dir/depend - diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir/cmake_clean.cmake b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir/cmake_clean.cmake @@ -1,16 +0,0 @@ -file(REMOVE_RECURSE - "CMakeFiles/libvterm" - "CMakeFiles/libvterm-complete" - "libvterm-prefix/src/libvterm-stamp/libvterm-build" - "libvterm-prefix/src/libvterm-stamp/libvterm-configure" - "libvterm-prefix/src/libvterm-stamp/libvterm-download" - "libvterm-prefix/src/libvterm-stamp/libvterm-install" - "libvterm-prefix/src/libvterm-stamp/libvterm-mkdir" - "libvterm-prefix/src/libvterm-stamp/libvterm-patch" - "libvterm-prefix/src/libvterm-stamp/libvterm-update" -) - -# Per-language clean rules from dependency scanning. -foreach(lang ) - include(CMakeFiles/libvterm.dir/cmake_clean_${lang}.cmake OPTIONAL) -endforeach() diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir/compiler_depend.make b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir/compiler_depend.make @@ -1,2 +0,0 @@ -# Empty custom commands generated dependencies file for libvterm. -# This may be replaced when dependencies are built. diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir/compiler_depend.ts b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir/compiler_depend.ts @@ -1,2 +0,0 @@ -# CMAKE generated file: DO NOT EDIT! -# Timestamp file for custom commands dependencies management for libvterm. diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir/progress.make b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/libvterm.dir/progress.make @@ -1,9 +0,0 @@ -CMAKE_PROGRESS_1 = 1 -CMAKE_PROGRESS_2 = 2 -CMAKE_PROGRESS_3 = 3 -CMAKE_PROGRESS_4 = 4 -CMAKE_PROGRESS_5 = 5 -CMAKE_PROGRESS_6 = 6 -CMAKE_PROGRESS_7 = 7 -CMAKE_PROGRESS_8 = 8 - diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/progress.marks b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/progress.marks @@ -1 +0,0 @@ -12 diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/run.dir/DependInfo.cmake b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/run.dir/DependInfo.cmake @@ -1,22 +0,0 @@ - -# Consider dependencies only in project. -set(CMAKE_DEPENDS_IN_PROJECT_ONLY OFF) - -# The set of languages for which implicit dependencies are needed: -set(CMAKE_DEPENDS_LANGUAGES - ) - -# The set of dependency files which are needed: -set(CMAKE_DEPENDS_DEPENDENCY_FILES - ) - -# Targets to which this target links which contain Fortran sources. -set(CMAKE_Fortran_TARGET_LINKED_INFO_FILES - ) - -# Targets to which this target links which contain Fortran sources. -set(CMAKE_Fortran_TARGET_FORWARD_LINKED_INFO_FILES - ) - -# Fortran module output directory. -set(CMAKE_Fortran_TARGET_MODULE_DIR "") diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/run.dir/build.make b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/run.dir/build.make @@ -1,87 +0,0 @@ -# CMAKE generated file: DO NOT EDIT! -# Generated by "Unix Makefiles" Generator, CMake Version 3.30 - -# Delete rule output on recipe failure. -.DELETE_ON_ERROR: - -#============================================================================= -# Special targets provided by cmake. - -# Disable implicit rules so canonical targets will work. -.SUFFIXES: - -# Disable VCS-based implicit rules. -% : %,v - -# Disable VCS-based implicit rules. -% : RCS/% - -# Disable VCS-based implicit rules. -% : RCS/%,v - -# Disable VCS-based implicit rules. -% : SCCS/s.% - -# Disable VCS-based implicit rules. -% : s.% - -.SUFFIXES: .hpux_make_needs_suffix_list - -# Command-line flag to silence nested $(MAKE). -$(VERBOSE)MAKESILENT = -s - -#Suppress display of executed commands. -$(VERBOSE).SILENT: - -# A target that is always out of date. -cmake_force: -.PHONY : cmake_force - -#============================================================================= -# Set environment variables for the build. - -# The shell in which to execute make rules. -SHELL = /bin/sh - -# The CMake executable. -CMAKE_COMMAND = /usr/bin/cmake - -# The command to remove a file. -RM = /usr/bin/cmake -E rm -f - -# Escaping for special characters. -EQUALS = = - -# The top-level source directory on which CMake was run. -CMAKE_SOURCE_DIR = /home/dwrz/.config/emacs/elpa/vterm-20240825.133 - -# The top-level build directory on which CMake was run. -CMAKE_BINARY_DIR = /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build - -# Utility rule file for run. - -# Include any custom commands dependencies for this target. -include CMakeFiles/run.dir/compiler_depend.make - -# Include the progress variables for this target. -include CMakeFiles/run.dir/progress.make - -CMakeFiles/run: /home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.so - emacs -Q -L /home/dwrz/.config/emacs/elpa/vterm-20240825.133 -L /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build --eval \(require\ \'vterm\) --eval \(vterm\) - -run: CMakeFiles/run -run: CMakeFiles/run.dir/build.make -.PHONY : run - -# Rule to build all files generated by this target. -CMakeFiles/run.dir/build: run -.PHONY : CMakeFiles/run.dir/build - -CMakeFiles/run.dir/clean: - $(CMAKE_COMMAND) -P CMakeFiles/run.dir/cmake_clean.cmake -.PHONY : CMakeFiles/run.dir/clean - -CMakeFiles/run.dir/depend: - cd /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build && $(CMAKE_COMMAND) -E cmake_depends "Unix Makefiles" /home/dwrz/.config/emacs/elpa/vterm-20240825.133 /home/dwrz/.config/emacs/elpa/vterm-20240825.133 /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/run.dir/DependInfo.cmake "--color=$(COLOR)" -.PHONY : CMakeFiles/run.dir/depend - diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/run.dir/cmake_clean.cmake b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/run.dir/cmake_clean.cmake @@ -1,8 +0,0 @@ -file(REMOVE_RECURSE - "CMakeFiles/run" -) - -# Per-language clean rules from dependency scanning. -foreach(lang ) - include(CMakeFiles/run.dir/cmake_clean_${lang}.cmake OPTIONAL) -endforeach() diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/run.dir/compiler_depend.make b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/run.dir/compiler_depend.make @@ -1,2 +0,0 @@ -# Empty custom commands generated dependencies file for run. -# This may be replaced when dependencies are built. diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/run.dir/compiler_depend.ts b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/run.dir/compiler_depend.ts @@ -1,2 +0,0 @@ -# CMAKE generated file: DO NOT EDIT! -# Timestamp file for custom commands dependencies management for run. diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/run.dir/progress.make b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/run.dir/progress.make @@ -1 +0,0 @@ - diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/DependInfo.cmake b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/DependInfo.cmake @@ -1,25 +0,0 @@ - -# Consider dependencies only in project. -set(CMAKE_DEPENDS_IN_PROJECT_ONLY OFF) - -# The set of languages for which implicit dependencies are needed: -set(CMAKE_DEPENDS_LANGUAGES - ) - -# The set of dependency files which are needed: -set(CMAKE_DEPENDS_DEPENDENCY_FILES - "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/elisp.c" "CMakeFiles/vterm-module.dir/elisp.c.o" "gcc" "CMakeFiles/vterm-module.dir/elisp.c.o.d" - "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/utf8.c" "CMakeFiles/vterm-module.dir/utf8.c.o" "gcc" "CMakeFiles/vterm-module.dir/utf8.c.o.d" - "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.c" "CMakeFiles/vterm-module.dir/vterm-module.c.o" "gcc" "CMakeFiles/vterm-module.dir/vterm-module.c.o.d" - ) - -# Targets to which this target links which contain Fortran sources. -set(CMAKE_Fortran_TARGET_LINKED_INFO_FILES - ) - -# Targets to which this target links which contain Fortran sources. -set(CMAKE_Fortran_TARGET_FORWARD_LINKED_INFO_FILES - ) - -# Fortran module output directory. -set(CMAKE_Fortran_TARGET_MODULE_DIR "") diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/build.make b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/build.make @@ -1,143 +0,0 @@ -# CMAKE generated file: DO NOT EDIT! -# Generated by "Unix Makefiles" Generator, CMake Version 3.30 - -# Delete rule output on recipe failure. -.DELETE_ON_ERROR: - -#============================================================================= -# Special targets provided by cmake. - -# Disable implicit rules so canonical targets will work. -.SUFFIXES: - -# Disable VCS-based implicit rules. -% : %,v - -# Disable VCS-based implicit rules. -% : RCS/% - -# Disable VCS-based implicit rules. -% : RCS/%,v - -# Disable VCS-based implicit rules. -% : SCCS/s.% - -# Disable VCS-based implicit rules. -% : s.% - -.SUFFIXES: .hpux_make_needs_suffix_list - -# Command-line flag to silence nested $(MAKE). -$(VERBOSE)MAKESILENT = -s - -#Suppress display of executed commands. -$(VERBOSE).SILENT: - -# A target that is always out of date. -cmake_force: -.PHONY : cmake_force - -#============================================================================= -# Set environment variables for the build. - -# The shell in which to execute make rules. -SHELL = /bin/sh - -# The CMake executable. -CMAKE_COMMAND = /usr/bin/cmake - -# The command to remove a file. -RM = /usr/bin/cmake -E rm -f - -# Escaping for special characters. -EQUALS = = - -# The top-level source directory on which CMake was run. -CMAKE_SOURCE_DIR = /home/dwrz/.config/emacs/elpa/vterm-20240825.133 - -# The top-level build directory on which CMake was run. -CMAKE_BINARY_DIR = /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build - -# Include any dependencies generated for this target. -include CMakeFiles/vterm-module.dir/depend.make -# Include any dependencies generated by the compiler for this target. -include CMakeFiles/vterm-module.dir/compiler_depend.make - -# Include the progress variables for this target. -include CMakeFiles/vterm-module.dir/progress.make - -# Include the compile flags for this target's objects. -include CMakeFiles/vterm-module.dir/flags.make - -CMakeFiles/vterm-module.dir/vterm-module.c.o: CMakeFiles/vterm-module.dir/flags.make -CMakeFiles/vterm-module.dir/vterm-module.c.o: /home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.c -CMakeFiles/vterm-module.dir/vterm-module.c.o: CMakeFiles/vterm-module.dir/compiler_depend.ts - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --green --progress-dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles --progress-num=$(CMAKE_PROGRESS_1) "Building C object CMakeFiles/vterm-module.dir/vterm-module.c.o" - /usr/bin/cc $(C_DEFINES) $(C_INCLUDES) $(C_FLAGS) -MD -MT CMakeFiles/vterm-module.dir/vterm-module.c.o -MF CMakeFiles/vterm-module.dir/vterm-module.c.o.d -o CMakeFiles/vterm-module.dir/vterm-module.c.o -c /home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.c - -CMakeFiles/vterm-module.dir/vterm-module.c.i: cmake_force - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --green "Preprocessing C source to CMakeFiles/vterm-module.dir/vterm-module.c.i" - /usr/bin/cc $(C_DEFINES) $(C_INCLUDES) $(C_FLAGS) -E /home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.c > CMakeFiles/vterm-module.dir/vterm-module.c.i - -CMakeFiles/vterm-module.dir/vterm-module.c.s: cmake_force - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --green "Compiling C source to assembly CMakeFiles/vterm-module.dir/vterm-module.c.s" - /usr/bin/cc $(C_DEFINES) $(C_INCLUDES) $(C_FLAGS) -S /home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.c -o CMakeFiles/vterm-module.dir/vterm-module.c.s - -CMakeFiles/vterm-module.dir/utf8.c.o: CMakeFiles/vterm-module.dir/flags.make -CMakeFiles/vterm-module.dir/utf8.c.o: /home/dwrz/.config/emacs/elpa/vterm-20240825.133/utf8.c -CMakeFiles/vterm-module.dir/utf8.c.o: CMakeFiles/vterm-module.dir/compiler_depend.ts - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --green --progress-dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles --progress-num=$(CMAKE_PROGRESS_2) "Building C object CMakeFiles/vterm-module.dir/utf8.c.o" - /usr/bin/cc $(C_DEFINES) $(C_INCLUDES) $(C_FLAGS) -MD -MT CMakeFiles/vterm-module.dir/utf8.c.o -MF CMakeFiles/vterm-module.dir/utf8.c.o.d -o CMakeFiles/vterm-module.dir/utf8.c.o -c /home/dwrz/.config/emacs/elpa/vterm-20240825.133/utf8.c - -CMakeFiles/vterm-module.dir/utf8.c.i: cmake_force - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --green "Preprocessing C source to CMakeFiles/vterm-module.dir/utf8.c.i" - /usr/bin/cc $(C_DEFINES) $(C_INCLUDES) $(C_FLAGS) -E /home/dwrz/.config/emacs/elpa/vterm-20240825.133/utf8.c > CMakeFiles/vterm-module.dir/utf8.c.i - -CMakeFiles/vterm-module.dir/utf8.c.s: cmake_force - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --green "Compiling C source to assembly CMakeFiles/vterm-module.dir/utf8.c.s" - /usr/bin/cc $(C_DEFINES) $(C_INCLUDES) $(C_FLAGS) -S /home/dwrz/.config/emacs/elpa/vterm-20240825.133/utf8.c -o CMakeFiles/vterm-module.dir/utf8.c.s - -CMakeFiles/vterm-module.dir/elisp.c.o: CMakeFiles/vterm-module.dir/flags.make -CMakeFiles/vterm-module.dir/elisp.c.o: /home/dwrz/.config/emacs/elpa/vterm-20240825.133/elisp.c -CMakeFiles/vterm-module.dir/elisp.c.o: CMakeFiles/vterm-module.dir/compiler_depend.ts - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --green --progress-dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles --progress-num=$(CMAKE_PROGRESS_3) "Building C object CMakeFiles/vterm-module.dir/elisp.c.o" - /usr/bin/cc $(C_DEFINES) $(C_INCLUDES) $(C_FLAGS) -MD -MT CMakeFiles/vterm-module.dir/elisp.c.o -MF CMakeFiles/vterm-module.dir/elisp.c.o.d -o CMakeFiles/vterm-module.dir/elisp.c.o -c /home/dwrz/.config/emacs/elpa/vterm-20240825.133/elisp.c - -CMakeFiles/vterm-module.dir/elisp.c.i: cmake_force - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --green "Preprocessing C source to CMakeFiles/vterm-module.dir/elisp.c.i" - /usr/bin/cc $(C_DEFINES) $(C_INCLUDES) $(C_FLAGS) -E /home/dwrz/.config/emacs/elpa/vterm-20240825.133/elisp.c > CMakeFiles/vterm-module.dir/elisp.c.i - -CMakeFiles/vterm-module.dir/elisp.c.s: cmake_force - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --green "Compiling C source to assembly CMakeFiles/vterm-module.dir/elisp.c.s" - /usr/bin/cc $(C_DEFINES) $(C_INCLUDES) $(C_FLAGS) -S /home/dwrz/.config/emacs/elpa/vterm-20240825.133/elisp.c -o CMakeFiles/vterm-module.dir/elisp.c.s - -# Object files for target vterm-module -vterm__module_OBJECTS = \ -"CMakeFiles/vterm-module.dir/vterm-module.c.o" \ -"CMakeFiles/vterm-module.dir/utf8.c.o" \ -"CMakeFiles/vterm-module.dir/elisp.c.o" - -# External object files for target vterm-module -vterm__module_EXTERNAL_OBJECTS = - -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.so: CMakeFiles/vterm-module.dir/vterm-module.c.o -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.so: CMakeFiles/vterm-module.dir/utf8.c.o -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.so: CMakeFiles/vterm-module.dir/elisp.c.o -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.so: CMakeFiles/vterm-module.dir/build.make -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.so: libvterm-prefix/src/libvterm/.libs/libvterm.a -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.so: CMakeFiles/vterm-module.dir/link.txt - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --green --bold --progress-dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles --progress-num=$(CMAKE_PROGRESS_4) "Linking C shared module /home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.so" - $(CMAKE_COMMAND) -E cmake_link_script CMakeFiles/vterm-module.dir/link.txt --verbose=$(VERBOSE) - -# Rule to build all files generated by this target. -CMakeFiles/vterm-module.dir/build: /home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.so -.PHONY : CMakeFiles/vterm-module.dir/build - -CMakeFiles/vterm-module.dir/clean: - $(CMAKE_COMMAND) -P CMakeFiles/vterm-module.dir/cmake_clean.cmake -.PHONY : CMakeFiles/vterm-module.dir/clean - -CMakeFiles/vterm-module.dir/depend: - cd /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build && $(CMAKE_COMMAND) -E cmake_depends "Unix Makefiles" /home/dwrz/.config/emacs/elpa/vterm-20240825.133 /home/dwrz/.config/emacs/elpa/vterm-20240825.133 /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/DependInfo.cmake "--color=$(COLOR)" -.PHONY : CMakeFiles/vterm-module.dir/depend - diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/cmake_clean.cmake b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/cmake_clean.cmake @@ -1,15 +0,0 @@ -file(REMOVE_RECURSE - "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.pdb" - "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.so" - "CMakeFiles/vterm-module.dir/elisp.c.o" - "CMakeFiles/vterm-module.dir/elisp.c.o.d" - "CMakeFiles/vterm-module.dir/utf8.c.o" - "CMakeFiles/vterm-module.dir/utf8.c.o.d" - "CMakeFiles/vterm-module.dir/vterm-module.c.o" - "CMakeFiles/vterm-module.dir/vterm-module.c.o.d" -) - -# Per-language clean rules from dependency scanning. -foreach(lang C) - include(CMakeFiles/vterm-module.dir/cmake_clean_${lang}.cmake OPTIONAL) -endforeach() diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/compiler_depend.internal b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/compiler_depend.internal @@ -1,207 +0,0 @@ -# CMAKE generated file: DO NOT EDIT! -# Generated by "Unix Makefiles" Generator, CMake Version 3.30 - -CMakeFiles/vterm-module.dir/elisp.c.o - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/elisp.c - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm/include/vterm.h - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm/include/vterm_keycodes.h - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/elisp.h - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/emacs-module.h - /usr/include/alloca.h - /usr/include/bits/atomic_wide_counter.h - /usr/include/bits/byteswap.h - /usr/include/bits/endian.h - /usr/include/bits/endianness.h - /usr/include/bits/floatn-common.h - /usr/include/bits/floatn.h - /usr/include/bits/libc-header-start.h - /usr/include/bits/long-double.h - /usr/include/bits/pthreadtypes-arch.h - /usr/include/bits/pthreadtypes.h - /usr/include/bits/select.h - /usr/include/bits/stdint-intn.h - /usr/include/bits/stdint-least.h - /usr/include/bits/stdint-uintn.h - /usr/include/bits/stdio.h - /usr/include/bits/stdio_lim.h - /usr/include/bits/stdlib-bsearch.h - /usr/include/bits/stdlib-float.h - /usr/include/bits/struct_mutex.h - /usr/include/bits/struct_rwlock.h - /usr/include/bits/thread-shared-types.h - /usr/include/bits/time64.h - /usr/include/bits/timesize.h - /usr/include/bits/types.h - /usr/include/bits/types/FILE.h - /usr/include/bits/types/__FILE.h - /usr/include/bits/types/__fpos64_t.h - /usr/include/bits/types/__fpos_t.h - /usr/include/bits/types/__mbstate_t.h - /usr/include/bits/types/__sigset_t.h - /usr/include/bits/types/clock_t.h - /usr/include/bits/types/clockid_t.h - /usr/include/bits/types/cookie_io_functions_t.h - /usr/include/bits/types/sigset_t.h - /usr/include/bits/types/struct_FILE.h - /usr/include/bits/types/struct_timespec.h - /usr/include/bits/types/struct_timeval.h - /usr/include/bits/types/time_t.h - /usr/include/bits/types/timer_t.h - /usr/include/bits/typesizes.h - /usr/include/bits/uintn-identity.h - /usr/include/bits/waitflags.h - /usr/include/bits/waitstatus.h - /usr/include/bits/wchar.h - /usr/include/bits/wordsize.h - /usr/include/endian.h - /usr/include/features-time64.h - /usr/include/features.h - /usr/include/gnu/stubs-64.h - /usr/include/gnu/stubs.h - /usr/include/stdc-predef.h - /usr/include/stdint.h - /usr/include/stdio.h - /usr/include/stdlib.h - /usr/include/sys/cdefs.h - /usr/include/sys/select.h - /usr/include/sys/types.h - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdarg.h - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdbool.h - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stddef.h - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdint.h - -CMakeFiles/vterm-module.dir/utf8.c.o - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/utf8.c - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/utf8.h - /usr/include/bits/libc-header-start.h - /usr/include/bits/long-double.h - /usr/include/bits/stdint-intn.h - /usr/include/bits/stdint-least.h - /usr/include/bits/stdint-uintn.h - /usr/include/bits/time64.h - /usr/include/bits/timesize.h - /usr/include/bits/types.h - /usr/include/bits/typesizes.h - /usr/include/bits/wchar.h - /usr/include/bits/wordsize.h - /usr/include/features-time64.h - /usr/include/features.h - /usr/include/gnu/stubs-64.h - /usr/include/gnu/stubs.h - /usr/include/stdc-predef.h - /usr/include/stdint.h - /usr/include/sys/cdefs.h - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdbool.h - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stddef.h - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdint.h - -CMakeFiles/vterm-module.dir/vterm-module.c.o - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.c - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm/include/vterm.h - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm/include/vterm_keycodes.h - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/elisp.h - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/emacs-module.h - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/utf8.h - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.h - /usr/include/alloca.h - /usr/include/assert.h - /usr/include/bits/atomic_wide_counter.h - /usr/include/bits/byteswap.h - /usr/include/bits/confname.h - /usr/include/bits/endian.h - /usr/include/bits/endianness.h - /usr/include/bits/environments.h - /usr/include/bits/fcntl-linux.h - /usr/include/bits/fcntl.h - /usr/include/bits/floatn-common.h - /usr/include/bits/floatn.h - /usr/include/bits/getopt_core.h - /usr/include/bits/getopt_posix.h - /usr/include/bits/libc-header-start.h - /usr/include/bits/local_lim.h - /usr/include/bits/long-double.h - /usr/include/bits/posix1_lim.h - /usr/include/bits/posix2_lim.h - /usr/include/bits/posix_opt.h - /usr/include/bits/pthread_stack_min-dynamic.h - /usr/include/bits/pthread_stack_min.h - /usr/include/bits/pthreadtypes-arch.h - /usr/include/bits/pthreadtypes.h - /usr/include/bits/select.h - /usr/include/bits/stat.h - /usr/include/bits/stdint-intn.h - /usr/include/bits/stdint-least.h - /usr/include/bits/stdint-uintn.h - /usr/include/bits/stdio.h - /usr/include/bits/stdio_lim.h - /usr/include/bits/stdlib-bsearch.h - /usr/include/bits/stdlib-float.h - /usr/include/bits/struct_mutex.h - /usr/include/bits/struct_rwlock.h - /usr/include/bits/struct_stat.h - /usr/include/bits/termios-baud.h - /usr/include/bits/termios-c_cc.h - /usr/include/bits/termios-c_cflag.h - /usr/include/bits/termios-c_iflag.h - /usr/include/bits/termios-c_lflag.h - /usr/include/bits/termios-c_oflag.h - /usr/include/bits/termios-misc.h - /usr/include/bits/termios-struct.h - /usr/include/bits/termios-tcflow.h - /usr/include/bits/termios.h - /usr/include/bits/thread-shared-types.h - /usr/include/bits/time64.h - /usr/include/bits/timesize.h - /usr/include/bits/types.h - /usr/include/bits/types/FILE.h - /usr/include/bits/types/__FILE.h - /usr/include/bits/types/__fpos64_t.h - /usr/include/bits/types/__fpos_t.h - /usr/include/bits/types/__locale_t.h - /usr/include/bits/types/__mbstate_t.h - /usr/include/bits/types/__sigset_t.h - /usr/include/bits/types/clock_t.h - /usr/include/bits/types/clockid_t.h - /usr/include/bits/types/cookie_io_functions_t.h - /usr/include/bits/types/locale_t.h - /usr/include/bits/types/sigset_t.h - /usr/include/bits/types/struct_FILE.h - /usr/include/bits/types/struct_timespec.h - /usr/include/bits/types/struct_timeval.h - /usr/include/bits/types/time_t.h - /usr/include/bits/types/timer_t.h - /usr/include/bits/typesizes.h - /usr/include/bits/uintn-identity.h - /usr/include/bits/unistd_ext.h - /usr/include/bits/waitflags.h - /usr/include/bits/waitstatus.h - /usr/include/bits/wchar.h - /usr/include/bits/wordsize.h - /usr/include/endian.h - /usr/include/fcntl.h - /usr/include/features-time64.h - /usr/include/features.h - /usr/include/gnu/stubs-64.h - /usr/include/gnu/stubs.h - /usr/include/inttypes.h - /usr/include/limits.h - /usr/include/linux/limits.h - /usr/include/stdc-predef.h - /usr/include/stdint.h - /usr/include/stdio.h - /usr/include/stdlib.h - /usr/include/string.h - /usr/include/strings.h - /usr/include/sys/cdefs.h - /usr/include/sys/select.h - /usr/include/sys/ttydefaults.h - /usr/include/sys/types.h - /usr/include/termios.h - /usr/include/unistd.h - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/limits.h - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdarg.h - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdbool.h - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stddef.h - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdint.h - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/syslimits.h - diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/compiler_depend.make b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/compiler_depend.make @@ -1,424 +0,0 @@ -# CMAKE generated file: DO NOT EDIT! -# Generated by "Unix Makefiles" Generator, CMake Version 3.30 - -CMakeFiles/vterm-module.dir/elisp.c.o: /home/dwrz/.config/emacs/elpa/vterm-20240825.133/elisp.c \ - libvterm-prefix/src/libvterm/include/vterm.h \ - libvterm-prefix/src/libvterm/include/vterm_keycodes.h \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/elisp.h \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/emacs-module.h \ - /usr/include/alloca.h \ - /usr/include/bits/atomic_wide_counter.h \ - /usr/include/bits/byteswap.h \ - /usr/include/bits/endian.h \ - /usr/include/bits/endianness.h \ - /usr/include/bits/floatn-common.h \ - /usr/include/bits/floatn.h \ - /usr/include/bits/libc-header-start.h \ - /usr/include/bits/long-double.h \ - /usr/include/bits/pthreadtypes-arch.h \ - /usr/include/bits/pthreadtypes.h \ - /usr/include/bits/select.h \ - /usr/include/bits/stdint-intn.h \ - /usr/include/bits/stdint-least.h \ - /usr/include/bits/stdint-uintn.h \ - /usr/include/bits/stdio.h \ - /usr/include/bits/stdio_lim.h \ - /usr/include/bits/stdlib-bsearch.h \ - /usr/include/bits/stdlib-float.h \ - /usr/include/bits/struct_mutex.h \ - /usr/include/bits/struct_rwlock.h \ - /usr/include/bits/thread-shared-types.h \ - /usr/include/bits/time64.h \ - /usr/include/bits/timesize.h \ - /usr/include/bits/types.h \ - /usr/include/bits/types/FILE.h \ - /usr/include/bits/types/__FILE.h \ - /usr/include/bits/types/__fpos64_t.h \ - /usr/include/bits/types/__fpos_t.h \ - /usr/include/bits/types/__mbstate_t.h \ - /usr/include/bits/types/__sigset_t.h \ - /usr/include/bits/types/clock_t.h \ - /usr/include/bits/types/clockid_t.h \ - /usr/include/bits/types/cookie_io_functions_t.h \ - /usr/include/bits/types/sigset_t.h \ - /usr/include/bits/types/struct_FILE.h \ - /usr/include/bits/types/struct_timespec.h \ - /usr/include/bits/types/struct_timeval.h \ - /usr/include/bits/types/time_t.h \ - /usr/include/bits/types/timer_t.h \ - /usr/include/bits/typesizes.h \ - /usr/include/bits/uintn-identity.h \ - /usr/include/bits/waitflags.h \ - /usr/include/bits/waitstatus.h \ - /usr/include/bits/wchar.h \ - /usr/include/bits/wordsize.h \ - /usr/include/endian.h \ - /usr/include/features-time64.h \ - /usr/include/features.h \ - /usr/include/gnu/stubs-64.h \ - /usr/include/gnu/stubs.h \ - /usr/include/stdc-predef.h \ - /usr/include/stdint.h \ - /usr/include/stdio.h \ - /usr/include/stdlib.h \ - /usr/include/sys/cdefs.h \ - /usr/include/sys/select.h \ - /usr/include/sys/types.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdarg.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdbool.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stddef.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdint.h - -CMakeFiles/vterm-module.dir/utf8.c.o: /home/dwrz/.config/emacs/elpa/vterm-20240825.133/utf8.c \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/utf8.h \ - /usr/include/bits/libc-header-start.h \ - /usr/include/bits/long-double.h \ - /usr/include/bits/stdint-intn.h \ - /usr/include/bits/stdint-least.h \ - /usr/include/bits/stdint-uintn.h \ - /usr/include/bits/time64.h \ - /usr/include/bits/timesize.h \ - /usr/include/bits/types.h \ - /usr/include/bits/typesizes.h \ - /usr/include/bits/wchar.h \ - /usr/include/bits/wordsize.h \ - /usr/include/features-time64.h \ - /usr/include/features.h \ - /usr/include/gnu/stubs-64.h \ - /usr/include/gnu/stubs.h \ - /usr/include/stdc-predef.h \ - /usr/include/stdint.h \ - /usr/include/sys/cdefs.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdbool.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stddef.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdint.h - -CMakeFiles/vterm-module.dir/vterm-module.c.o: /home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.c \ - libvterm-prefix/src/libvterm/include/vterm.h \ - libvterm-prefix/src/libvterm/include/vterm_keycodes.h \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/elisp.h \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/emacs-module.h \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/utf8.h \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.h \ - /usr/include/alloca.h \ - /usr/include/assert.h \ - /usr/include/bits/atomic_wide_counter.h \ - /usr/include/bits/byteswap.h \ - /usr/include/bits/confname.h \ - /usr/include/bits/endian.h \ - /usr/include/bits/endianness.h \ - /usr/include/bits/environments.h \ - /usr/include/bits/fcntl-linux.h \ - /usr/include/bits/fcntl.h \ - /usr/include/bits/floatn-common.h \ - /usr/include/bits/floatn.h \ - /usr/include/bits/getopt_core.h \ - /usr/include/bits/getopt_posix.h \ - /usr/include/bits/libc-header-start.h \ - /usr/include/bits/local_lim.h \ - /usr/include/bits/long-double.h \ - /usr/include/bits/posix1_lim.h \ - /usr/include/bits/posix2_lim.h \ - /usr/include/bits/posix_opt.h \ - /usr/include/bits/pthread_stack_min-dynamic.h \ - /usr/include/bits/pthread_stack_min.h \ - /usr/include/bits/pthreadtypes-arch.h \ - /usr/include/bits/pthreadtypes.h \ - /usr/include/bits/select.h \ - /usr/include/bits/stat.h \ - /usr/include/bits/stdint-intn.h \ - /usr/include/bits/stdint-least.h \ - /usr/include/bits/stdint-uintn.h \ - /usr/include/bits/stdio.h \ - /usr/include/bits/stdio_lim.h \ - /usr/include/bits/stdlib-bsearch.h \ - /usr/include/bits/stdlib-float.h \ - /usr/include/bits/struct_mutex.h \ - /usr/include/bits/struct_rwlock.h \ - /usr/include/bits/struct_stat.h \ - /usr/include/bits/termios-baud.h \ - /usr/include/bits/termios-c_cc.h \ - /usr/include/bits/termios-c_cflag.h \ - /usr/include/bits/termios-c_iflag.h \ - /usr/include/bits/termios-c_lflag.h \ - /usr/include/bits/termios-c_oflag.h \ - /usr/include/bits/termios-misc.h \ - /usr/include/bits/termios-struct.h \ - /usr/include/bits/termios-tcflow.h \ - /usr/include/bits/termios.h \ - /usr/include/bits/thread-shared-types.h \ - /usr/include/bits/time64.h \ - /usr/include/bits/timesize.h \ - /usr/include/bits/types.h \ - /usr/include/bits/types/FILE.h \ - /usr/include/bits/types/__FILE.h \ - /usr/include/bits/types/__fpos64_t.h \ - /usr/include/bits/types/__fpos_t.h \ - /usr/include/bits/types/__locale_t.h \ - /usr/include/bits/types/__mbstate_t.h \ - /usr/include/bits/types/__sigset_t.h \ - /usr/include/bits/types/clock_t.h \ - /usr/include/bits/types/clockid_t.h \ - /usr/include/bits/types/cookie_io_functions_t.h \ - /usr/include/bits/types/locale_t.h \ - /usr/include/bits/types/sigset_t.h \ - /usr/include/bits/types/struct_FILE.h \ - /usr/include/bits/types/struct_timespec.h \ - /usr/include/bits/types/struct_timeval.h \ - /usr/include/bits/types/time_t.h \ - /usr/include/bits/types/timer_t.h \ - /usr/include/bits/typesizes.h \ - /usr/include/bits/uintn-identity.h \ - /usr/include/bits/unistd_ext.h \ - /usr/include/bits/waitflags.h \ - /usr/include/bits/waitstatus.h \ - /usr/include/bits/wchar.h \ - /usr/include/bits/wordsize.h \ - /usr/include/endian.h \ - /usr/include/fcntl.h \ - /usr/include/features-time64.h \ - /usr/include/features.h \ - /usr/include/gnu/stubs-64.h \ - /usr/include/gnu/stubs.h \ - /usr/include/inttypes.h \ - /usr/include/limits.h \ - /usr/include/linux/limits.h \ - /usr/include/stdc-predef.h \ - /usr/include/stdint.h \ - /usr/include/stdio.h \ - /usr/include/stdlib.h \ - /usr/include/string.h \ - /usr/include/strings.h \ - /usr/include/sys/cdefs.h \ - /usr/include/sys/select.h \ - /usr/include/sys/ttydefaults.h \ - /usr/include/sys/types.h \ - /usr/include/termios.h \ - /usr/include/unistd.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/limits.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdarg.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdbool.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stddef.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdint.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/syslimits.h - - -/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/syslimits.h: - -/usr/include/unistd.h: - -/usr/include/sys/ttydefaults.h: - -/usr/include/strings.h: - -/usr/include/inttypes.h: - -/usr/include/bits/types/locale_t.h: - -/usr/include/bits/types/__locale_t.h: - -/usr/include/bits/termios-tcflow.h: - -/usr/include/bits/termios-c_cflag.h: - -/usr/include/bits/struct_stat.h: - -/usr/include/bits/stat.h: - -/usr/include/bits/pthread_stack_min.h: - -/usr/include/bits/pthread_stack_min-dynamic.h: - -/usr/include/bits/posix_opt.h: - -/usr/include/bits/posix2_lim.h: - -/usr/include/fcntl.h: - -/usr/include/bits/posix1_lim.h: - -/usr/include/bits/getopt_posix.h: - -/usr/include/bits/fcntl.h: - -/usr/include/bits/confname.h: - -/usr/include/assert.h: - -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.h: - -/usr/include/termios.h: - -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.c: - -/usr/include/bits/termios-c_oflag.h: - -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/utf8.h: - -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/utf8.c: - -/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdarg.h: - -/usr/include/sys/types.h: - -/usr/include/bits/environments.h: - -/usr/include/sys/select.h: - -/usr/include/sys/cdefs.h: - -/usr/include/bits/termios-baud.h: - -/usr/include/stdlib.h: - -/usr/include/string.h: - -/usr/include/bits/time64.h: - -/usr/include/bits/byteswap.h: - -/usr/include/bits/stdlib-bsearch.h: - -/usr/include/bits/termios-misc.h: - -/usr/include/bits/types/sigset_t.h: - -/usr/include/bits/thread-shared-types.h: - -/usr/include/bits/wchar.h: - -/usr/include/bits/unistd_ext.h: - -/usr/include/bits/fcntl-linux.h: - -/usr/include/bits/stdio.h: - -/usr/include/features.h: - -/usr/include/bits/termios.h: - -/usr/include/bits/stdint-least.h: - -/usr/include/alloca.h: - -/usr/include/bits/stdint-intn.h: - -/usr/include/bits/long-double.h: - -/usr/include/bits/pthreadtypes-arch.h: - -/usr/include/stdc-predef.h: - -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/elisp.c: - -/usr/include/linux/limits.h: - -/usr/include/bits/types/clock_t.h: - -/usr/include/bits/endianness.h: - -/usr/include/bits/termios-c_lflag.h: - -/usr/include/bits/floatn-common.h: - -/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/limits.h: - -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/elisp.h: - -/usr/include/bits/pthreadtypes.h: - -/usr/include/bits/floatn.h: - -/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stddef.h: - -/usr/include/bits/struct_mutex.h: - -/usr/include/gnu/stubs-64.h: - -/usr/include/bits/select.h: - -/usr/include/bits/types/__fpos64_t.h: - -/usr/include/features-time64.h: - -/home/dwrz/.config/emacs/elpa/vterm-20240825.133/emacs-module.h: - -/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdbool.h: - -libvterm-prefix/src/libvterm/include/vterm.h: - -/usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdint.h: - -/usr/include/bits/libc-header-start.h: - -libvterm-prefix/src/libvterm/include/vterm_keycodes.h: - -/usr/include/bits/termios-c_iflag.h: - -/usr/include/stdint.h: - -/usr/include/bits/timesize.h: - -/usr/include/bits/endian.h: - -/usr/include/bits/types/__sigset_t.h: - -/usr/include/bits/waitflags.h: - -/usr/include/bits/getopt_core.h: - -/usr/include/bits/types.h: - -/usr/include/limits.h: - -/usr/include/bits/types/FILE.h: - -/usr/include/bits/stdlib-float.h: - -/usr/include/bits/types/__FILE.h: - -/usr/include/bits/types/__fpos_t.h: - -/usr/include/bits/wordsize.h: - -/usr/include/bits/local_lim.h: - -/usr/include/bits/types/__mbstate_t.h: - -/usr/include/bits/atomic_wide_counter.h: - -/usr/include/bits/types/clockid_t.h: - -/usr/include/bits/uintn-identity.h: - -/usr/include/bits/typesizes.h: - -/usr/include/bits/types/struct_FILE.h: - -/usr/include/bits/types/struct_timespec.h: - -/usr/include/bits/stdio_lim.h: - -/usr/include/bits/types/struct_timeval.h: - -/usr/include/bits/termios-c_cc.h: - -/usr/include/bits/struct_rwlock.h: - -/usr/include/bits/types/time_t.h: - -/usr/include/bits/stdint-uintn.h: - -/usr/include/bits/types/cookie_io_functions_t.h: - -/usr/include/endian.h: - -/usr/include/bits/waitstatus.h: - -/usr/include/bits/termios-struct.h: - -/usr/include/gnu/stubs.h: - -/usr/include/bits/types/timer_t.h: - -/usr/include/stdio.h: diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/compiler_depend.ts b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/compiler_depend.ts @@ -1,2 +0,0 @@ -# CMAKE generated file: DO NOT EDIT! -# Timestamp file for compiler generated dependencies management for vterm-module. diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/depend.make b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/depend.make @@ -1,2 +0,0 @@ -# Empty dependencies file for vterm-module. -# This may be replaced when dependencies are built. diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/elisp.c.o b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/elisp.c.o Binary files differ. diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/elisp.c.o.d b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/elisp.c.o.d @@ -1,43 +0,0 @@ -CMakeFiles/vterm-module.dir/elisp.c.o: \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/elisp.c \ - /usr/include/stdc-predef.h \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/elisp.h \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/emacs-module.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stddef.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdint.h \ - /usr/include/stdint.h /usr/include/bits/libc-header-start.h \ - /usr/include/features.h /usr/include/features-time64.h \ - /usr/include/bits/wordsize.h /usr/include/bits/timesize.h \ - /usr/include/sys/cdefs.h /usr/include/bits/long-double.h \ - /usr/include/gnu/stubs.h /usr/include/gnu/stubs-64.h \ - /usr/include/bits/types.h /usr/include/bits/typesizes.h \ - /usr/include/bits/time64.h /usr/include/bits/wchar.h \ - /usr/include/bits/stdint-intn.h /usr/include/bits/stdint-uintn.h \ - /usr/include/bits/stdint-least.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdbool.h \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm/include/vterm.h \ - /usr/include/stdlib.h /usr/include/bits/waitflags.h \ - /usr/include/bits/waitstatus.h /usr/include/bits/floatn.h \ - /usr/include/bits/floatn-common.h /usr/include/sys/types.h \ - /usr/include/bits/types/clock_t.h /usr/include/bits/types/clockid_t.h \ - /usr/include/bits/types/time_t.h /usr/include/bits/types/timer_t.h \ - /usr/include/endian.h /usr/include/bits/endian.h \ - /usr/include/bits/endianness.h /usr/include/bits/byteswap.h \ - /usr/include/bits/uintn-identity.h /usr/include/sys/select.h \ - /usr/include/bits/select.h /usr/include/bits/types/sigset_t.h \ - /usr/include/bits/types/__sigset_t.h \ - /usr/include/bits/types/struct_timeval.h \ - /usr/include/bits/types/struct_timespec.h \ - /usr/include/bits/pthreadtypes.h /usr/include/bits/thread-shared-types.h \ - /usr/include/bits/pthreadtypes-arch.h \ - /usr/include/bits/atomic_wide_counter.h /usr/include/bits/struct_mutex.h \ - /usr/include/bits/struct_rwlock.h /usr/include/alloca.h \ - /usr/include/bits/stdlib-bsearch.h /usr/include/bits/stdlib-float.h \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm/include/vterm_keycodes.h \ - /usr/include/stdio.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdarg.h \ - /usr/include/bits/types/__fpos_t.h /usr/include/bits/types/__mbstate_t.h \ - /usr/include/bits/types/__fpos64_t.h /usr/include/bits/types/__FILE.h \ - /usr/include/bits/types/FILE.h /usr/include/bits/types/struct_FILE.h \ - /usr/include/bits/types/cookie_io_functions_t.h \ - /usr/include/bits/stdio_lim.h /usr/include/bits/stdio.h diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/flags.make b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/flags.make @@ -1,10 +0,0 @@ -# CMAKE generated file: DO NOT EDIT! -# Generated by "Unix Makefiles" Generator, CMake Version 3.30 - -# compile C with /usr/bin/cc -C_DEFINES = -Dvterm_module_EXPORTS - -C_INCLUDES = -isystem /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm/include - -C_FLAGS = -O2 -g -DNDEBUG -std=gnu99 -fPIC -fvisibility=hidden - diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/link.txt b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/link.txt @@ -1 +0,0 @@ -/usr/bin/cc -fPIC -O2 -g -DNDEBUG -shared -o /home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.so "CMakeFiles/vterm-module.dir/vterm-module.c.o" "CMakeFiles/vterm-module.dir/utf8.c.o" "CMakeFiles/vterm-module.dir/elisp.c.o" libvterm-prefix/src/libvterm/.libs/libvterm.a diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/progress.make b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/progress.make @@ -1,5 +0,0 @@ -CMAKE_PROGRESS_1 = 9 -CMAKE_PROGRESS_2 = 10 -CMAKE_PROGRESS_3 = 11 -CMAKE_PROGRESS_4 = 12 - diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/utf8.c.o b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/utf8.c.o Binary files differ. diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/utf8.c.o.d b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/utf8.c.o.d @@ -1,16 +0,0 @@ -CMakeFiles/vterm-module.dir/utf8.c.o: \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/utf8.c \ - /usr/include/stdc-predef.h \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/utf8.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdbool.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stddef.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdint.h \ - /usr/include/stdint.h /usr/include/bits/libc-header-start.h \ - /usr/include/features.h /usr/include/features-time64.h \ - /usr/include/bits/wordsize.h /usr/include/bits/timesize.h \ - /usr/include/sys/cdefs.h /usr/include/bits/long-double.h \ - /usr/include/gnu/stubs.h /usr/include/gnu/stubs-64.h \ - /usr/include/bits/types.h /usr/include/bits/typesizes.h \ - /usr/include/bits/time64.h /usr/include/bits/wchar.h \ - /usr/include/bits/stdint-intn.h /usr/include/bits/stdint-uintn.h \ - /usr/include/bits/stdint-least.h diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/vterm-module.c.o b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/vterm-module.c.o Binary files differ. diff --git a/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/vterm-module.c.o.d b/emacs/elpa/vterm-20240825.133/build/CMakeFiles/vterm-module.dir/vterm-module.c.o.d @@ -1,67 +0,0 @@ -CMakeFiles/vterm-module.dir/vterm-module.c.o: \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.c \ - /usr/include/stdc-predef.h \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/vterm-module.h \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/emacs-module.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stddef.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdint.h \ - /usr/include/stdint.h /usr/include/bits/libc-header-start.h \ - /usr/include/features.h /usr/include/features-time64.h \ - /usr/include/bits/wordsize.h /usr/include/bits/timesize.h \ - /usr/include/sys/cdefs.h /usr/include/bits/long-double.h \ - /usr/include/gnu/stubs.h /usr/include/gnu/stubs-64.h \ - /usr/include/bits/types.h /usr/include/bits/typesizes.h \ - /usr/include/bits/time64.h /usr/include/bits/wchar.h \ - /usr/include/bits/stdint-intn.h /usr/include/bits/stdint-uintn.h \ - /usr/include/bits/stdint-least.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdbool.h \ - /usr/include/inttypes.h \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm/include/vterm.h \ - /usr/include/stdlib.h /usr/include/bits/waitflags.h \ - /usr/include/bits/waitstatus.h /usr/include/bits/floatn.h \ - /usr/include/bits/floatn-common.h /usr/include/sys/types.h \ - /usr/include/bits/types/clock_t.h /usr/include/bits/types/clockid_t.h \ - /usr/include/bits/types/time_t.h /usr/include/bits/types/timer_t.h \ - /usr/include/endian.h /usr/include/bits/endian.h \ - /usr/include/bits/endianness.h /usr/include/bits/byteswap.h \ - /usr/include/bits/uintn-identity.h /usr/include/sys/select.h \ - /usr/include/bits/select.h /usr/include/bits/types/sigset_t.h \ - /usr/include/bits/types/__sigset_t.h \ - /usr/include/bits/types/struct_timeval.h \ - /usr/include/bits/types/struct_timespec.h \ - /usr/include/bits/pthreadtypes.h /usr/include/bits/thread-shared-types.h \ - /usr/include/bits/pthreadtypes-arch.h \ - /usr/include/bits/atomic_wide_counter.h /usr/include/bits/struct_mutex.h \ - /usr/include/bits/struct_rwlock.h /usr/include/alloca.h \ - /usr/include/bits/stdlib-bsearch.h /usr/include/bits/stdlib-float.h \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm/include/vterm_keycodes.h \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/elisp.h \ - /home/dwrz/.config/emacs/elpa/vterm-20240825.133/utf8.h \ - /usr/include/assert.h /usr/include/fcntl.h /usr/include/bits/fcntl.h \ - /usr/include/bits/fcntl-linux.h /usr/include/bits/stat.h \ - /usr/include/bits/struct_stat.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/limits.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/syslimits.h \ - /usr/include/limits.h /usr/include/bits/posix1_lim.h \ - /usr/include/bits/local_lim.h /usr/include/linux/limits.h \ - /usr/include/bits/pthread_stack_min-dynamic.h \ - /usr/include/bits/pthread_stack_min.h /usr/include/bits/posix2_lim.h \ - /usr/include/stdio.h \ - /usr/lib/gcc/x86_64-pc-linux-gnu/14.2.1/include/stdarg.h \ - /usr/include/bits/types/__fpos_t.h /usr/include/bits/types/__mbstate_t.h \ - /usr/include/bits/types/__fpos64_t.h /usr/include/bits/types/__FILE.h \ - /usr/include/bits/types/FILE.h /usr/include/bits/types/struct_FILE.h \ - /usr/include/bits/types/cookie_io_functions_t.h \ - /usr/include/bits/stdio_lim.h /usr/include/bits/stdio.h \ - /usr/include/string.h /usr/include/bits/types/locale_t.h \ - /usr/include/bits/types/__locale_t.h /usr/include/strings.h \ - /usr/include/termios.h /usr/include/bits/termios.h \ - /usr/include/bits/termios-struct.h /usr/include/bits/termios-c_cc.h \ - /usr/include/bits/termios-c_iflag.h /usr/include/bits/termios-c_oflag.h \ - /usr/include/bits/termios-baud.h /usr/include/bits/termios-c_cflag.h \ - /usr/include/bits/termios-c_lflag.h /usr/include/bits/termios-tcflow.h \ - /usr/include/bits/termios-misc.h /usr/include/sys/ttydefaults.h \ - /usr/include/unistd.h /usr/include/bits/posix_opt.h \ - /usr/include/bits/environments.h /usr/include/bits/confname.h \ - /usr/include/bits/getopt_posix.h /usr/include/bits/getopt_core.h \ - /usr/include/bits/unistd_ext.h diff --git a/emacs/elpa/vterm-20240825.133/build/Makefile b/emacs/elpa/vterm-20240825.133/build/Makefile @@ -1,263 +0,0 @@ -# CMAKE generated file: DO NOT EDIT! -# Generated by "Unix Makefiles" Generator, CMake Version 3.30 - -# Default target executed when no arguments are given to make. -default_target: all -.PHONY : default_target - -# Allow only one "make -f Makefile2" at a time, but pass parallelism. -.NOTPARALLEL: - -#============================================================================= -# Special targets provided by cmake. - -# Disable implicit rules so canonical targets will work. -.SUFFIXES: - -# Disable VCS-based implicit rules. -% : %,v - -# Disable VCS-based implicit rules. -% : RCS/% - -# Disable VCS-based implicit rules. -% : RCS/%,v - -# Disable VCS-based implicit rules. -% : SCCS/s.% - -# Disable VCS-based implicit rules. -% : s.% - -.SUFFIXES: .hpux_make_needs_suffix_list - -# Command-line flag to silence nested $(MAKE). -$(VERBOSE)MAKESILENT = -s - -#Suppress display of executed commands. -$(VERBOSE).SILENT: - -# A target that is always out of date. -cmake_force: -.PHONY : cmake_force - -#============================================================================= -# Set environment variables for the build. - -# The shell in which to execute make rules. -SHELL = /bin/sh - -# The CMake executable. -CMAKE_COMMAND = /usr/bin/cmake - -# The command to remove a file. -RM = /usr/bin/cmake -E rm -f - -# Escaping for special characters. -EQUALS = = - -# The top-level source directory on which CMake was run. -CMAKE_SOURCE_DIR = /home/dwrz/.config/emacs/elpa/vterm-20240825.133 - -# The top-level build directory on which CMake was run. -CMAKE_BINARY_DIR = /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build - -#============================================================================= -# Targets provided globally by CMake. - -# Special rule for the target edit_cache -edit_cache: - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --cyan "Running CMake cache editor..." - /usr/bin/ccmake -S$(CMAKE_SOURCE_DIR) -B$(CMAKE_BINARY_DIR) -.PHONY : edit_cache - -# Special rule for the target edit_cache -edit_cache/fast: edit_cache -.PHONY : edit_cache/fast - -# Special rule for the target rebuild_cache -rebuild_cache: - @$(CMAKE_COMMAND) -E cmake_echo_color "--switch=$(COLOR)" --cyan "Running CMake to regenerate build system..." - /usr/bin/cmake --regenerate-during-build -S$(CMAKE_SOURCE_DIR) -B$(CMAKE_BINARY_DIR) -.PHONY : rebuild_cache - -# Special rule for the target rebuild_cache -rebuild_cache/fast: rebuild_cache -.PHONY : rebuild_cache/fast - -# The main all target -all: cmake_check_build_system - $(CMAKE_COMMAND) -E cmake_progress_start /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build//CMakeFiles/progress.marks - $(MAKE) $(MAKESILENT) -f CMakeFiles/Makefile2 all - $(CMAKE_COMMAND) -E cmake_progress_start /home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/CMakeFiles 0 -.PHONY : all - -# The main clean target -clean: - $(MAKE) $(MAKESILENT) -f CMakeFiles/Makefile2 clean -.PHONY : clean - -# The main clean target -clean/fast: clean -.PHONY : clean/fast - -# Prepare targets for installation. -preinstall: all - $(MAKE) $(MAKESILENT) -f CMakeFiles/Makefile2 preinstall -.PHONY : preinstall - -# Prepare targets for installation. -preinstall/fast: - $(MAKE) $(MAKESILENT) -f CMakeFiles/Makefile2 preinstall -.PHONY : preinstall/fast - -# clear depends -depend: - $(CMAKE_COMMAND) -S$(CMAKE_SOURCE_DIR) -B$(CMAKE_BINARY_DIR) --check-build-system CMakeFiles/Makefile.cmake 1 -.PHONY : depend - -#============================================================================= -# Target rules for targets named vterm-module - -# Build rule for target. -vterm-module: cmake_check_build_system - $(MAKE) $(MAKESILENT) -f CMakeFiles/Makefile2 vterm-module -.PHONY : vterm-module - -# fast build rule for target. -vterm-module/fast: - $(MAKE) $(MAKESILENT) -f CMakeFiles/vterm-module.dir/build.make CMakeFiles/vterm-module.dir/build -.PHONY : vterm-module/fast - -#============================================================================= -# Target rules for targets named libvterm - -# Build rule for target. -libvterm: cmake_check_build_system - $(MAKE) $(MAKESILENT) -f CMakeFiles/Makefile2 libvterm -.PHONY : libvterm - -# fast build rule for target. -libvterm/fast: - $(MAKE) $(MAKESILENT) -f CMakeFiles/libvterm.dir/build.make CMakeFiles/libvterm.dir/build -.PHONY : libvterm/fast - -#============================================================================= -# Target rules for targets named run - -# Build rule for target. -run: cmake_check_build_system - $(MAKE) $(MAKESILENT) -f CMakeFiles/Makefile2 run -.PHONY : run - -# fast build rule for target. -run/fast: - $(MAKE) $(MAKESILENT) -f CMakeFiles/run.dir/build.make CMakeFiles/run.dir/build -.PHONY : run/fast - -elisp.o: elisp.c.o -.PHONY : elisp.o - -# target to build an object file -elisp.c.o: - $(MAKE) $(MAKESILENT) -f CMakeFiles/vterm-module.dir/build.make CMakeFiles/vterm-module.dir/elisp.c.o -.PHONY : elisp.c.o - -elisp.i: elisp.c.i -.PHONY : elisp.i - -# target to preprocess a source file -elisp.c.i: - $(MAKE) $(MAKESILENT) -f CMakeFiles/vterm-module.dir/build.make CMakeFiles/vterm-module.dir/elisp.c.i -.PHONY : elisp.c.i - -elisp.s: elisp.c.s -.PHONY : elisp.s - -# target to generate assembly for a file -elisp.c.s: - $(MAKE) $(MAKESILENT) -f CMakeFiles/vterm-module.dir/build.make CMakeFiles/vterm-module.dir/elisp.c.s -.PHONY : elisp.c.s - -utf8.o: utf8.c.o -.PHONY : utf8.o - -# target to build an object file -utf8.c.o: - $(MAKE) $(MAKESILENT) -f CMakeFiles/vterm-module.dir/build.make CMakeFiles/vterm-module.dir/utf8.c.o -.PHONY : utf8.c.o - -utf8.i: utf8.c.i -.PHONY : utf8.i - -# target to preprocess a source file -utf8.c.i: - $(MAKE) $(MAKESILENT) -f CMakeFiles/vterm-module.dir/build.make CMakeFiles/vterm-module.dir/utf8.c.i -.PHONY : utf8.c.i - -utf8.s: utf8.c.s -.PHONY : utf8.s - -# target to generate assembly for a file -utf8.c.s: - $(MAKE) $(MAKESILENT) -f CMakeFiles/vterm-module.dir/build.make CMakeFiles/vterm-module.dir/utf8.c.s -.PHONY : utf8.c.s - -vterm-module.o: vterm-module.c.o -.PHONY : vterm-module.o - -# target to build an object file -vterm-module.c.o: - $(MAKE) $(MAKESILENT) -f CMakeFiles/vterm-module.dir/build.make CMakeFiles/vterm-module.dir/vterm-module.c.o -.PHONY : vterm-module.c.o - -vterm-module.i: vterm-module.c.i -.PHONY : vterm-module.i - -# target to preprocess a source file -vterm-module.c.i: - $(MAKE) $(MAKESILENT) -f CMakeFiles/vterm-module.dir/build.make CMakeFiles/vterm-module.dir/vterm-module.c.i -.PHONY : vterm-module.c.i - -vterm-module.s: vterm-module.c.s -.PHONY : vterm-module.s - -# target to generate assembly for a file -vterm-module.c.s: - $(MAKE) $(MAKESILENT) -f CMakeFiles/vterm-module.dir/build.make CMakeFiles/vterm-module.dir/vterm-module.c.s -.PHONY : vterm-module.c.s - -# Help Target -help: - @echo "The following are some of the valid targets for this Makefile:" - @echo "... all (the default if no target is provided)" - @echo "... clean" - @echo "... depend" - @echo "... edit_cache" - @echo "... rebuild_cache" - @echo "... libvterm" - @echo "... run" - @echo "... vterm-module" - @echo "... elisp.o" - @echo "... elisp.i" - @echo "... elisp.s" - @echo "... utf8.o" - @echo "... utf8.i" - @echo "... utf8.s" - @echo "... vterm-module.o" - @echo "... vterm-module.i" - @echo "... vterm-module.s" -.PHONY : help - - - -#============================================================================= -# Special targets to cleanup operation of make. - -# Special rule to run CMake to check the build system integrity. -# No rule that depends on this can have commands that come from listfiles -# because they might be regenerated. -cmake_check_build_system: - $(CMAKE_COMMAND) -S$(CMAKE_SOURCE_DIR) -B$(CMAKE_BINARY_DIR) --check-build-system CMakeFiles/Makefile.cmake 0 -.PHONY : cmake_check_build_system - diff --git a/emacs/elpa/vterm-20240825.133/build/cmake_install.cmake b/emacs/elpa/vterm-20240825.133/build/cmake_install.cmake @@ -1,62 +0,0 @@ -# Install script for directory: /home/dwrz/.config/emacs/elpa/vterm-20240825.133 - -# Set the install prefix -if(NOT DEFINED CMAKE_INSTALL_PREFIX) - set(CMAKE_INSTALL_PREFIX "/usr/local") -endif() -string(REGEX REPLACE "/$" "" CMAKE_INSTALL_PREFIX "${CMAKE_INSTALL_PREFIX}") - -# Set the install configuration name. -if(NOT DEFINED CMAKE_INSTALL_CONFIG_NAME) - if(BUILD_TYPE) - string(REGEX REPLACE "^[^A-Za-z0-9_]+" "" - CMAKE_INSTALL_CONFIG_NAME "${BUILD_TYPE}") - else() - set(CMAKE_INSTALL_CONFIG_NAME "RelWithDebInfo") - endif() - message(STATUS "Install configuration: \"${CMAKE_INSTALL_CONFIG_NAME}\"") -endif() - -# Set the component getting installed. -if(NOT CMAKE_INSTALL_COMPONENT) - if(COMPONENT) - message(STATUS "Install component: \"${COMPONENT}\"") - set(CMAKE_INSTALL_COMPONENT "${COMPONENT}") - else() - set(CMAKE_INSTALL_COMPONENT) - endif() -endif() - -# Install shared libraries without execute permission? -if(NOT DEFINED CMAKE_INSTALL_SO_NO_EXE) - set(CMAKE_INSTALL_SO_NO_EXE "0") -endif() - -# Is this installation the result of a crosscompile? -if(NOT DEFINED CMAKE_CROSSCOMPILING) - set(CMAKE_CROSSCOMPILING "FALSE") -endif() - -# Set path to fallback-tool for dependency-resolution. -if(NOT DEFINED CMAKE_OBJDUMP) - set(CMAKE_OBJDUMP "/usr/bin/objdump") -endif() - -if(CMAKE_INSTALL_COMPONENT) - if(CMAKE_INSTALL_COMPONENT MATCHES "^[a-zA-Z0-9_.+-]+$") - set(CMAKE_INSTALL_MANIFEST "install_manifest_${CMAKE_INSTALL_COMPONENT}.txt") - else() - string(MD5 CMAKE_INST_COMP_HASH "${CMAKE_INSTALL_COMPONENT}") - set(CMAKE_INSTALL_MANIFEST "install_manifest_${CMAKE_INST_COMP_HASH}.txt") - unset(CMAKE_INST_COMP_HASH) - endif() -else() - set(CMAKE_INSTALL_MANIFEST "install_manifest.txt") -endif() - -if(NOT CMAKE_INSTALL_LOCAL_ONLY) - string(REPLACE ";" "\n" CMAKE_INSTALL_MANIFEST_CONTENT - "${CMAKE_INSTALL_MANIFEST_FILES}") - file(WRITE "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/${CMAKE_INSTALL_MANIFEST}" - "${CMAKE_INSTALL_MANIFEST_CONTENT}") -endif() diff --git a/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm b/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm @@ -1 +0,0 @@ -Subproject commit 64f1775952dbe001e989f2ab679563b54f2fca55 diff --git a/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-build b/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-build diff --git a/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-configure b/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-configure diff --git a/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-done b/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-done diff --git a/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-download b/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-download diff --git a/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-gitclone-lastrun.txt b/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-gitclone-lastrun.txt @@ -1,15 +0,0 @@ -# This is a generated file and its contents are an internal implementation detail. -# The download step will be re-executed if anything in this file changes. -# No other meaning or use of this file is supported. - -method=git -command=/usr/bin/cmake;-DCMAKE_MESSAGE_LOG_LEVEL=VERBOSE;-P;/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/tmp/libvterm-gitclone.cmake -source_dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm -work_dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src -repository=https://github.com/Sbozzolo/libvterm-mirror.git -remote=origin -init_submodules=TRUE -recurse_submodules=--recursive -submodules= -CMP0097= - diff --git a/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-gitinfo.txt b/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-gitinfo.txt @@ -1,15 +0,0 @@ -# This is a generated file and its contents are an internal implementation detail. -# The download step will be re-executed if anything in this file changes. -# No other meaning or use of this file is supported. - -method=git -command=/usr/bin/cmake;-DCMAKE_MESSAGE_LOG_LEVEL=VERBOSE;-P;/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/tmp/libvterm-gitclone.cmake -source_dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm -work_dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src -repository=https://github.com/Sbozzolo/libvterm-mirror.git -remote=origin -init_submodules=TRUE -recurse_submodules=--recursive -submodules= -CMP0097= - diff --git a/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-install b/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-install diff --git a/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-mkdir b/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-mkdir diff --git a/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-patch b/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-patch diff --git a/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-patch-info.txt b/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-patch-info.txt @@ -1,6 +0,0 @@ -# This is a generated file and its contents are an internal implementation detail. -# The update step will be re-executed if anything in this file changes. -# No other meaning or use of this file is supported. - -command= -work_dir= diff --git a/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-update-info.txt b/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-update-info.txt @@ -1,7 +0,0 @@ -# This is a generated file and its contents are an internal implementation detail. -# The patch step will be re-executed if anything in this file changes. -# No other meaning or use of this file is supported. - -command (connected)=/usr/bin/cmake;-Dcan_fetch=YES;-DCMAKE_MESSAGE_LOG_LEVEL=VERBOSE;-P;/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/tmp/libvterm-gitupdate.cmake -command (disconnected)=/usr/bin/cmake;-Dcan_fetch=NO;-DCMAKE_MESSAGE_LOG_LEVEL=VERBOSE;-P;/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/tmp/libvterm-gitupdate.cmake -work_dir=/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm diff --git a/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/tmp/libvterm-cfgcmd.txt b/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/tmp/libvterm-cfgcmd.txt @@ -1 +0,0 @@ -cmd='' diff --git a/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/tmp/libvterm-gitclone.cmake b/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/tmp/libvterm-gitclone.cmake @@ -1,87 +0,0 @@ -# Distributed under the OSI-approved BSD 3-Clause License. See accompanying -# file Copyright.txt or https://cmake.org/licensing for details. - -cmake_minimum_required(VERSION 3.5) - -if(EXISTS "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-gitclone-lastrun.txt" AND EXISTS "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-gitinfo.txt" AND - "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-gitclone-lastrun.txt" IS_NEWER_THAN "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-gitinfo.txt") - message(VERBOSE - "Avoiding repeated git clone, stamp file is up to date: " - "'/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-gitclone-lastrun.txt'" - ) - return() -endif() - -# Even at VERBOSE level, we don't want to see the commands executed, but -# enabling them to be shown for DEBUG may be useful to help diagnose problems. -cmake_language(GET_MESSAGE_LOG_LEVEL active_log_level) -if(active_log_level MATCHES "DEBUG|TRACE") - set(maybe_show_command COMMAND_ECHO STDOUT) -else() - set(maybe_show_command "") -endif() - -execute_process( - COMMAND ${CMAKE_COMMAND} -E rm -rf "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - RESULT_VARIABLE error_code - ${maybe_show_command} -) -if(error_code) - message(FATAL_ERROR "Failed to remove directory: '/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm'") -endif() - -# try the clone 3 times in case there is an odd git clone issue -set(error_code 1) -set(number_of_tries 0) -while(error_code AND number_of_tries LESS 3) - execute_process( - COMMAND "/usr/bin/git" - clone --no-checkout --config "advice.detachedHead=false" "https://github.com/Sbozzolo/libvterm-mirror.git" "libvterm" - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src" - RESULT_VARIABLE error_code - ${maybe_show_command} - ) - math(EXPR number_of_tries "${number_of_tries} + 1") -endwhile() -if(number_of_tries GREATER 1) - message(NOTICE "Had to git clone more than once: ${number_of_tries} times.") -endif() -if(error_code) - message(FATAL_ERROR "Failed to clone repository: 'https://github.com/Sbozzolo/libvterm-mirror.git'") -endif() - -execute_process( - COMMAND "/usr/bin/git" - checkout "64f1775952dbe001e989f2ab679563b54f2fca55" -- - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - RESULT_VARIABLE error_code - ${maybe_show_command} -) -if(error_code) - message(FATAL_ERROR "Failed to checkout tag: '64f1775952dbe001e989f2ab679563b54f2fca55'") -endif() - -set(init_submodules TRUE) -if(init_submodules) - execute_process( - COMMAND "/usr/bin/git" - submodule update --recursive --init - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - RESULT_VARIABLE error_code - ${maybe_show_command} - ) -endif() -if(error_code) - message(FATAL_ERROR "Failed to update submodules in: '/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm'") -endif() - -# Complete success, update the script-last-run stamp file: -# -execute_process( - COMMAND ${CMAKE_COMMAND} -E copy "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-gitinfo.txt" "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-gitclone-lastrun.txt" - RESULT_VARIABLE error_code - ${maybe_show_command} -) -if(error_code) - message(FATAL_ERROR "Failed to copy script-last-run stamp file: '/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/libvterm-gitclone-lastrun.txt'") -endif() diff --git a/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/tmp/libvterm-gitupdate.cmake b/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/tmp/libvterm-gitupdate.cmake @@ -1,317 +0,0 @@ -# Distributed under the OSI-approved BSD 3-Clause License. See accompanying -# file Copyright.txt or https://cmake.org/licensing for details. - -cmake_minimum_required(VERSION 3.5) - -# Even at VERBOSE level, we don't want to see the commands executed, but -# enabling them to be shown for DEBUG may be useful to help diagnose problems. -cmake_language(GET_MESSAGE_LOG_LEVEL active_log_level) -if(active_log_level MATCHES "DEBUG|TRACE") - set(maybe_show_command COMMAND_ECHO STDOUT) -else() - set(maybe_show_command "") -endif() - -function(do_fetch) - message(VERBOSE "Fetching latest from the remote origin") - execute_process( - COMMAND "/usr/bin/git" --git-dir=.git fetch --tags --force "origin" - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - COMMAND_ERROR_IS_FATAL LAST - ${maybe_show_command} - ) -endfunction() - -function(get_hash_for_ref ref out_var err_var) - execute_process( - COMMAND "/usr/bin/git" --git-dir=.git rev-parse "${ref}^0" - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - RESULT_VARIABLE error_code - OUTPUT_VARIABLE ref_hash - ERROR_VARIABLE error_msg - OUTPUT_STRIP_TRAILING_WHITESPACE - ) - if(error_code) - set(${out_var} "" PARENT_SCOPE) - else() - set(${out_var} "${ref_hash}" PARENT_SCOPE) - endif() - set(${err_var} "${error_msg}" PARENT_SCOPE) -endfunction() - -get_hash_for_ref(HEAD head_sha error_msg) -if(head_sha STREQUAL "") - message(FATAL_ERROR "Failed to get the hash for HEAD:\n${error_msg}") -endif() - -if("${can_fetch}" STREQUAL "") - set(can_fetch "YES") -endif() - -execute_process( - COMMAND "/usr/bin/git" --git-dir=.git show-ref "64f1775952dbe001e989f2ab679563b54f2fca55" - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - OUTPUT_VARIABLE show_ref_output -) -if(show_ref_output MATCHES "^[a-z0-9]+[ \\t]+refs/remotes/") - # Given a full remote/branch-name and we know about it already. Since - # branches can move around, we should always fetch, if permitted. - if(can_fetch) - do_fetch() - endif() - set(checkout_name "64f1775952dbe001e989f2ab679563b54f2fca55") - -elseif(show_ref_output MATCHES "^[a-z0-9]+[ \\t]+refs/tags/") - # Given a tag name that we already know about. We don't know if the tag we - # have matches the remote though (tags can move), so we should fetch. As a - # special case to preserve backward compatibility, if we are already at the - # same commit as the tag we hold locally, don't do a fetch and assume the tag - # hasn't moved on the remote. - # FIXME: We should provide an option to always fetch for this case - get_hash_for_ref("64f1775952dbe001e989f2ab679563b54f2fca55" tag_sha error_msg) - if(tag_sha STREQUAL head_sha) - message(VERBOSE "Already at requested tag: 64f1775952dbe001e989f2ab679563b54f2fca55") - return() - endif() - - if(can_fetch) - do_fetch() - endif() - set(checkout_name "64f1775952dbe001e989f2ab679563b54f2fca55") - -elseif(show_ref_output MATCHES "^[a-z0-9]+[ \\t]+refs/heads/") - # Given a branch name without any remote and we already have a branch by that - # name. We might already have that branch checked out or it might be a - # different branch. It isn't fully safe to use a bare branch name without the - # remote, so do a fetch (if allowed) and replace the ref with one that - # includes the remote. - if(can_fetch) - do_fetch() - endif() - set(checkout_name "origin/64f1775952dbe001e989f2ab679563b54f2fca55") - -else() - get_hash_for_ref("64f1775952dbe001e989f2ab679563b54f2fca55" tag_sha error_msg) - if(tag_sha STREQUAL head_sha) - # Have the right commit checked out already - message(VERBOSE "Already at requested ref: ${tag_sha}") - return() - - elseif(tag_sha STREQUAL "") - # We don't know about this ref yet, so we have no choice but to fetch. - if(NOT can_fetch) - message(FATAL_ERROR - "Requested git ref \"64f1775952dbe001e989f2ab679563b54f2fca55\" is not present locally, and not " - "allowed to contact remote due to UPDATE_DISCONNECTED setting." - ) - endif() - - # We deliberately swallow any error message at the default log level - # because it can be confusing for users to see a failed git command. - # That failure is being handled here, so it isn't an error. - if(NOT error_msg STREQUAL "") - message(DEBUG "${error_msg}") - endif() - do_fetch() - set(checkout_name "64f1775952dbe001e989f2ab679563b54f2fca55") - - else() - # We have the commit, so we know we were asked to find a commit hash - # (otherwise it would have been handled further above), but we don't - # have that commit checked out yet. We don't need to fetch from the remote. - set(checkout_name "64f1775952dbe001e989f2ab679563b54f2fca55") - if(NOT error_msg STREQUAL "") - message(WARNING "${error_msg}") - endif() - - endif() -endif() - -set(git_update_strategy "REBASE") -if(git_update_strategy STREQUAL "") - # Backward compatibility requires REBASE as the default behavior - set(git_update_strategy REBASE) -endif() - -if(git_update_strategy MATCHES "^REBASE(_CHECKOUT)?$") - # Asked to potentially try to rebase first, maybe with fallback to checkout. - # We can't if we aren't already on a branch and we shouldn't if that local - # branch isn't tracking the one we want to checkout. - execute_process( - COMMAND "/usr/bin/git" --git-dir=.git symbolic-ref -q HEAD - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - OUTPUT_VARIABLE current_branch - OUTPUT_STRIP_TRAILING_WHITESPACE - # Don't test for an error. If this isn't a branch, we get a non-zero error - # code but empty output. - ) - - if(current_branch STREQUAL "") - # Not on a branch, checkout is the only sensible option since any rebase - # would always fail (and backward compatibility requires us to checkout in - # this situation) - set(git_update_strategy CHECKOUT) - - else() - execute_process( - COMMAND "/usr/bin/git" --git-dir=.git for-each-ref "--format=%(upstream:short)" "${current_branch}" - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - OUTPUT_VARIABLE upstream_branch - OUTPUT_STRIP_TRAILING_WHITESPACE - COMMAND_ERROR_IS_FATAL ANY # There is no error if no upstream is set - ) - if(NOT upstream_branch STREQUAL checkout_name) - # Not safe to rebase when asked to checkout a different branch to the one - # we are tracking. If we did rebase, we could end up with arbitrary - # commits added to the ref we were asked to checkout if the current local - # branch happens to be able to rebase onto the target branch. There would - # be no error message and the user wouldn't know this was occurring. - set(git_update_strategy CHECKOUT) - endif() - - endif() -elseif(NOT git_update_strategy STREQUAL "CHECKOUT") - message(FATAL_ERROR "Unsupported git update strategy: ${git_update_strategy}") -endif() - - -# Check if stash is needed -execute_process( - COMMAND "/usr/bin/git" --git-dir=.git status --porcelain - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - RESULT_VARIABLE error_code - OUTPUT_VARIABLE repo_status -) -if(error_code) - message(FATAL_ERROR "Failed to get the status") -endif() -string(LENGTH "${repo_status}" need_stash) - -# If not in clean state, stash changes in order to be able to perform a -# rebase or checkout without losing those changes permanently -if(need_stash) - execute_process( - COMMAND "/usr/bin/git" --git-dir=.git stash save --quiet;--include-untracked - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - COMMAND_ERROR_IS_FATAL ANY - ${maybe_show_command} - ) -endif() - -if(git_update_strategy STREQUAL "CHECKOUT") - execute_process( - COMMAND "/usr/bin/git" --git-dir=.git checkout "${checkout_name}" - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - COMMAND_ERROR_IS_FATAL ANY - ${maybe_show_command} - ) -else() - execute_process( - COMMAND "/usr/bin/git" --git-dir=.git rebase "${checkout_name}" - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - RESULT_VARIABLE error_code - OUTPUT_VARIABLE rebase_output - ERROR_VARIABLE rebase_output - ) - if(error_code) - # Rebase failed, undo the rebase attempt before continuing - execute_process( - COMMAND "/usr/bin/git" --git-dir=.git rebase --abort - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - ${maybe_show_command} - ) - - if(NOT git_update_strategy STREQUAL "REBASE_CHECKOUT") - # Not allowed to do a checkout as a fallback, so cannot proceed - if(need_stash) - execute_process( - COMMAND "/usr/bin/git" --git-dir=.git stash pop --index --quiet - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - ${maybe_show_command} - ) - endif() - message(FATAL_ERROR "\nFailed to rebase in: '/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm'." - "\nOutput from the attempted rebase follows:" - "\n${rebase_output}" - "\n\nYou will have to resolve the conflicts manually") - endif() - - # Fall back to checkout. We create an annotated tag so that the user - # can manually inspect the situation and revert if required. - # We can't log the failed rebase output because MSVC sees it and - # intervenes, causing the build to fail even though it completes. - # Write it to a file instead. - string(TIMESTAMP tag_timestamp "%Y%m%dT%H%M%S" UTC) - set(tag_name _cmake_ExternalProject_moved_from_here_${tag_timestamp}Z) - set(error_log_file ${CMAKE_CURRENT_LIST_DIR}/rebase_error_${tag_timestamp}Z.log) - file(WRITE ${error_log_file} "${rebase_output}") - message(WARNING "Rebase failed, output has been saved to ${error_log_file}" - "\nFalling back to checkout, previous commit tagged as ${tag_name}") - execute_process( - COMMAND "/usr/bin/git" --git-dir=.git tag -a - -m "ExternalProject attempting to move from here to ${checkout_name}" - ${tag_name} - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - COMMAND_ERROR_IS_FATAL ANY - ${maybe_show_command} - ) - - execute_process( - COMMAND "/usr/bin/git" --git-dir=.git checkout "${checkout_name}" - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - COMMAND_ERROR_IS_FATAL ANY - ${maybe_show_command} - ) - endif() -endif() - -if(need_stash) - # Put back the stashed changes - execute_process( - COMMAND "/usr/bin/git" --git-dir=.git stash pop --index --quiet - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - RESULT_VARIABLE error_code - ${maybe_show_command} - ) - if(error_code) - # Stash pop --index failed: Try again dropping the index - execute_process( - COMMAND "/usr/bin/git" --git-dir=.git reset --hard --quiet - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - ${maybe_show_command} - ) - execute_process( - COMMAND "/usr/bin/git" --git-dir=.git stash pop --quiet - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - RESULT_VARIABLE error_code - ${maybe_show_command} - ) - if(error_code) - # Stash pop failed: Restore previous state. - execute_process( - COMMAND "/usr/bin/git" --git-dir=.git reset --hard --quiet ${head_sha} - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - ${maybe_show_command} - ) - execute_process( - COMMAND "/usr/bin/git" --git-dir=.git stash pop --index --quiet - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - ${maybe_show_command} - ) - message(FATAL_ERROR "\nFailed to unstash changes in: '/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm'." - "\nYou will have to resolve the conflicts manually") - endif() - endif() -endif() - -set(init_submodules "TRUE") -if(init_submodules) - execute_process( - COMMAND "/usr/bin/git" - --git-dir=.git - submodule update --recursive --init - WORKING_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm" - COMMAND_ERROR_IS_FATAL ANY - ${maybe_show_command} - ) -endif() diff --git a/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/tmp/libvterm-mkdirs.cmake b/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/tmp/libvterm-mkdirs.cmake @@ -1,27 +0,0 @@ -# Distributed under the OSI-approved BSD 3-Clause License. See accompanying -# file Copyright.txt or https://cmake.org/licensing for details. - -cmake_minimum_required(VERSION 3.5) - -# If CMAKE_DISABLE_SOURCE_CHANGES is set to true and the source directory is an -# existing directory in our source tree, calling file(MAKE_DIRECTORY) on it -# would cause a fatal error, even though it would be a no-op. -if(NOT EXISTS "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm") - file(MAKE_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm") -endif() -file(MAKE_DIRECTORY - "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-build" - "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix" - "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/tmp" - "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp" - "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src" - "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp" -) - -set(configSubDirs ) -foreach(subDir IN LISTS configSubDirs) - file(MAKE_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp/${subDir}") -endforeach() -if(cfgdir) - file(MAKE_DIRECTORY "/home/dwrz/.config/emacs/elpa/vterm-20240825.133/build/libvterm-prefix/src/libvterm-stamp${cfgdir}") # cfgdir has leading slash -endif() diff --git a/emacs/elpa/vterm-20240825.133/vterm-module.so b/emacs/elpa/vterm-20240825.133/vterm-module.so Binary files differ. diff --git a/emacs/elpa/vterm-20240825.133/vterm-pkg.el b/emacs/elpa/vterm-20240825.133/vterm-pkg.el @@ -1,14 +0,0 @@ -(define-package "vterm" "20240825.133" "Fully-featured terminal emulator" - '((emacs "25.1")) - :commit "988279316fc89e6d78947b48513f248597ba969a" :authors - '(("Lukas Fürmetz" . "fuermetz@mailbox.org")) - :maintainers - '(("Lukas Fürmetz" . "fuermetz@mailbox.org")) - :maintainer - '("Lukas Fürmetz" . "fuermetz@mailbox.org") - :keywords - '("terminals") - :url "https://github.com/akermu/emacs-libvterm") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/emacs/elpa/vterm-20240825.133/vterm.el b/emacs/elpa/vterm-20240825.133/vterm.el @@ -1,1890 +0,0 @@ -;;; vterm.el --- Fully-featured terminal emulator -*- lexical-binding: t; -*- - -;; Copyright (C) 2017-2020 by Lukas Fürmetz & Contributors -;; -;; Author: Lukas Fürmetz <fuermetz@mailbox.org> -;; Version: 0.0.2 -;; URL: https://github.com/akermu/emacs-libvterm -;; Keywords: terminals -;; Package-Requires: ((emacs "25.1")) - - -;; This file is not part of GNU Emacs. - -;; This file 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 2, or (at your option) -;; any later version. - -;; This file 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: -;; -;; Emacs-libvterm (vterm) is fully-fledged terminal emulator based on an -;; external library (libvterm) loaded as a dynamic module. As a result of using -;; compiled code (instead of elisp), emacs-libvterm is fully capable, fast, and -;; it can seamlessly handle large outputs. - -;;; Installation - -;; Emacs-libvterm requires support for loading modules. You can check if your -;; Emacs supports modules by inspecting the variable module-file-suffix. If it -;; nil, than, you need to recompile Emacs or obtain a copy of Emacs with this -;; option enabled. - -;; Emacs-libvterm requires CMake and libvterm. If libvterm is not available, -;; emacs-libvterm will downloaded and compiled. In this case, libtool is -;; needed. - -;; The reccomended way to install emacs-libvterm is from MELPA. - -;;; Usage - -;; To open a terminal, simply use the command M-x vterm. - -;;; Tips and tricks - -;; Adding some shell-side configuration enables a large set of additional -;; features, including, directory tracking, prompt recognition, message passing. - -;;; Code: - -(require 'term/xterm) - -(unless module-file-suffix - (error "VTerm needs module support. Please compile Emacs with - the --with-modules option!")) - -(defvar vterm-copy-mode) - -;;; Compilation of the module - -(defcustom vterm-module-cmake-args "" - "Arguments given to CMake to compile vterm-module. - -Currently, vterm defines the following flags (in addition to the -ones already available in CMake): - -`USE_SYSTEM_LIBVTERM'. Set it to `Off' to use the vendored version of -libvterm instead of the one installed on your system. - -This string is given verbatim to CMake, so it has to have the -correct syntax. An example of meaningful value for this variable -is `-DUSE_SYSTEM_LIBVTERM=Off'." - :type 'string - :group 'vterm) - -(defcustom vterm-always-compile-module nil - "If not nil, if `vterm-module' is not found, compile it without asking. - -When `vterm-always-compile-module' is nil, vterm will ask for -confirmation before compiling." - :type 'boolean - :group 'vterm) - -(defvar vterm-install-buffer-name " *Install vterm* " - "Name of the buffer used for compiling vterm-module.") - -(defun vterm-module--cmake-is-available () - "Return t if cmake is available. -CMake is needed to build vterm, here we check that we can find -the executable." - - (unless (executable-find "cmake") - (error "Vterm needs CMake to be compiled. Please, install CMake")) - t) - -;;;###autoload -(defun vterm-module-compile () - "Compile vterm-module." - (interactive) - (when (vterm-module--cmake-is-available) - (let* ((vterm-directory - (shell-quote-argument - ;; NOTE: This is a workaround to fix an issue with how the Emacs - ;; feature/native-comp branch changes the result of - ;; `(locate-library "vterm")'. See emacs-devel thread - ;; https://lists.gnu.org/archive/html/emacs-devel/2020-07/msg00306.html - ;; for a discussion. - (file-name-directory (locate-library "vterm.el" t)))) - (make-commands - (concat - "cd " vterm-directory "; \ - mkdir -p build; \ - cd build; \ - cmake -G 'Unix Makefiles' " - vterm-module-cmake-args - " ..; \ - make; \ - cd -")) - (buffer (get-buffer-create vterm-install-buffer-name))) - (pop-to-buffer buffer) - (compilation-mode) - (if (zerop (let ((inhibit-read-only t)) - (call-process "sh" nil buffer t "-c" make-commands))) - (message "Compilation of `emacs-libvterm' module succeeded") - (error "Compilation of `emacs-libvterm' module failed!"))))) - -;; If the vterm-module is not compiled yet, compile it -(unless (require 'vterm-module nil t) - (if (or vterm-always-compile-module - (y-or-n-p "Vterm needs `vterm-module' to work. Compile it now? ")) - (progn - (vterm-module-compile) - (require 'vterm-module)) - (error "Vterm will not work until `vterm-module' is compiled!"))) - -;;; Dependencies - -;; Generate this list with: -;; awk -F\" '/bind_function*/ {print "(declare-function", $2, "\"vterm-module\")"}' vterm-module.c -(declare-function vterm--new "vterm-module") -(declare-function vterm--update "vterm-module") -(declare-function vterm--redraw "vterm-module") -(declare-function vterm--write-input "vterm-module") -(declare-function vterm--set-size "vterm-module") -(declare-function vterm--set-pty-name "vterm-module") -(declare-function vterm--get-pwd-raw "vterm-module") -(declare-function vterm--reset-point "vterm-module") -(declare-function vterm--get-icrnl "vterm-module") - -(require 'subr-x) -(require 'find-func) -(require 'cl-lib) -(require 'term) -(require 'color) -(require 'compile) -(require 'face-remap) -(require 'tramp) -(require 'bookmark) - -;;; Options - -(defcustom vterm-shell shell-file-name - "The shell that gets run in the vterm." - :type 'string - :group 'vterm) - -(defcustom vterm-tramp-shells '(("docker" "/bin/sh")) - "The shell that gets run in the vterm for tramp. - -`vterm-tramp-shells' has to be a list of pairs of the format: -\(TRAMP-METHOD SHELL)" - :type '(alist :key-type string :value-type string) - :group 'vterm) - -(defcustom vterm-buffer-name "*vterm*" - "The basename used for vterm buffers. -This is the default name used when running `vterm' or -`vterm-other-window'. - -With a numeric prefix argument to `vterm', the buffer name will -be the value of this variable followed by the number. For -example, with the numeric prefix argument 2, the buffer would be -named \"*vterm*<2>\"." - :type 'string - :group 'vterm) - -(defcustom vterm-max-scrollback 1000 - "Maximum \\='scrollback\\=' value. - -The maximum allowed is 100000. This value can modified by -changing the SB_MAX variable in vterm-module.h and recompiling -the module." - :type 'number - :group 'vterm) - -(defcustom vterm-min-window-width 80 - "Minimum window width." - :type 'number - :group 'vterm) - -(defcustom vterm-kill-buffer-on-exit t - "If not nil vterm buffers are killed when the attached process is terminated. - -If `vterm-kill-buffer-on-exit' is set to t, when the process -associated to a vterm buffer quits, the buffer is killed. When -nil, the buffer will still be available as if it were in -`fundamental-mode'." - :type 'boolean - :group 'vterm) - -(define-obsolete-variable-alias 'vterm-clear-scrollback - 'vterm-clear-scrollback-when-clearing "0.0.1") - -(define-obsolete-variable-alias 'vterm-use-vterm-prompt - 'vterm-use-vterm-prompt-detection-method "0.0.1") - -(defcustom vterm-clear-scrollback-when-clearing nil - "If not nil `vterm-clear' clears both screen and scrollback. - -The scrollback is everything that is not current visible on -screen in vterm buffers. - -If `vterm-clear-scrollback-when-clearing' is nil, `vterm-clear' -clears only the screen, so the scrollback is accessible moving -the point up." - :type 'boolean - :group 'vterm) - -(defcustom vterm-keymap-exceptions - '("C-c" "C-x" "C-u" "C-g" "C-h" "C-l" "M-x" "M-o" "C-y" "M-y") - "Exceptions for `vterm-keymap'. - -If you use a keybinding with a prefix-key, add that prefix-key to -this list. Note that after doing so that prefix-key cannot be sent -to the terminal anymore. - -The mapping is done by the macro `vterm-define-key', and the -function `vterm--exclude-keys' removes the keybindings defined in -`vterm-keymap-exceptions'." - :type '(repeat string) - :set (lambda (sym val) - (set sym val) - (when (and (fboundp 'vterm--exclude-keys) - (boundp 'vterm-mode-map)) - (vterm--exclude-keys vterm-mode-map val))) - :group 'vterm) - -(defcustom vterm-exit-functions nil - "List of functions called when a vterm process exits. - -Each function is called with two arguments: the vterm buffer of -the process if any, and a string describing the event passed from -the sentinel. - -This hook applies only to new vterms, created after setting this -value with `add-hook'. - -Note that this hook will not work if another package like -`shell-pop' sets its own sentinel to the `vterm' process." - :type 'hook - :group 'vterm) - -(make-obsolete-variable 'vterm-set-title-functions - "This variable was substituted by `vterm-buffer-name-string'." - "0.0.1") - -(defcustom vterm-buffer-name-string nil - "Format string for the title of vterm buffers. - -If `vterm-buffer-name-string' is nil, vterm will not set the -title of its buffers. If not nil, `vterm-buffer-name-string' has -to be a format control string (see `format') containing one -instance of %s which will be substituted with the string TITLE. -The argument TITLE is provided by the shell. This requires shell -side configuration. - -For example, if `vterm-buffer-name-string' is set to \"vterm %s\", -and the shell properly configured to set TITLE=$(pwd), than vterm -buffers will be named \"vterm\" followed by the current path. - -See URL http://tldp.org/HOWTO/Xterm-Title-4.html for additional -information on the how to configure the shell." - :type 'string - :group 'vterm) - -(defcustom vterm-term-environment-variable "xterm-256color" - "TERM value for terminal." - :type 'string - :group 'vterm) - -(defcustom vterm-environment nil - "List of extra environment variables to the vterm shell processes only. - -demo: \\='(\"env1=v1\" \"env2=v2\")" - :type '(repeat string) - :group 'vterm) - - -(defcustom vterm-enable-manipulate-selection-data-by-osc52 nil - "Support OSC 52 MANIPULATE SELECTION DATA(libvterm 0.2 is needed). - -Support copy text to Emacs kill ring and system clipboard by using OSC 52. -For example: send base64 encoded \\='foo\\=' to kill ring: echo -en \\='\\e]52;c;Zm9v\\a\\=', -tmux can share its copy buffer to terminals by supporting osc52(like iterm2 - xterm) you can enable this feature for tmux by : -set -g set-clipboard on #osc 52 copy paste share with iterm -set -ga terminal-overrides \\=',xterm*:XT:Ms=\\E]52;%p1%s;%p2%s\\007\\=' -set -ga terminal-overrides \\=',screen*:XT:Ms=\\E]52;%p1%s;%p2%s\\007\\=' - -The clipboard querying/clearing functionality offered by OSC 52 is not -implemented here,And for security reason, this feature is disabled -by default." - :type 'boolean - :group 'vterm) - -;; TODO: Improve doc string, it should not point to the readme but it should -;; be self-contained. -(defcustom vterm-eval-cmds '(("find-file" find-file) - ("message" message) - ("vterm-clear-scrollback" vterm-clear-scrollback)) - "Whitelisted Emacs functions that can be executed from vterm. - -You can execute Emacs functions directly from vterm buffers. To do this, -you have to escape the name of the function and its arguments with \e]51;E. - -See Message passing in README. - -The function you want to execute has to be in `vterm-eval-cmds'. - -`vterm-eval-cmds' has to be a list of pairs of the format: -\(NAME-OF-COMMAND-IN-SHELL EMACS-FUNCTION) - -The need for an explicit map is to avoid arbitrary code execution." - :type '(alist :key-type string) - :group 'vterm) - -(defcustom vterm-disable-underline nil - "When not-nil, underline text properties are ignored. - -This means that vterm will render underlined text as if it was not -underlined." - :type 'boolean - :group 'vterm) - -(defcustom vterm-disable-inverse-video nil - "When not-nil, inverse video text properties are ignored. - -This means that vterm will render reversed video text as if it was not -such." - :type 'boolean - :group 'vterm) - -(define-obsolete-variable-alias 'vterm-disable-bold-font - 'vterm-disable-bold "0.0.1") - -(defcustom vterm-disable-bold-font nil - "When not-nil, bold text properties are ignored. - -This means that vterm will render bold with the default face weight." - :type 'boolean - :group 'vterm) - -(defcustom vterm-set-bold-hightbright nil - "When not-nil, using hightbright colors for bolded text, see #549." - :type 'boolean - :group 'vterm) - -(defcustom vterm-ignore-blink-cursor t - "When t, vterm will ignore request from application to turn on/off cursor blink. - -If nil, cursor in any window may begin to blink or not blink because -`blink-cursor-mode`is a global minor mode in Emacs, -you can use `M-x blink-cursor-mode` to toggle." - :type 'boolean - :group 'vterm) - -(defcustom vterm-copy-exclude-prompt t - "When not-nil, the prompt is not included by `vterm-copy-mode-done'." - :type 'boolean - :group 'vterm) - -(defcustom vterm-use-vterm-prompt-detection-method t - "When not-nil, the prompt is detected through the shell. - -Vterm needs to know where the shell prompt is to enable all the -available features. There are two supported ways to do this. -First, the shell can inform vterm on the location of the prompt. -This requires shell-side configuration: the escape code 51;A is -used to set the current directory and prompt location. This -detection method is the most-reliable. To use it, you have -to change your shell prompt to print 51;A. - -The second method is using a regular expression. This method does -not require any shell-side configuration. See -`term-prompt-regexp', for more information." - :type 'boolean - :group 'vterm) - -(defcustom vterm-bookmark-check-dir t - "When set to non-nil, also restore directory when restoring a vterm bookmark." - :type 'boolean - :group 'vterm) - -(defcustom vterm-copy-mode-remove-fake-newlines nil - "When not-nil fake newlines are removed on entering copy mode. - -vterm inserts \\='fake\\=' newlines purely for rendering. When using -vterm-copy-mode these are in conflict with many emacs functions -like isearch-forward. if this varialbe is not-nil the -fake-newlines are removed on entering copy-mode and re-inserted -on leaving copy mode. Also truncate-lines is set to t on entering -copy-mode and set to nil on leaving." - :type 'boolean - :group 'vterm) - -;;; Faces - -(defface vterm-color-black - `((t :inherit term-color-black)) - "Face used to render black color code." - :group 'vterm) - -(defface vterm-color-red - `((t :inherit term-color-red)) - "Face used to render red color code." - :group 'vterm) - -(defface vterm-color-green - `((t :inherit term-color-green)) - "Face used to render green color code." - :group 'vterm) - -(defface vterm-color-yellow - `((t :inherit term-color-yellow)) - "Face used to render yellow color code." - :group 'vterm) - -(defface vterm-color-blue - `((t :inherit term-color-blue)) - "Face used to render blue color code." - :group 'vterm) - -(defface vterm-color-magenta - `((t :inherit term-color-magenta)) - "Face used to render magenta color code." - :group 'vterm) - -(defface vterm-color-cyan - `((t :inherit term-color-cyan)) - "Face used to render cyan color code." - :group 'vterm) - -(defface vterm-color-white - `((t :inherit term-color-white)) - "Face used to render white color code." - :group 'vterm) - -(defface vterm-color-bright-black - `((t :inherit ,(if (facep 'term-color-bright-black) - 'term-color-bright-black - 'term-color-black))) - "Face used to render bright black color code." - :group 'vterm) - -(defface vterm-color-bright-red - `((t :inherit ,(if (facep 'term-color-bright-red) - 'term-color-bright-red - 'term-color-red))) - "Face used to render bright red color code." - :group 'vterm) - -(defface vterm-color-bright-green - `((t :inherit ,(if (facep 'term-color-bright-green) - 'term-color-bright-green - 'term-color-green))) - "Face used to render bright green color code." - :group 'vterm) - -(defface vterm-color-bright-yellow - `((t :inherit ,(if (facep 'term-color-bright-yellow) - 'term-color-bright-yellow - 'term-color-yellow))) - "Face used to render bright yellow color code." - :group 'vterm) - -(defface vterm-color-bright-blue - `((t :inherit ,(if (facep 'term-color-bright-blue) - 'term-color-bright-blue - 'term-color-blue))) - "Face used to render bright blue color code." - :group 'vterm) - -(defface vterm-color-bright-magenta - `((t :inherit ,(if (facep 'term-color-bright-magenta) - 'term-color-bright-magenta - 'term-color-magenta))) - "Face used to render bright magenta color code." - :group 'vterm) - -(defface vterm-color-bright-cyan - `((t :inherit ,(if (facep 'term-color-bright-cyan) - 'term-color-bright-cyan - 'term-color-cyan))) - "Face used to render bright cyan color code." - :group 'vterm) - -(defface vterm-color-bright-white - `((t :inherit ,(if (facep 'term-color-bright-white) - 'term-color-bright-white - 'term-color-white))) - "Face used to render bright white color code." - :group 'vterm) - -(defface vterm-color-underline - `((t :inherit default)) - "Face used to render cells with underline attribute. -Only foreground is used." - :group 'vterm) - -(defface vterm-color-inverse-video - `((t :inherit default)) - "Face used to render cells with inverse video attribute. -Only background is used." - :group 'vterm) - -;;; Variables - -(defvar vterm-color-palette - [vterm-color-black - vterm-color-red - vterm-color-green - vterm-color-yellow - vterm-color-blue - vterm-color-magenta - vterm-color-cyan - vterm-color-white - vterm-color-bright-black - vterm-color-bright-red - vterm-color-bright-green - vterm-color-bright-yellow - vterm-color-bright-blue - vterm-color-bright-magenta - vterm-color-bright-cyan - vterm-color-bright-white] - "Color palette for the foreground and background.") - -(defvar-local vterm--term nil - "Pointer to Term.") - -(defvar-local vterm--process nil - "Shell process of current term.") - -(defvar-local vterm--redraw-timer nil) -(defvar-local vterm--redraw-immididately nil) -(defvar-local vterm--linenum-remapping nil) -(defvar-local vterm--prompt-tracking-enabled-p nil) -(defvar-local vterm--insert-function (symbol-function #'insert)) -(defvar-local vterm--delete-char-function (symbol-function #'delete-char)) -(defvar-local vterm--delete-region-function (symbol-function #'delete-region)) -(defvar-local vterm--undecoded-bytes nil) -(defvar-local vterm--copy-mode-fake-newlines nil) - - -(defvar vterm-timer-delay 0.1 - "Delay for refreshing the buffer after receiving updates from libvterm. - -A larger delary improves performance when receiving large bursts -of data. If nil, never delay. The units are seconds.") - -;;; Keybindings - -;; We have many functions defined by vterm-define-key. Later, we will bind some -;; of the functions. If the following is not evaluated during compilation, the compiler -;; will complain that some functions are not defined (eg, vterm-send-C-c) -(eval-and-compile - (defmacro vterm-define-key (key) - "Define a command that sends KEY with modifiers C and M to vterm." - (declare (indent defun) - (doc-string 3)) - `(progn (defun ,(intern (format "vterm-send-%s" key))() - ,(format "Sends %s to the libvterm." key) - (interactive) - (vterm-send-key ,(char-to-string (get-byte (1- (length key)) key)) - ,(let ((case-fold-search nil)) - (or (string-match-p "[A-Z]$" key) - (string-match-p "S-" key))) - ,(string-match-p "M-" key) - ,(string-match-p "C-" key))) - (make-obsolete ',(intern (format "vterm-send-%s" key)) - "use `vterm--self-insert' or `vterm-send' or `vterm-send-key'." - "v0.1"))) - (make-obsolete 'vterm-define-key "" "v0.1") - (mapc (lambda (key) - (eval `(vterm-define-key ,key))) - (cl-loop for prefix in '("M-") - append (cl-loop for char from ?A to ?Z - for key = (format "%s%c" prefix char) - collect key))) - (mapc (lambda (key) - (eval `(vterm-define-key ,key))) - (cl-loop for prefix in '("C-" "M-" "C-S-") - append (cl-loop for char from ?a to ?z - for key = (format "%s%c" prefix char) - collect key)))) - -;; Function keys and most of C- and M- bindings -(defun vterm--exclude-keys (map exceptions) - "Remove EXCEPTIONS from the keys bound by `vterm-define-keys'. - -Exceptions are defined by `vterm-keymap-exceptions'." - (mapc (lambda (key) - (define-key map (kbd key) nil)) - exceptions) - (mapc (lambda (key) - (define-key map (kbd key) #'vterm--self-insert)) - (cl-loop for number from 1 to 12 - for key = (format "<f%i>" number) - unless (member key exceptions) - collect key)) - (let ((esc-map (lookup-key map "\e")) - (i 0) - key) - (unless esc-map (setq esc-map (make-keymap))) - (while (< i 128) - (setq key (make-string 1 i)) - (unless (member (key-description key) exceptions) - (define-key map key 'vterm--self-insert)) - ;; Avoid O and [. They are used in escape sequences for various keys. - (unless (or (eq i ?O) (eq i 91)) - (unless (member (key-description key "\e") exceptions) - (define-key esc-map key 'vterm--self-insert-meta))) - (setq i (1+ i))) - (define-key map "\e" esc-map))) - -(defun vterm-xterm-paste (event) - "Handle xterm paste EVENT in vterm." - (interactive "e") - (with-temp-buffer - (xterm-paste event) - (kill-new (buffer-string))) - (vterm-yank)) - -(defvar vterm-mode-map - (let ((map (make-sparse-keymap))) - (vterm--exclude-keys map vterm-keymap-exceptions) - (define-key map (kbd "C-]") #'vterm--self-insert) - (define-key map (kbd "M-<") #'vterm--self-insert) - (define-key map (kbd "M->") #'vterm--self-insert) - (define-key map [tab] #'vterm-send-tab) - (define-key map (kbd "TAB") #'vterm-send-tab) - (define-key map [backtab] #'vterm--self-insert) - (define-key map [backspace] #'vterm-send-backspace) - (define-key map (kbd "DEL") #'vterm-send-backspace) - (define-key map [delete] #'vterm-send-delete) - (define-key map [M-backspace] #'vterm-send-meta-backspace) - (define-key map (kbd "M-DEL") #'vterm-send-meta-backspace) - (define-key map [C-backspace] #'vterm-send-meta-backspace) - (define-key map [return] #'vterm-send-return) - (define-key map (kbd "RET") #'vterm-send-return) - (define-key map [C-left] #'vterm--self-insert) - (define-key map [M-left] #'vterm--self-insert) - (define-key map [C-right] #'vterm--self-insert) - (define-key map [M-right] #'vterm--self-insert) - (define-key map [C-up] #'vterm--self-insert) - (define-key map [C-down] #'vterm--self-insert) - (define-key map [M-up] #'vterm--self-insert) - (define-key map [M-down] #'vterm--self-insert) - (define-key map [left] #'vterm--self-insert) - (define-key map [right] #'vterm--self-insert) - (define-key map [up] #'vterm--self-insert) - (define-key map [down] #'vterm--self-insert) - (define-key map [prior] #'vterm--self-insert) - (define-key map [S-prior] #'scroll-down-command) - (define-key map [next] #'vterm--self-insert) - (define-key map [S-next] #'scroll-up-command) - (define-key map [home] #'vterm--self-insert) - (define-key map [end] #'vterm--self-insert) - (define-key map [C-home] #'vterm--self-insert) - (define-key map [C-end] #'vterm--self-insert) - (define-key map [escape] #'vterm--self-insert) - (define-key map [remap yank] #'vterm-yank) - (define-key map [remap xterm-paste] #'vterm-xterm-paste) - (define-key map [remap yank-pop] #'vterm-yank-pop) - (define-key map [remap mouse-yank-primary] #'vterm-yank-primary) - (define-key map [mouse-1] #'vterm-mouse-set-point) - (define-key map (kbd "C-SPC") #'vterm--self-insert) - (define-key map (kbd "S-SPC") #'vterm-send-space) - (define-key map (kbd "C-_") #'vterm--self-insert) - (define-key map [remap undo] #'vterm-undo) - (define-key map (kbd "M-.") #'vterm--self-insert) - (define-key map (kbd "M-,") #'vterm--self-insert) - (define-key map (kbd "C-c C-y") #'vterm--self-insert) - (define-key map (kbd "C-c C-c") #'vterm--self-insert) - (define-key map (kbd "C-c C-l") #'vterm-clear-scrollback) - (define-key map (kbd "C-l") #'vterm-clear) - (define-key map (kbd "C-\\") #'vterm--self-insert) - (define-key map (kbd "C-c C-g") #'vterm--self-insert) - (define-key map (kbd "C-c C-u") #'vterm--self-insert) - (define-key map [remap self-insert-command] #'vterm--self-insert) - (define-key map (kbd "C-c C-r") #'vterm-reset-cursor-point) - (define-key map (kbd "C-c C-n") #'vterm-next-prompt) - (define-key map (kbd "C-c C-p") #'vterm-previous-prompt) - (define-key map (kbd "C-c C-t") #'vterm-copy-mode) - map)) - -(defvar vterm-copy-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-t") #'vterm-copy-mode) - (define-key map [return] #'vterm-copy-mode-done) - (define-key map (kbd "RET") #'vterm-copy-mode-done) - (define-key map (kbd "C-c C-r") #'vterm-reset-cursor-point) - (define-key map (kbd "C-a") #'vterm-beginning-of-line) - (define-key map (kbd "C-e") #'vterm-end-of-line) - (define-key map (kbd "C-c C-n") #'vterm-next-prompt) - (define-key map (kbd "C-c C-p") #'vterm-previous-prompt) - map)) - - -;;; Mode - -(define-derived-mode vterm-mode fundamental-mode "VTerm" - "Major mode for vterm buffer." - (buffer-disable-undo) - (and (boundp 'display-line-numbers) - (let ((font-height (expt text-scale-mode-step text-scale-mode-amount))) - (setq vterm--linenum-remapping - (face-remap-add-relative 'line-number :height font-height)))) - (hack-dir-local-variables) - (let ((vterm-env (assq 'vterm-environment dir-local-variables-alist))) - (when vterm-env - (make-local-variable 'vterm-environment) - (setq vterm-environment (cdr vterm-env)))) - (let ((process-environment (append vterm-environment - `(,(concat "TERM=" - vterm-term-environment-variable) - ,(concat "EMACS_VTERM_PATH=" - (file-name-directory (find-library-name "vterm"))) - "INSIDE_EMACS=vterm" - "LINES" - "COLUMNS") - process-environment)) - ;; TODO: Figure out why inhibit is needed for curses to render correctly. - (inhibit-eol-conversion nil) - (coding-system-for-read 'binary) - (process-adaptive-read-buffering nil) - (width (max (- (window-max-chars-per-line) (vterm--get-margin-width)) - vterm-min-window-width))) - (setq vterm--term (vterm--new (window-body-height) - width vterm-max-scrollback - vterm-disable-bold-font - vterm-disable-underline - vterm-disable-inverse-video - vterm-ignore-blink-cursor - vterm-set-bold-hightbright)) - (setq buffer-read-only t) - (setq-local scroll-conservatively 101) - (setq-local scroll-margin 0) - (setq-local hscroll-margin 0) - (setq-local hscroll-step 1) - (setq-local truncate-lines t) - - - ;; Disable all automatic fontification - (setq-local font-lock-defaults '(nil t)) - - (add-function :filter-return - (local 'filter-buffer-substring-function) - #'vterm--filter-buffer-substring) - (setq vterm--process - (make-process - :name "vterm" - :buffer (current-buffer) - :command - `("/bin/sh" "-c" - ,(format - "stty -nl sane %s erase ^? rows %d columns %d >/dev/null && exec %s" - ;; Some stty implementations (i.e. that of *BSD) do not - ;; support the iutf8 option. to handle that, we run some - ;; heuristics to work out if the system supports that - ;; option and set the arg string accordingly. This is a - ;; gross hack but FreeBSD doesn't seem to want to fix it. - ;; - ;; See: https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=220009 - (if (eq system-type 'berkeley-unix) "" "iutf8") - (window-body-height) - width (vterm--get-shell))) - ;; :coding 'no-conversion - :connection-type 'pty - :file-handler t - :filter #'vterm--filter - ;; The sentinel is needed if there are exit functions or if - ;; vterm-kill-buffer-on-exit is set to t. In this latter case, - ;; vterm--sentinel will kill the buffer - :sentinel (when (or vterm-exit-functions - vterm-kill-buffer-on-exit) - #'vterm--sentinel)))) - - ;; Change major-mode is not allowed - ;; Vterm interfaces with an underlying process. Changing the major - ;; mode can break this, leading to segmentation faults. - (add-hook 'change-major-mode-hook - (lambda () (interactive) - (user-error "You cannot change major mode in vterm buffers")) nil t) - - (vterm--set-pty-name vterm--term (process-tty-name vterm--process)) - (process-put vterm--process 'adjust-window-size-function - #'vterm--window-adjust-process-window-size) - ;; Support to compilation-shell-minor-mode - ;; Is this necessary? See vterm--compilation-setup - (setq next-error-function 'vterm-next-error-function) - (setq-local bookmark-make-record-function 'vterm--bookmark-make-record)) - -(defun vterm--get-shell () - "Get the shell that gets run in the vterm." - (if (ignore-errors (file-remote-p default-directory)) - (with-parsed-tramp-file-name default-directory nil - (or (cadr (assoc method vterm-tramp-shells)) - (with-connection-local-variables shell-file-name) - vterm-shell)) - vterm-shell)) - -(defun vterm--bookmark-make-record () - "Create a vterm bookmark. - -Notes down the current directory and buffer name." - `(nil - (handler . vterm--bookmark-handler) - (thisdir . ,default-directory) - (buf-name . ,(buffer-name)) - (defaults . nil))) - - -;;;###autoload -(defun vterm--bookmark-handler (bmk) - "Handler to restore a vterm bookmark BMK. - -If a vterm buffer of the same name does not exist, the function will create a -new vterm buffer of the name. It also checks the current directory and sets -it to the bookmarked directory if needed." - (let* ((thisdir (bookmark-prop-get bmk 'thisdir)) - (buf-name (bookmark-prop-get bmk 'buf-name)) - (buf (get-buffer buf-name)) - (thismode (and buf (with-current-buffer buf major-mode)))) - ;; create if no such vterm buffer exists - (when (or (not buf) (not (eq thismode 'vterm-mode))) - (setq buf (generate-new-buffer buf-name)) - (with-current-buffer buf - (when vterm-bookmark-check-dir - (setq default-directory thisdir)) - (vterm-mode))) - ;; check the current directory - (with-current-buffer buf - (when (and vterm-bookmark-check-dir - (not (string-equal default-directory thisdir))) - (when vterm-copy-mode - (vterm-copy-mode-done nil)) - (vterm-insert (concat "cd " thisdir)) - (vterm-send-return))) - ;; set to this vterm buf - (set-buffer buf))) - -(defun vterm--compilation-setup () - "Function to enable the option `compilation-shell-minor-mode' for vterm. -`'compilation-shell-minor-mode' would change the value of local -variable `next-error-function', so we should call this function in -`compilation-shell-minor-mode-hook'." - (when (or (eq major-mode 'vterm-mode) - (derived-mode-p 'vterm-mode)) - (setq next-error-function 'vterm-next-error-function))) - -(add-hook 'compilation-shell-minor-mode-hook #'vterm--compilation-setup) - -;;;###autoload -(defun vterm-next-error-function (n &optional reset) - "Advance to the next error message and visit the file where the error was. -This is the value of `next-error-function' in Compilation -buffers. Prefix arg N says how many error messages to move -forwards (or backwards, if negative). - -Optional argument RESET clears all the errors." - (interactive "p") - (let* ((pt (point)) - (default-directory default-directory) - (pwd (vterm--get-pwd))) - (when pwd - (setq default-directory pwd)) - (goto-char pt) - (compilation-next-error-function n reset))) - -;;; Copy Mode - -(defun vterm--enter-copy-mode () - (use-local-map nil) - (vterm-send-stop) - (when vterm-copy-mode-remove-fake-newlines - (save-excursion - (setq truncate-lines nil) - (vterm--remove-fake-newlines t)))) - - -(defun vterm--exit-copy-mode () - (when vterm-copy-mode-remove-fake-newlines - (save-excursion - (setq truncate-lines t) - (vterm--reinsert-fake-newlines))) - (vterm-reset-cursor-point) - (use-local-map vterm-mode-map) - (vterm-send-start)) - -(define-minor-mode vterm-copy-mode - "Toggle `vterm-copy-mode'. - -When `vterm-copy-mode' is enabled, the terminal will not display -additional output received from the underlying process and will -behave similarly to buffer in `fundamental-mode'. This mode is -typically used to copy text from vterm buffers. - -A conventient way to exit `vterm-copy-mode' is with -`vterm-copy-mode-done', which copies the selected text and exit -`vterm-copy-mode'." - :group 'vterm - :lighter " VTermCopy" - :keymap vterm-copy-mode-map - (if (or (equal major-mode 'vterm-mode) - (derived-mode-p 'vterm-mode)) - (if vterm-copy-mode - (vterm--enter-copy-mode) - (vterm--exit-copy-mode)) - (user-error "You cannot enable vterm-copy-mode outside vterm buffers"))) - -(defun vterm-copy-mode-done (arg) - "Save the active region or line to the kill ring and exit `vterm-copy-mode'. - -If a region is defined then that region is killed, with no region then -current line is killed from start to end. - -The option `vterm-copy-exclude-prompt' controls if the prompt -should be included in a line copy. Using the universal prefix ARG -will invert `vterm-copy-exclude-prompt' for that call." - (interactive "P") - (unless vterm-copy-mode - (user-error "This command is effective only in vterm-copy-mode")) - (unless (use-region-p) - (goto-char (vterm--get-beginning-of-line)) - ;; Are we excluding the prompt? - (if (or (and vterm-copy-exclude-prompt (not arg)) - (and (not vterm-copy-exclude-prompt) arg)) - (goto-char (max (or (vterm--get-prompt-point) 0) - (vterm--get-beginning-of-line)))) - (set-mark (point)) - (goto-char (vterm--get-end-of-line))) - (kill-ring-save (region-beginning) (region-end)) - (vterm-copy-mode -1)) - -;;; Commands - -(defun vterm--self-insert-meta () - (interactive) - (when vterm--term - (dolist (key (vterm--translate-event-to-args - last-command-event :meta)) - (apply #'vterm-send-key key)))) - -(defun vterm--self-insert () - "Send invoking key to libvterm." - (interactive) - (when vterm--term - (dolist (key (vterm--translate-event-to-args - last-command-event)) - (apply #'vterm-send-key key)))) - -(defun vterm-send-key (key &optional shift meta ctrl accept-proc-output) - "Send KEY to libvterm with optional modifiers SHIFT, META and CTRL." - (deactivate-mark) - (when vterm--term - (let ((inhibit-redisplay t) - (inhibit-read-only t)) - (vterm--update vterm--term key shift meta ctrl) - (setq vterm--redraw-immididately t) - (when accept-proc-output - (accept-process-output vterm--process vterm-timer-delay nil t))))) - -(defun vterm-send (key) - "Send KEY to libvterm. KEY can be anything `kbd' understands." - (dolist (key (vterm--translate-event-to-args - (listify-key-sequence (kbd key)))) - (apply #'vterm-send-key key))) - -(defun vterm-send-next-key () - "Read next input event and send it to the libvterm. - -With this you can directly send modified keys to applications -running in the terminal (like Emacs or Nano)." - (interactive) - (dolist (key (vterm--translate-event-to-args - (read-event))) - (apply #'vterm-send-key key))) - -(defun vterm-send-start () - "Output from the system is started when the system receives START." - (interactive) - (vterm-send-key "<start>")) - -(defun vterm-send-stop () - "Output from the system is stopped when the system receives STOP." - (interactive) - (vterm-send-key "<stop>")) - -(defun vterm-send-return () - "Send `C-m' to the libvterm." - (interactive) - (deactivate-mark) - (when vterm--term - (if (vterm--get-icrnl vterm--term) - (process-send-string vterm--process "\C-j") - (process-send-string vterm--process "\C-m")))) - -(defun vterm-send-tab () - "Send `<tab>' to the libvterm." - (interactive) - (vterm-send-key "<tab>")) - -(defun vterm-send-space () - "Send `<space>' to the libvterm." - (interactive) - (vterm-send-key " ")) - -(defun vterm-send-backspace () - "Send `<backspace>' to the libvterm." - (interactive) - (vterm-send-key "<backspace>")) - -(defun vterm-send-delete () - "Send `<delete>' to the libvterm." - (interactive) - (vterm-send-key "<delete>")) - -(defun vterm-send-meta-backspace () - "Send `M-<backspace>' to the libvterm." - (interactive) - (vterm-send-key "<backspace>" nil t)) - -(defun vterm-send-up () - "Send `<up>' to the libvterm." - (interactive) - (vterm-send-key "<up>")) -(make-obsolete 'vterm-send-up 'vterm--self-insert "v0.1") - -(defun vterm-send-down () - "Send `<down>' to the libvterm." - (interactive) - (vterm-send-key "<down>")) -(make-obsolete 'vterm-send-down 'vterm--self-insert "v0.1") - -(defun vterm-send-left () - "Send `<left>' to the libvterm." - (interactive) - (vterm-send-key "<left>")) -(make-obsolete 'vterm-send-left 'vterm--self-insert "v0.1") - -(defun vterm-send-right () - "Send `<right>' to the libvterm." - (interactive) - (vterm-send-key "<right>")) -(make-obsolete 'vterm-send-right 'vterm--self-insert "v0.1") - -(defun vterm-send-prior () - "Send `<prior>' to the libvterm." - (interactive) - (vterm-send-key "<prior>")) -(make-obsolete 'vterm-send-prior 'vterm--self-insert "v0.1") - -(defun vterm-send-next () - "Send `<next>' to the libvterm." - (interactive) - (vterm-send-key "<next>")) -(make-obsolete 'vterm-send-next 'vterm--self-insert "v0.1") - -(defun vterm-send-meta-dot () - "Send `M-.' to the libvterm." - (interactive) - (vterm-send-key "." nil t)) -(make-obsolete 'vterm-send-meta-dot 'vterm--self-insert "v0.1") - -(defun vterm-send-meta-comma () - "Send `M-,' to the libvterm." - (interactive) - (vterm-send-key "," nil t)) -(make-obsolete 'vterm-send-meta-comma 'vterm--self-insert "v0.1") - -(defun vterm-send-ctrl-slash () - "Send `C-\' to the libvterm." - (interactive) - (vterm-send-key "\\" nil nil t)) -(make-obsolete 'vterm-send-ctrl-slash 'vterm--self-insert "v0.1") - -(defun vterm-send-escape () - "Send `<escape>' to the libvterm." - (interactive) - (vterm-send-key "<escape>")) - -(defun vterm-clear-scrollback () - "Send `<clear-scrollback>' to the libvterm." - (interactive) - (vterm-send-key "<clear_scrollback>")) - -(defun vterm-clear (&optional arg) - "Send `<clear>' to the libvterm. - -`vterm-clear-scrollback' determines whether -`vterm-clear' should also clear the scrollback or not. - -This behavior can be altered by calling `vterm-clear' with a -prefix argument ARG or with \\[universal-argument]." - (interactive "P") - (if (or - (and vterm-clear-scrollback-when-clearing (not arg)) - (and arg (not vterm-clear-scrollback-when-clearing))) - (vterm-clear-scrollback)) - (vterm-send-key "l" nil nil :ctrl)) - -(defun vterm-undo () - "Send `C-_' to the libvterm." - (interactive) - (vterm-send-key "_" nil nil t)) - -(defun vterm-yank (&optional arg) - "Yank (paste) text in vterm. - -Argument ARG is passed to `yank'." - (interactive "P") - (deactivate-mark) - (vterm-goto-char (point)) - (let ((inhibit-read-only t)) - (cl-letf (((symbol-function 'insert-for-yank) #'vterm-insert)) - (yank arg)))) - -(defun vterm-yank-primary () - "Yank text from the primary selection in vterm." - (interactive) - (vterm-goto-char (point)) - (let ((inhibit-read-only t) - (primary (gui-get-primary-selection))) - (cl-letf (((symbol-function 'insert-for-yank) #'vterm-insert)) - (insert-for-yank primary)))) - -(defun vterm-yank-pop (&optional arg) - "Replaced text just yanked with the next entry in the kill ring. - -Argument ARG is passed to `yank'" - (interactive "p") - (vterm-goto-char (point)) - (let ((inhibit-read-only t) - (yank-undo-function #'(lambda (_start _end) (vterm-undo)))) - (cl-letf (((symbol-function 'insert-for-yank) #'vterm-insert)) - (yank-pop arg)))) - -(defun vterm-mouse-set-point (event &optional promote-to-region) - "Move point to the position clicked on with the mouse. -But when clicking to the unused area below the last prompt, -move the cursor to the prompt area." - (interactive "e\np") - (let ((pt (mouse-set-point event promote-to-region))) - (if (= (count-words pt (point-max)) 0) - (vterm-reset-cursor-point) - pt)) - ;; Otherwise it selects text for every other click - (keyboard-quit)) - -(defun vterm-send-string (string &optional paste-p) - "Send the string STRING to vterm. -Optional argument PASTE-P paste-p." - (when vterm--term - (when paste-p - (vterm--update vterm--term "<start_paste>" )) - (dolist (char (string-to-list string)) - (vterm--update vterm--term (char-to-string char))) - (when paste-p - (vterm--update vterm--term "<end_paste>"))) - (setq vterm--redraw-immididately t) - (accept-process-output vterm--process vterm-timer-delay nil t)) - -(defun vterm-insert (&rest contents) - "Insert the arguments, either strings or characters, at point. - -Provide similar behavior as `insert' for vterm." - (when vterm--term - (vterm--update vterm--term "<start_paste>") - (dolist (c contents) - (if (characterp c) - (vterm--update vterm--term (char-to-string c)) - (dolist (char (string-to-list c)) - (vterm--update vterm--term (char-to-string char))))) - (vterm--update vterm--term "<end_paste>") - (setq vterm--redraw-immididately t) - (accept-process-output vterm--process vterm-timer-delay nil t))) - -(defun vterm-delete-region (start end) - "Delete the text between START and END for vterm. " - (when vterm--term - (save-excursion - (when (get-text-property start 'vterm-line-wrap) - ;; skip over the fake newline when start there. - (setq start (1+ start)))) - ;; count of chars after fake newline removed - (let ((count (length (filter-buffer-substring start end)))) - (if (vterm-goto-char start) - (cl-loop repeat count do - (vterm-send-key "<delete>" nil nil nil t)) - (let ((inhibit-read-only nil)) - (vterm--delete-region start end)))))) - -(defun vterm-goto-char (pos) - "Set point to POSITION for vterm. - -The return value is `t' when point moved successfully." - (when (and vterm--term - (vterm-cursor-in-command-buffer-p) - (vterm-cursor-in-command-buffer-p pos)) - (vterm-reset-cursor-point) - (let ((diff (- pos (point)))) - (cond - ((zerop diff) t) ;do not need move - ((< diff 0) ;backward - (while (and - (vterm--backward-char) - (> (point) pos))) - (<= (point) pos)) - (t - (while (and (vterm--forward-char) - (< (point) pos))) - (>= (point) pos)))))) - -;;; Internal - -(defun vterm--forward-char () - "Move point 1 character forward (). - -the return value is `t' when cursor moved." - (vterm-reset-cursor-point) - (let ((pt (point))) - (vterm-send-key "<right>" nil nil nil t) - (cond - ((= (point) (1+ pt)) t) - ((and (> (point) pt) - ;; move over the fake newline - (get-text-property (1- (point)) 'vterm-line-wrap)) - t) - ((and (= (point) (+ 4 pt)) - (looking-back (regexp-quote "^[[C") nil)) ;escape code for <right> - (dotimes (_ 3) (vterm-send-key "<backspace>" nil nil nil t)) ;;delete "^[[C" - nil) - ((> (point) (1+ pt)) ;auto suggest - (vterm-send-key "_" nil nil t t) ;undo C-_ - nil) - (t nil)))) - - - -(defun vterm--backward-char () - "Move point N characters backward. - -Return count of moved characeters." - (vterm-reset-cursor-point) - (let ((pt (point))) - (vterm-send-key "<left>" nil nil nil t) - (cond - ((= (point) (1- pt)) t) - ((and (= (point) (- pt 2)) - ;; backward cross fake newline - (string-equal (buffer-substring-no-properties - (1+ (point)) (+ 2 (point))) - "\n")) - t) - ((and (= (point) (+ 4 pt)) - (looking-back (regexp-quote "^[[D") nil)) ;escape code for <left> - (dotimes (_ 3) (vterm-send-key "<backspace>" nil nil nil t)) ;;delete "^[[D" - nil) - (t nil)))) - -(defun vterm--delete-region(start end) - "A wrapper for `delete-region'." - (funcall vterm--delete-region-function start end)) - -(defun vterm--insert(&rest content) - "A wrapper for `insert'." - (apply vterm--insert-function content)) - -(defun vterm--delete-char(n &optional killflag) - "A wrapper for `delete-char'." - (funcall vterm--delete-char-function n killflag)) - -(defun vterm--translate-event-to-args (event &optional meta) - "Translate EVENT as list of args for `vterm-send-key'. - -When some input method is enabled, one key may generate -several characters, so the result of this function is a list, -looks like: ((\"m\" :shift ))" - (let* ((modifiers (event-modifiers event)) - (shift (memq 'shift modifiers)) - (meta (or meta (memq 'meta modifiers))) - (ctrl (memq 'control modifiers)) - (raw-key (event-basic-type event)) - (ev-keys) keys) - (if input-method-function - (let ((inhibit-read-only t)) - (setq ev-keys (funcall input-method-function raw-key)) - (when (listp ev-keys) - (dolist (k ev-keys) - (when-let ((key (key-description (vector k)))) - (when (and (not (symbolp event)) shift (not meta) (not ctrl)) - (setq key (upcase key))) - (setq keys (append keys (list (list key shift meta ctrl)))))))) - (when-let ((key (key-description (vector raw-key)))) - (when (and (not (symbolp event)) shift (not meta) (not ctrl)) - (setq key (upcase key))) - (setq keys (list (list key shift meta ctrl))))) - keys)) - -(defun vterm--invalidate () - "The terminal buffer is invalidated, the buffer needs redrawing." - (if (and (not vterm--redraw-immididately) - vterm-timer-delay) - (unless vterm--redraw-timer - (setq vterm--redraw-timer - (run-with-timer vterm-timer-delay nil - #'vterm--delayed-redraw (current-buffer)))) - (vterm--delayed-redraw (current-buffer)) - (setq vterm--redraw-immididately nil))) - -(defun vterm-check-proc (&optional buffer) - "Check if there is a running process associated to the vterm buffer BUFFER. - -BUFFER can be either a buffer or the name of one." - (let* ((buffer (get-buffer (or buffer (current-buffer)))) - (proc (get-buffer-process buffer))) - (and proc - (memq (process-status proc) '(run stop open listen connect)) - (buffer-local-value 'vterm--term buffer)))) - -(defun vterm--delayed-redraw (buffer) - "Redraw the terminal buffer. -Argument BUFFER the terminal buffer." - (when (buffer-live-p buffer) - (with-current-buffer buffer - (let ((inhibit-redisplay t) - (inhibit-read-only t) - (windows (get-buffer-window-list))) - (setq vterm--redraw-timer nil) - (when vterm--term - (vterm--redraw vterm--term) - (unless (zerop (window-hscroll)) - (when (cl-member (selected-window) windows :test #'eq) - (set-window-hscroll (selected-window) 0)))))))) - -;; see VTermSelectionMask in vterm.el -;; VTERM_SELECTION_CLIPBOARD = (1<<0), -;; VTERM_SELECTION_PRIMARY = (1<<1), -(defconst vterm--selection-clipboard 1) ;(1<<0) -(defconst vterm--selection-primary 2) ;(1<<1) -(defun vterm--set-selection (mask data) - "OSC 52 Manipulate Selection Data. -Search Manipulate Selection Data in - https://invisible-island.net/xterm/ctlseqs/ctlseqs.html ." - (when vterm-enable-manipulate-selection-data-by-osc52 - (let ((select-enable-clipboard select-enable-clipboard) - (select-enable-primary select-enable-primary)) - (setq select-enable-clipboard - (logand mask vterm--selection-clipboard)) - (setq select-enable-primary - (logand mask vterm--selection-primary)) - (kill-new data) - (message "kill-ring is updated by vterm OSC 52(Manipulate Selection Data)")) - )) - -;;; Entry Points - -;;;###autoload -(defun vterm (&optional arg) - "Create an interactive Vterm buffer. -Start a new Vterm session, or switch to an already active -session. Return the buffer selected (or created). - -With a nonnumeric prefix arg, create a new session. - -With a string prefix arg, create a new session with arg as buffer name. - -With a numeric prefix arg (as in `C-u 42 M-x vterm RET'), switch -to the session with that number, or create it if it doesn't -already exist. - -The buffer name used for Vterm sessions is determined by the -value of `vterm-buffer-name'." - (interactive "P") - (vterm--internal #'pop-to-buffer-same-window arg)) - -;;;###autoload -(defun vterm-other-window (&optional arg) - "Create an interactive Vterm buffer in another window. -Start a new Vterm session, or switch to an already active -session. Return the buffer selected (or created). - -With a nonnumeric prefix arg, create a new session. - -With a string prefix arg, create a new session with arg as buffer name. - -With a numeric prefix arg (as in `C-u 42 M-x vterm RET'), switch -to the session with that number, or create it if it doesn't -already exist. - -The buffer name used for Vterm sessions is determined by the -value of `vterm-buffer-name'." - (interactive "P") - (vterm--internal #'pop-to-buffer arg)) - -(defun vterm--internal (pop-to-buf-fun &optional arg) - (cl-assert vterm-buffer-name) - (let ((buf (cond ((numberp arg) - (get-buffer-create (format "%s<%d>" - vterm-buffer-name - arg))) - ((stringp arg) (generate-new-buffer arg)) - (arg (generate-new-buffer vterm-buffer-name)) - (t - (get-buffer-create vterm-buffer-name))))) - (cl-assert (and buf (buffer-live-p buf))) - (funcall pop-to-buf-fun buf) - (with-current-buffer buf - (unless (derived-mode-p 'vterm-mode) - (vterm-mode))) - buf)) - -;;; Internal - -(defun vterm--flush-output (output) - "Send the virtual terminal's OUTPUT to the shell." - (process-send-string vterm--process output)) -;; Terminal emulation -;; This is the standard process filter for term buffers. -;; It emulates (most of the features of) a VT100/ANSI-style terminal. - -;; References: -;; [ctlseqs]: http://invisible-island.net/xterm/ctlseqs/ctlseqs.html -;; [ECMA-48]: https://www.ecma-international.org/publications/standards/Ecma-048.htm -;; [vt100]: https://vt100.net/docs/vt100-ug/chapter3.html - -(defconst vterm-control-seq-regexp - (concat - ;; A control character, - "\\(?:[\r\n\000\007\t\b\016\017]\\|" - ;; a C1 escape coded character (see [ECMA-48] section 5.3 "Elements - ;; of the C1 set"), - "\e\\(?:[DM78c=]\\|" - ;; another Emacs specific control sequence for term.el, - "AnSiT[^\n]+\n\\|" - ;; another Emacs specific control sequence for vterm.el - ;; printf "\e]%s\e\\" - "\\][^\e]+\e\\\\\\|" - ;; or an escape sequence (section 5.4 "Control Sequences"), - "\\[\\([\x30-\x3F]*\\)[\x20-\x2F]*[\x40-\x7E]\\)\\)") - "Regexp matching control sequences handled by term.el.") - -(defconst vterm-control-seq-prefix-regexp - "[\032\e]") - -(defun vterm--filter (process input) - "I/O Event. Feeds PROCESS's INPUT to the virtual terminal. - -Then triggers a redraw from the module." - (let ((inhibit-redisplay t) - (inhibit-eol-conversion t) - (inhibit-read-only t) - (buf (process-buffer process)) - (i 0) - (str-length (length input)) - decoded-substring - funny) - (when (buffer-live-p buf) - (with-current-buffer buf - ;; borrowed from term.el - ;; Handle non-control data. Decode the string before - ;; counting characters, to avoid garbling of certain - ;; multibyte characters (https://github.com/akermu/emacs-libvterm/issues/394). - ;; same bug of term.el https://debbugs.gnu.org/cgi/bugreport.cgi?bug=1006 - (when vterm--undecoded-bytes - (setq input (concat vterm--undecoded-bytes input)) - (setq vterm--undecoded-bytes nil) - (setq str-length (length input))) - (while (< i str-length) - (setq funny (string-match vterm-control-seq-regexp input i)) - (let ((ctl-end (if funny (match-end 0) - (setq funny (string-match vterm-control-seq-prefix-regexp input i)) - (if funny - (setq vterm--undecoded-bytes - (substring input funny)) - (setq funny str-length)) - ;; The control sequence ends somewhere - ;; past the end of this string. - (1+ str-length)))) - (when (> funny i) - ;; Handle non-control data. Decode the string before - ;; counting characters, to avoid garbling of certain - ;; multibyte characters (emacs bug#1006). - (setq decoded-substring - (decode-coding-string - (substring input i funny) - locale-coding-system t)) - ;; Check for multibyte characters that ends - ;; before end of string, and save it for - ;; next time. - (when (= funny str-length) - (let ((partial 0) - (count (length decoded-substring))) - (while (and (< partial count) - (eq (char-charset (aref decoded-substring - (- count 1 partial))) - 'eight-bit)) - (cl-incf partial)) - (when (> (1+ count) partial 0) - (setq vterm--undecoded-bytes - (substring decoded-substring (- partial))) - (setq decoded-substring - (substring decoded-substring 0 (- partial))) - (cl-decf str-length partial) - (cl-decf funny partial)))) - (ignore-errors (vterm--write-input vterm--term decoded-substring)) - (setq i funny)) - (when (<= ctl-end str-length) - (ignore-errors (vterm--write-input vterm--term (substring input i ctl-end)))) - (setq i ctl-end))) - (vterm--update vterm--term))))) - -(defun vterm--sentinel (process event) - "Sentinel of vterm PROCESS. -Argument EVENT process event." - (let ((buf (process-buffer process))) - (run-hook-with-args 'vterm-exit-functions - (if (buffer-live-p buf) buf nil) - event) - (if (and vterm-kill-buffer-on-exit (buffer-live-p buf)) - (kill-buffer buf)))) - -(defun vterm--text-scale-mode (&optional _argv) - "Fix `line-number' height for scaled text." - (and text-scale-mode - (or (equal major-mode 'vterm-mode) - (derived-mode-p 'vterm-mode)) - (boundp 'display-line-numbers) - (let ((height (expt text-scale-mode-step - text-scale-mode-amount))) - (when vterm--linenum-remapping - (face-remap-remove-relative vterm--linenum-remapping)) - (setq vterm--linenum-remapping - (face-remap-add-relative 'line-number :height height)))) - (window--adjust-process-windows)) - -(advice-add #'text-scale-mode :after #'vterm--text-scale-mode) - -(defun vterm--window-adjust-process-window-size (process windows) - "Adjust width of window WINDOWS associated to process PROCESS. - -`vterm-min-window-width' determines the minimum width allowed." - ;; We want `vterm-copy-mode' to resemble a fundamental buffer as much as - ;; possible. Hence, we must not call this function when the minor mode is - ;; enabled, otherwise the buffer would be redrawn, messing around with the - ;; position of the point. - (unless vterm-copy-mode - (let* ((size (funcall window-adjust-process-window-size-function - process windows)) - (width (car size)) - (height (cdr size)) - (inhibit-read-only t)) - (setq width (- width (vterm--get-margin-width))) - (setq width (max width vterm-min-window-width)) - (when (and (processp process) - (process-live-p process) - (> width 0) - (> height 0)) - (vterm--set-size vterm--term height width) - (cons width height))))) - -(defun vterm--get-margin-width () - "Get margin width of vterm buffer when `display-line-numbers-mode' is enabled." - (let ((width 0) - (max-line-num (+ (frame-height) vterm-max-scrollback))) - (when (bound-and-true-p display-line-numbers) - (setq width (+ width 4 - (string-width (number-to-string max-line-num))))) - width)) - -(defun vterm--delete-lines (line-num count &optional delete-whole-line) - "Delete COUNT lines from LINE-NUM. -If LINE-NUM is negative backward-line from end of buffer. -If option DELETE-WHOLE-LINE is non-nil, then this command kills -the whole line including its terminating newline" - (save-excursion - (when (vterm--goto-line line-num) - (vterm--delete-region (point) (line-end-position count)) - (when (and delete-whole-line - (looking-at "\n")) - (vterm--delete-char 1))))) - -(defun vterm--goto-line (n) - "Go to line N and return true on success. -If N is negative backward-line from end of buffer." - (cond - ((> n 0) - (goto-char (point-min)) - (eq 0 (forward-line (1- n)))) - (t - (goto-char (point-max)) - (eq 0 (forward-line n))))) - -(defun vterm--set-title (title) - "Use TITLE to set the buffer name according to `vterm-buffer-name-string'." - (when vterm-buffer-name-string - (rename-buffer (format vterm-buffer-name-string title) t))) - -(defun vterm--set-directory (path) - "Set `default-directory' to PATH." - (let ((dir (vterm--get-directory path))) - (when dir (setq default-directory dir)))) - -(defun vterm--get-directory (path) - "Get normalized directory to PATH." - (when path - (let (directory) - (if (string-match "^\\(.*?\\)@\\(.*?\\):\\(.*?\\)$" path) - (progn - (let ((user (match-string 1 path)) - (host (match-string 2 path)) - (dir (match-string 3 path))) - (if (and (string-equal user user-login-name) - (string-equal host (system-name))) - (progn - (when (file-directory-p dir) - (setq directory (file-name-as-directory dir)))) - (setq directory (file-name-as-directory (concat "/-:" path)))))) - (when (file-directory-p path) - (setq directory (file-name-as-directory path)))) - directory))) - -(defun vterm--get-pwd (&optional linenum) - "Get working directory at LINENUM." - (when vterm--term - (let ((raw-pwd (vterm--get-pwd-raw - vterm--term - (or linenum (line-number-at-pos))))) - (when raw-pwd - (vterm--get-directory raw-pwd))))) - -(defun vterm--get-color (index &rest args) - "Get color by INDEX from `vterm-color-palette'. - -Special INDEX of -1 is used to represent default colors. ARGS -may optionally contain `:underline' or `:inverse-video' for cells -with underline or inverse video attribute. If ARGS contains -`:foreground', use foreground color of the respective face -instead of background." - (let ((foreground (member :foreground args)) - (underline (member :underline args)) - (inverse-video (member :inverse-video args))) - (funcall (if foreground #'face-foreground #'face-background) - (cond - ((and (>= index 0) (< index 16)) - (elt vterm-color-palette index)) - ((and (= index -1) foreground underline) - 'vterm-color-underline) - ((and (= index -1) (not foreground) inverse-video) - 'vterm-color-inverse-video) - (t 'default)) - nil 'default))) - -(defun vterm--eval (str) - "Check if string STR is `vterm-eval-cmds' and execute command. - -All passed in arguments are strings and forwarded as string to -the called functions." - (let* ((parts (split-string-and-unquote str)) - (command (car parts)) - (args (cdr parts)) - (f (assoc command vterm-eval-cmds))) - (if f - (apply (cadr f) args) - (message "Failed to find command: %s. To execute a command, - add it to the `vterm-eval-cmd' list" command)))) - -;; TODO: Improve doc string, it should not point to the readme but it should -;; be self-contained. -(defun vterm--prompt-tracking-enabled-p () - "Return t if tracking the prompt is enabled. - -Prompt tracking need shell side configurations. - -For zsh user, this is done by PROMPT=$PROMPT'%{$(vterm_prompt_end)%}'. - -The shell send semantic information about where the prompt ends via properly -escaped sequences to Emacs. - -More information see `Shell-side configuration' and `Directory tracking' -in README." - (or vterm--prompt-tracking-enabled-p - (save-excursion - (setq vterm--prompt-tracking-enabled-p - (next-single-property-change (point-min) 'vterm-prompt))))) - -(defun vterm-next-prompt (n) - "Move to end of Nth next prompt in the buffer." - (interactive "p") - (if (and vterm-use-vterm-prompt-detection-method - (vterm--prompt-tracking-enabled-p)) - (let ((pt (point)) - (promp-pt (vterm--get-prompt-point))) - (when promp-pt (goto-char promp-pt)) - (cl-loop repeat (or n 1) do - (setq pt (next-single-property-change (line-beginning-position 2) 'vterm-prompt)) - (when pt (goto-char pt)))) - (term-next-prompt n))) - -(defun vterm-previous-prompt (n) - "Move to end of Nth previous prompt in the buffer." - (interactive "p") - (if (and vterm-use-vterm-prompt-detection-method - (vterm--prompt-tracking-enabled-p)) - (let ((pt (point)) - (prompt-pt (vterm--get-prompt-point))) - (when prompt-pt - (goto-char prompt-pt) - (when (> pt (point)) - (setq n (1- (or n 1)))) - (cl-loop repeat n do - (setq pt (previous-single-property-change (1- (point)) 'vterm-prompt)) - (when pt (goto-char (1- pt)))))) - (term-previous-prompt n))) - -(defun vterm--get-beginning-of-line (&optional pt) - "Find the start of the line, bypassing line wraps. -If PT is specified, find it's beginning of the line instead of the beginning -of the line at cursor." - (save-excursion - (when pt (goto-char pt)) - (beginning-of-line) - (while (and (not (bobp)) - (get-text-property (1- (point)) 'vterm-line-wrap)) - (forward-char -1) - (beginning-of-line)) - (point))) - -(defun vterm--get-end-of-line (&optional pt) - "Find the start of the line, bypassing line wraps. -If PT is specified, find it's end of the line instead of the end -of the line at cursor." - (save-excursion - (when pt (goto-char pt)) - (end-of-line) - (while (get-text-property (point) 'vterm-line-wrap) - (forward-char) - (end-of-line)) - (point))) - -;; TODO: Improve doc string, it should not point to the readme but it should -;; be self-contained. -(defun vterm--get-prompt-point () - "Get the position of the end of current prompt. -More information see `vterm--prompt-tracking-enabled-p' and -`Directory tracking and Prompt tracking'in README." - (let ((end-point (vterm--get-end-of-line)) - prompt-point) - (save-excursion - (if (and vterm-use-vterm-prompt-detection-method - (vterm--prompt-tracking-enabled-p)) - (if (get-text-property end-point 'vterm-prompt) - end-point - (setq prompt-point (previous-single-property-change end-point 'vterm-prompt)) - (when prompt-point (setq prompt-point (1- prompt-point)))) - (goto-char end-point) - (if (search-backward-regexp term-prompt-regexp nil t) - (goto-char (match-end 0)) - (vterm--get-beginning-of-line)))))) - -(defun vterm--at-prompt-p () - "Return t if the cursor position is at shell prompt." - (= (point) (or (vterm--get-prompt-point) 0))) - -(defun vterm-cursor-in-command-buffer-p (&optional pt) - "Check whether cursor in command buffer area." - (save-excursion - (vterm-reset-cursor-point) - (let ((promp-pt (vterm--get-prompt-point))) - (when promp-pt - (<= promp-pt (or pt (vterm--get-cursor-point))))))) - -(defun vterm-beginning-of-line () - "Move point to the beginning of the line. - -Move the point to the first character after the shell prompt on this line. -If the point is already there, move to the beginning of the line. -Effectively toggle between the two positions." - (interactive "^") - (if (vterm--at-prompt-p) - (goto-char (vterm--get-beginning-of-line)) - (goto-char (max (or (vterm--get-prompt-point) 0) - (vterm--get-beginning-of-line))))) - -(defun vterm-end-of-line () - "Move point to the end of the line, bypassing line wraps." - (interactive "^") - (goto-char (vterm--get-end-of-line))) - -(defun vterm-reset-cursor-point () - "Make sure the cursor at the right position." - (interactive) - (when vterm--term - (let ((inhibit-read-only t)) - (vterm--reset-point vterm--term)))) - -(defun vterm--get-cursor-point () - "Get term cursor position." - (when vterm--term - (save-excursion - (vterm-reset-cursor-point)))) - -(defun vterm--reinsert-fake-newlines () - "Reinsert fake newline from `vterm--copy-mode-fake-newlines'." - (let ((inhibit-read-only t) - (inhibit-redisplay t) - (fake-newline-text "\n") - fake-newline-pos) - (add-text-properties 0 1 '(vterm-line-wrap t rear-nonsticky t) - fake-newline-text) - (while vterm--copy-mode-fake-newlines - (setq fake-newline-pos (car vterm--copy-mode-fake-newlines)) - (setq vterm--copy-mode-fake-newlines (cdr vterm--copy-mode-fake-newlines)) - (goto-char fake-newline-pos) - (insert fake-newline-text)))) - -(defun vterm--remove-fake-newlines (&optional remembering-pos-p) - "Filter out injected newlines were injected when rendering the terminal. - -These newlines were tagged with \\='vterm-line-wrap property so we -can find them and remove them. -If REMEMBERING-POS-P is not nil remembering their positions in a buffer-local -`vterm--copy-mode-fake-newlines'." - (let (fake-newline - (inhibit-read-only t) - (inhibit-redisplay t)) - (when remembering-pos-p - (setq vterm--copy-mode-fake-newlines nil)) - - (goto-char (point-max)) - (when (and (bolp) - (not (bobp)) - (get-text-property (1- (point)) 'vterm-line-wrap)) - (forward-char -1) - (when remembering-pos-p - (setq vterm--copy-mode-fake-newlines - (cons (point) vterm--copy-mode-fake-newlines))) - (vterm--delete-char 1)) - - (while (and (not (bobp)) - (setq fake-newline (previous-single-property-change - (point) 'vterm-line-wrap))) - (goto-char (1- fake-newline)) - (cl-assert (eq ?\n (char-after))) - (when remembering-pos-p - (setq vterm--copy-mode-fake-newlines - (cons (point) vterm--copy-mode-fake-newlines))) - (vterm--delete-char 1)))) - -(defun vterm--filter-buffer-substring (content) - "Filter string CONTENT of fake/injected newlines." - (with-temp-buffer - (vterm--insert content) - (vterm--remove-fake-newlines nil) - (buffer-string))) - - -(provide 'vterm) -;; Local Variables: -;; indent-tabs-mode: nil -;; End: -;;; vterm.el ends here diff --git a/emacs/elpa/vterm-20240825.133/vterm.elc b/emacs/elpa/vterm-20240825.133/vterm.elc Binary files differ. diff --git a/emacs/elpa/vterm-20240825.133/CMakeLists.txt b/emacs/elpa/vterm-20241118.1627/CMakeLists.txt diff --git a/emacs/elpa/vterm-20240825.133/elisp.c b/emacs/elpa/vterm-20241118.1627/elisp.c diff --git a/emacs/elpa/vterm-20240825.133/elisp.h b/emacs/elpa/vterm-20241118.1627/elisp.h diff --git a/emacs/elpa/vterm-20240825.133/emacs-module.h b/emacs/elpa/vterm-20241118.1627/emacs-module.h diff --git a/emacs/elpa/vterm-20240825.133/etc/emacs-vterm-bash.sh b/emacs/elpa/vterm-20241118.1627/etc/emacs-vterm-bash.sh diff --git a/emacs/elpa/vterm-20240825.133/etc/emacs-vterm-zsh.sh b/emacs/elpa/vterm-20241118.1627/etc/emacs-vterm-zsh.sh diff --git a/emacs/elpa/vterm-20240825.133/etc/emacs-vterm.fish b/emacs/elpa/vterm-20241118.1627/etc/emacs-vterm.fish diff --git a/emacs/elpa/vterm-20240825.133/utf8.c b/emacs/elpa/vterm-20241118.1627/utf8.c diff --git a/emacs/elpa/vterm-20240825.133/utf8.h b/emacs/elpa/vterm-20241118.1627/utf8.h diff --git a/emacs/elpa/vterm-20240825.133/vterm-autoloads.el b/emacs/elpa/vterm-20241118.1627/vterm-autoloads.el diff --git a/emacs/elpa/vterm-20240825.133/vterm-module.c b/emacs/elpa/vterm-20241118.1627/vterm-module.c diff --git a/emacs/elpa/vterm-20240825.133/vterm-module.h b/emacs/elpa/vterm-20241118.1627/vterm-module.h diff --git a/emacs/elpa/vterm-20241118.1627/vterm-pkg.el b/emacs/elpa/vterm-20241118.1627/vterm-pkg.el @@ -0,0 +1,10 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "vterm" "20241118.1627" + "Fully-featured terminal emulator." + '((emacs "25.1")) + :url "https://github.com/akermu/emacs-libvterm" + :commit "fd50624723200f4ac261f122f6332f57796c782f" + :revdesc "fd5062472320" + :keywords '("terminals") + :authors '(("Lukas Fürmetz" . "fuermetz@mailbox.org")) + :maintainers '(("Lukas Fürmetz" . "fuermetz@mailbox.org"))) diff --git a/emacs/elpa/vterm-20241118.1627/vterm.el b/emacs/elpa/vterm-20241118.1627/vterm.el @@ -0,0 +1,1899 @@ +;;; vterm.el --- Fully-featured terminal emulator -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2020 by Lukas Fürmetz & Contributors +;; +;; Author: Lukas Fürmetz <fuermetz@mailbox.org> +;; Package-Version: 20241118.1627 +;; Package-Revision: fd5062472320 +;; URL: https://github.com/akermu/emacs-libvterm +;; Keywords: terminals +;; Package-Requires: ((emacs "25.1")) + + +;; This file is not part of GNU Emacs. + +;; This file 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 2, or (at your option) +;; any later version. + +;; This file 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: +;; +;; Emacs-libvterm (vterm) is fully-fledged terminal emulator based on an +;; external library (libvterm) loaded as a dynamic module. As a result of using +;; compiled code (instead of elisp), emacs-libvterm is fully capable, fast, and +;; it can seamlessly handle large outputs. + +;;; Installation + +;; Emacs-libvterm requires support for loading modules. You can check if your +;; Emacs supports modules by inspecting the variable module-file-suffix. If it +;; nil, than, you need to recompile Emacs or obtain a copy of Emacs with this +;; option enabled. + +;; Emacs-libvterm requires CMake and libvterm. If libvterm is not available, +;; emacs-libvterm will downloaded and compiled. In this case, libtool is +;; needed. + +;; The reccomended way to install emacs-libvterm is from MELPA. + +;;; Usage + +;; To open a terminal, simply use the command M-x vterm. + +;;; Tips and tricks + +;; Adding some shell-side configuration enables a large set of additional +;; features, including, directory tracking, prompt recognition, message passing. + +;;; Code: + +(require 'term/xterm) + +(unless module-file-suffix + (error "VTerm needs module support. Please compile Emacs with + the --with-modules option!")) + +(defvar vterm-copy-mode) + +;;; Compilation of the module + +(defcustom vterm-module-cmake-args "" + "Arguments given to CMake to compile vterm-module. + +Currently, vterm defines the following flags (in addition to the +ones already available in CMake): + +`USE_SYSTEM_LIBVTERM'. Set it to `Off' to use the vendored version of +libvterm instead of the one installed on your system. + +This string is given verbatim to CMake, so it has to have the +correct syntax. An example of meaningful value for this variable +is `-DUSE_SYSTEM_LIBVTERM=Off'." + :type 'string + :group 'vterm) + +(defcustom vterm-always-compile-module nil + "If not nil, if `vterm-module' is not found, compile it without asking. + +When `vterm-always-compile-module' is nil, vterm will ask for +confirmation before compiling." + :type 'boolean + :group 'vterm) + +(defvar vterm-install-buffer-name " *Install vterm* " + "Name of the buffer used for compiling vterm-module.") + +(defun vterm-module--cmake-is-available () + "Return t if cmake is available. +CMake is needed to build vterm, here we check that we can find +the executable." + + (unless (executable-find "cmake") + (error "Vterm needs CMake to be compiled. Please, install CMake")) + t) + +;;;###autoload +(defun vterm-module-compile () + "Compile vterm-module." + (interactive) + (when (vterm-module--cmake-is-available) + (let* ((vterm-directory + (shell-quote-argument + ;; NOTE: This is a workaround to fix an issue with how the Emacs + ;; feature/native-comp branch changes the result of + ;; `(locate-library "vterm")'. See emacs-devel thread + ;; https://lists.gnu.org/archive/html/emacs-devel/2020-07/msg00306.html + ;; for a discussion. + (file-name-directory (locate-library "vterm.el" t)))) + (make-commands + (concat + "cd " vterm-directory "; \ + mkdir -p build; \ + cd build; \ + cmake -G 'Unix Makefiles' " + vterm-module-cmake-args + " ..; \ + make; \ + cd -")) + (buffer (get-buffer-create vterm-install-buffer-name))) + (pop-to-buffer buffer) + (compilation-mode) + (if (zerop (let ((inhibit-read-only t)) + (call-process "sh" nil buffer t "-c" make-commands))) + (message "Compilation of `emacs-libvterm' module succeeded") + (error "Compilation of `emacs-libvterm' module failed!"))))) + +;; If the vterm-module is not compiled yet, compile it +(unless (require 'vterm-module nil t) + (if (or vterm-always-compile-module + (y-or-n-p "Vterm needs `vterm-module' to work. Compile it now? ")) + (progn + (vterm-module-compile) + (require 'vterm-module)) + (error "Vterm will not work until `vterm-module' is compiled!"))) + +;;; Dependencies + +;; Generate this list with: +;; awk -F\" '/bind_function*/ {print "(declare-function", $2, "\"vterm-module\")"}' vterm-module.c +(declare-function vterm--new "vterm-module") +(declare-function vterm--update "vterm-module") +(declare-function vterm--redraw "vterm-module") +(declare-function vterm--write-input "vterm-module") +(declare-function vterm--set-size "vterm-module") +(declare-function vterm--set-pty-name "vterm-module") +(declare-function vterm--get-pwd-raw "vterm-module") +(declare-function vterm--reset-point "vterm-module") +(declare-function vterm--get-icrnl "vterm-module") + +(require 'subr-x) +(require 'find-func) +(require 'cl-lib) +(require 'term) +(require 'color) +(require 'compile) +(require 'face-remap) +(require 'tramp) +(require 'bookmark) + +;;; Options + +(defcustom vterm-shell shell-file-name + "The shell that gets run in the vterm." + :type 'string + :group 'vterm) + +(defcustom vterm-tramp-shells '(("docker" "/bin/sh")) + "The shell that gets run in the vterm for tramp. + +`vterm-tramp-shells' has to be a list of pairs of the format: +\(TRAMP-METHOD SHELL)" + :type '(alist :key-type string :value-type string) + :group 'vterm) + +(defcustom vterm-buffer-name "*vterm*" + "The basename used for vterm buffers. +This is the default name used when running `vterm' or +`vterm-other-window'. + +With a numeric prefix argument to `vterm', the buffer name will +be the value of this variable followed by the number. For +example, with the numeric prefix argument 2, the buffer would be +named \"*vterm*<2>\"." + :type 'string + :group 'vterm) + +(defcustom vterm-max-scrollback 1000 + "Maximum \\='scrollback\\=' value. + +The maximum allowed is 100000. This value can modified by +changing the SB_MAX variable in vterm-module.h and recompiling +the module." + :type 'number + :group 'vterm) + +(defcustom vterm-min-window-width 80 + "Minimum window width." + :type 'number + :group 'vterm) + +(defcustom vterm-kill-buffer-on-exit t + "If not nil vterm buffers are killed when the attached process is terminated. + +If `vterm-kill-buffer-on-exit' is set to t, when the process +associated to a vterm buffer quits, the buffer is killed. When +nil, the buffer will still be available as if it were in +`fundamental-mode'." + :type 'boolean + :group 'vterm) + +(define-obsolete-variable-alias 'vterm-clear-scrollback + 'vterm-clear-scrollback-when-clearing "0.0.1") + +(define-obsolete-variable-alias 'vterm-use-vterm-prompt + 'vterm-use-vterm-prompt-detection-method "0.0.1") + +(defcustom vterm-clear-scrollback-when-clearing nil + "If not nil `vterm-clear' clears both screen and scrollback. + +The scrollback is everything that is not current visible on +screen in vterm buffers. + +If `vterm-clear-scrollback-when-clearing' is nil, `vterm-clear' +clears only the screen, so the scrollback is accessible moving +the point up." + :type 'boolean + :group 'vterm) + +(defcustom vterm-keymap-exceptions + '("C-c" "C-x" "C-u" "C-g" "C-h" "C-l" "M-x" "M-o" "C-y" "M-y") + "Exceptions for `vterm-keymap'. + +If you use a keybinding with a prefix-key, add that prefix-key to +this list. Note that after doing so that prefix-key cannot be sent +to the terminal anymore. + +The mapping is done by the macro `vterm-define-key', and the +function `vterm--exclude-keys' removes the keybindings defined in +`vterm-keymap-exceptions'." + :type '(repeat string) + :set (lambda (sym val) + (set sym val) + (when (and (fboundp 'vterm--exclude-keys) + (boundp 'vterm-mode-map)) + (vterm--exclude-keys vterm-mode-map val))) + :group 'vterm) + +(defcustom vterm-exit-functions nil + "List of functions called when a vterm process exits. + +Each function is called with two arguments: the vterm buffer of +the process if any, and a string describing the event passed from +the sentinel. + +This hook applies only to new vterms, created after setting this +value with `add-hook'. + +Note that this hook will not work if another package like +`shell-pop' sets its own sentinel to the `vterm' process." + :type 'hook + :group 'vterm) + +(make-obsolete-variable 'vterm-set-title-functions + "This variable was substituted by `vterm-buffer-name-string'." + "0.0.1") + +(defcustom vterm-buffer-name-string nil + "Format string for the title of vterm buffers. + +If `vterm-buffer-name-string' is nil, vterm will not set the +title of its buffers. If not nil, `vterm-buffer-name-string' has +to be a format control string (see `format') containing one +instance of %s which will be substituted with the string TITLE. +The argument TITLE is provided by the shell. This requires shell +side configuration. + +For example, if `vterm-buffer-name-string' is set to \"vterm %s\", +and the shell properly configured to set TITLE=$(pwd), than vterm +buffers will be named \"vterm\" followed by the current path. + +See URL http://tldp.org/HOWTO/Xterm-Title-4.html for additional +information on the how to configure the shell." + :type 'string + :group 'vterm) + +(defcustom vterm-term-environment-variable "xterm-256color" + "TERM value for terminal." + :type 'string + :group 'vterm) + +(defcustom vterm-environment nil + "List of extra environment variables to the vterm shell processes only. + +demo: \\='(\"env1=v1\" \"env2=v2\")" + :type '(repeat string) + :group 'vterm) + + +(defcustom vterm-enable-manipulate-selection-data-by-osc52 nil + "Support OSC 52 MANIPULATE SELECTION DATA(libvterm 0.2 is needed). + +Support copy text to Emacs kill ring and system clipboard by using OSC 52. +For example: send base64 encoded \\='foo\\=' to kill ring: echo -en \\='\\e]52;c;Zm9v\\a\\=', +tmux can share its copy buffer to terminals by supporting osc52(like iterm2 + xterm) you can enable this feature for tmux by : +set -g set-clipboard on #osc 52 copy paste share with iterm +set -ga terminal-overrides \\=',xterm*:XT:Ms=\\E]52;%p1%s;%p2%s\\007\\=' +set -ga terminal-overrides \\=',screen*:XT:Ms=\\E]52;%p1%s;%p2%s\\007\\=' + +The clipboard querying/clearing functionality offered by OSC 52 is not +implemented here,And for security reason, this feature is disabled +by default." + :type 'boolean + :group 'vterm) + +;; TODO: Improve doc string, it should not point to the readme but it should +;; be self-contained. +(defcustom vterm-eval-cmds '(("find-file" find-file) + ("message" message) + ("vterm-clear-scrollback" vterm-clear-scrollback)) + "Whitelisted Emacs functions that can be executed from vterm. + +You can execute Emacs functions directly from vterm buffers. To do this, +you have to escape the name of the function and its arguments with \e]51;E. + +See Message passing in README. + +The function you want to execute has to be in `vterm-eval-cmds'. + +`vterm-eval-cmds' has to be a list of pairs of the format: +\(NAME-OF-COMMAND-IN-SHELL EMACS-FUNCTION) + +The need for an explicit map is to avoid arbitrary code execution." + :type '(alist :key-type string) + :group 'vterm) + +(defcustom vterm-disable-underline nil + "When not-nil, underline text properties are ignored. + +This means that vterm will render underlined text as if it was not +underlined." + :type 'boolean + :group 'vterm) + +(defcustom vterm-disable-inverse-video nil + "When not-nil, inverse video text properties are ignored. + +This means that vterm will render reversed video text as if it was not +such." + :type 'boolean + :group 'vterm) + +(define-obsolete-variable-alias 'vterm-disable-bold-font + 'vterm-disable-bold "0.0.1") + +(defcustom vterm-disable-bold-font nil + "When not-nil, bold text properties are ignored. + +This means that vterm will render bold with the default face weight." + :type 'boolean + :group 'vterm) + +(defcustom vterm-set-bold-hightbright nil + "When not-nil, using hightbright colors for bolded text, see #549." + :type 'boolean + :group 'vterm) + +(defcustom vterm-ignore-blink-cursor t + "When t, vterm will ignore request from application to turn on/off cursor blink. + +If nil, cursor in any window may begin to blink or not blink because +`blink-cursor-mode`is a global minor mode in Emacs, +you can use `M-x blink-cursor-mode` to toggle." + :type 'boolean + :group 'vterm) + +(defcustom vterm-copy-exclude-prompt t + "When not-nil, the prompt is not included by `vterm-copy-mode-done'." + :type 'boolean + :group 'vterm) + +(defcustom vterm-use-vterm-prompt-detection-method t + "When not-nil, the prompt is detected through the shell. + +Vterm needs to know where the shell prompt is to enable all the +available features. There are two supported ways to do this. +First, the shell can inform vterm on the location of the prompt. +This requires shell-side configuration: the escape code 51;A is +used to set the current directory and prompt location. This +detection method is the most-reliable. To use it, you have +to change your shell prompt to print 51;A. + +The second method is using a regular expression. This method does +not require any shell-side configuration. See +`term-prompt-regexp', for more information." + :type 'boolean + :group 'vterm) + +(defcustom vterm-bookmark-check-dir t + "When set to non-nil, also restore directory when restoring a vterm bookmark." + :type 'boolean + :group 'vterm) + +(defcustom vterm-copy-mode-remove-fake-newlines nil + "When not-nil fake newlines are removed on entering copy mode. + +vterm inserts \\='fake\\=' newlines purely for rendering. When using +vterm-copy-mode these are in conflict with many emacs functions +like isearch-forward. if this varialbe is not-nil the +fake-newlines are removed on entering copy-mode and re-inserted +on leaving copy mode. Also truncate-lines is set to t on entering +copy-mode and set to nil on leaving." + :type 'boolean + :group 'vterm) + +;;; Faces + +(defface vterm-color-black + `((t :inherit term-color-black)) + "Face used to render black color code." + :group 'vterm) + +(defface vterm-color-red + `((t :inherit term-color-red)) + "Face used to render red color code." + :group 'vterm) + +(defface vterm-color-green + `((t :inherit term-color-green)) + "Face used to render green color code." + :group 'vterm) + +(defface vterm-color-yellow + `((t :inherit term-color-yellow)) + "Face used to render yellow color code." + :group 'vterm) + +(defface vterm-color-blue + `((t :inherit term-color-blue)) + "Face used to render blue color code." + :group 'vterm) + +(defface vterm-color-magenta + `((t :inherit term-color-magenta)) + "Face used to render magenta color code." + :group 'vterm) + +(defface vterm-color-cyan + `((t :inherit term-color-cyan)) + "Face used to render cyan color code." + :group 'vterm) + +(defface vterm-color-white + `((t :inherit term-color-white)) + "Face used to render white color code." + :group 'vterm) + +(defface vterm-color-bright-black + `((t :inherit ,(if (facep 'term-color-bright-black) + 'term-color-bright-black + 'term-color-black))) + "Face used to render bright black color code." + :group 'vterm) + +(defface vterm-color-bright-red + `((t :inherit ,(if (facep 'term-color-bright-red) + 'term-color-bright-red + 'term-color-red))) + "Face used to render bright red color code." + :group 'vterm) + +(defface vterm-color-bright-green + `((t :inherit ,(if (facep 'term-color-bright-green) + 'term-color-bright-green + 'term-color-green))) + "Face used to render bright green color code." + :group 'vterm) + +(defface vterm-color-bright-yellow + `((t :inherit ,(if (facep 'term-color-bright-yellow) + 'term-color-bright-yellow + 'term-color-yellow))) + "Face used to render bright yellow color code." + :group 'vterm) + +(defface vterm-color-bright-blue + `((t :inherit ,(if (facep 'term-color-bright-blue) + 'term-color-bright-blue + 'term-color-blue))) + "Face used to render bright blue color code." + :group 'vterm) + +(defface vterm-color-bright-magenta + `((t :inherit ,(if (facep 'term-color-bright-magenta) + 'term-color-bright-magenta + 'term-color-magenta))) + "Face used to render bright magenta color code." + :group 'vterm) + +(defface vterm-color-bright-cyan + `((t :inherit ,(if (facep 'term-color-bright-cyan) + 'term-color-bright-cyan + 'term-color-cyan))) + "Face used to render bright cyan color code." + :group 'vterm) + +(defface vterm-color-bright-white + `((t :inherit ,(if (facep 'term-color-bright-white) + 'term-color-bright-white + 'term-color-white))) + "Face used to render bright white color code." + :group 'vterm) + +(defface vterm-color-underline + `((t :inherit default)) + "Face used to render cells with underline attribute. +Only foreground is used." + :group 'vterm) + +(defface vterm-color-inverse-video + `((t :inherit default)) + "Face used to render cells with inverse video attribute. +Only background is used." + :group 'vterm) + +;;; Variables + +(defvar vterm-color-palette + [vterm-color-black + vterm-color-red + vterm-color-green + vterm-color-yellow + vterm-color-blue + vterm-color-magenta + vterm-color-cyan + vterm-color-white + vterm-color-bright-black + vterm-color-bright-red + vterm-color-bright-green + vterm-color-bright-yellow + vterm-color-bright-blue + vterm-color-bright-magenta + vterm-color-bright-cyan + vterm-color-bright-white] + "Color palette for the foreground and background.") + +(defvar-local vterm--term nil + "Pointer to Term.") + +(defvar-local vterm--process nil + "Shell process of current term.") + +(defvar-local vterm--redraw-timer nil) +(defvar-local vterm--redraw-immididately nil) +(defvar-local vterm--linenum-remapping nil) +(defvar-local vterm--prompt-tracking-enabled-p nil) +(defvar-local vterm--insert-function (symbol-function #'insert)) +(defvar-local vterm--delete-char-function (symbol-function #'delete-char)) +(defvar-local vterm--delete-region-function (symbol-function #'delete-region)) +(defvar-local vterm--undecoded-bytes nil) +(defvar-local vterm--copy-mode-fake-newlines nil) + + +(defvar vterm-timer-delay 0.1 + "Delay for refreshing the buffer after receiving updates from libvterm. + +A larger delary improves performance when receiving large bursts +of data. If nil, never delay. The units are seconds.") + +;;; Keybindings + +;; We have many functions defined by vterm-define-key. Later, we will bind some +;; of the functions. If the following is not evaluated during compilation, the compiler +;; will complain that some functions are not defined (eg, vterm-send-C-c) +(eval-and-compile + (defmacro vterm-define-key (key) + "Define a command that sends KEY with modifiers C and M to vterm." + (declare (indent defun) + (doc-string 3)) + `(progn (defun ,(intern (format "vterm-send-%s" key))() + ,(format "Sends %s to the libvterm." key) + (interactive) + (vterm-send-key ,(char-to-string (get-byte (1- (length key)) key)) + ,(let ((case-fold-search nil)) + (or (string-match-p "[A-Z]$" key) + (string-match-p "S-" key))) + ,(string-match-p "M-" key) + ,(string-match-p "C-" key))) + (make-obsolete ',(intern (format "vterm-send-%s" key)) + "use `vterm--self-insert' or `vterm-send' or `vterm-send-key'." + "v0.1"))) + (make-obsolete 'vterm-define-key "" "v0.1") + (mapc (lambda (key) + (eval `(vterm-define-key ,key))) + (cl-loop for prefix in '("M-") + append (cl-loop for char from ?A to ?Z + for key = (format "%s%c" prefix char) + collect key))) + (mapc (lambda (key) + (eval `(vterm-define-key ,key))) + (cl-loop for prefix in '("C-" "M-" "C-S-") + append (cl-loop for char from ?a to ?z + for key = (format "%s%c" prefix char) + collect key)))) + +;; Function keys and most of C- and M- bindings +(defun vterm--exclude-keys (map exceptions) + "Remove EXCEPTIONS from the keys bound by `vterm-define-keys'. + +Exceptions are defined by `vterm-keymap-exceptions'." + (mapc (lambda (key) + (define-key map (kbd key) nil)) + exceptions) + (mapc (lambda (key) + (define-key map (kbd key) #'vterm--self-insert)) + (cl-loop for number from 1 to 12 + for key = (format "<f%i>" number) + unless (member key exceptions) + collect key)) + (let ((esc-map (lookup-key map "\e")) + (i 0) + key) + (unless esc-map (setq esc-map (make-keymap))) + (while (< i 128) + (setq key (make-string 1 i)) + (unless (member (key-description key) exceptions) + (define-key map key 'vterm--self-insert)) + ;; Avoid O and [. They are used in escape sequences for various keys. + (unless (or (eq i ?O) (eq i 91)) + (unless (member (key-description key "\e") exceptions) + (define-key esc-map key 'vterm--self-insert-meta))) + (setq i (1+ i))) + (define-key map "\e" esc-map))) + +(defun vterm-xterm-paste (event) + "Handle xterm paste EVENT in vterm." + (interactive "e") + (with-temp-buffer + (xterm-paste event) + (kill-new (buffer-string))) + (vterm-yank)) + +(defvar vterm-mode-map + (let ((map (make-sparse-keymap))) + (vterm--exclude-keys map vterm-keymap-exceptions) + (define-key map (kbd "C-]") #'vterm--self-insert) + (define-key map (kbd "M-<") #'vterm--self-insert) + (define-key map (kbd "M->") #'vterm--self-insert) + (define-key map [tab] #'vterm-send-tab) + (define-key map (kbd "TAB") #'vterm-send-tab) + (define-key map [backtab] #'vterm--self-insert) + (define-key map [backspace] #'vterm-send-backspace) + (define-key map (kbd "DEL") #'vterm-send-backspace) + (define-key map [delete] #'vterm-send-delete) + (define-key map [M-backspace] #'vterm-send-meta-backspace) + (define-key map (kbd "M-DEL") #'vterm-send-meta-backspace) + (define-key map [C-backspace] #'vterm-send-meta-backspace) + (define-key map [return] #'vterm-send-return) + (define-key map (kbd "RET") #'vterm-send-return) + (define-key map [C-left] #'vterm--self-insert) + (define-key map [M-left] #'vterm--self-insert) + (define-key map [C-right] #'vterm--self-insert) + (define-key map [M-right] #'vterm--self-insert) + (define-key map [C-up] #'vterm--self-insert) + (define-key map [C-down] #'vterm--self-insert) + (define-key map [M-up] #'vterm--self-insert) + (define-key map [M-down] #'vterm--self-insert) + (define-key map [left] #'vterm--self-insert) + (define-key map [right] #'vterm--self-insert) + (define-key map [up] #'vterm--self-insert) + (define-key map [down] #'vterm--self-insert) + (define-key map [prior] #'vterm--self-insert) + (define-key map [S-prior] #'scroll-down-command) + (define-key map [next] #'vterm--self-insert) + (define-key map [S-next] #'scroll-up-command) + (define-key map [home] #'vterm--self-insert) + (define-key map [end] #'vterm--self-insert) + (define-key map [C-home] #'vterm--self-insert) + (define-key map [C-end] #'vterm--self-insert) + (define-key map [escape] #'vterm--self-insert) + (define-key map [remap yank] #'vterm-yank) + (define-key map [remap xterm-paste] #'vterm-xterm-paste) + (define-key map [remap yank-pop] #'vterm-yank-pop) + (define-key map [remap mouse-yank-primary] #'vterm-yank-primary) + (define-key map [mouse-1] #'vterm-mouse-set-point) + (define-key map (kbd "C-SPC") #'vterm--self-insert) + (define-key map (kbd "S-SPC") #'vterm-send-space) + (define-key map (kbd "C-_") #'vterm--self-insert) + (define-key map [remap undo] #'vterm-undo) + (define-key map (kbd "M-.") #'vterm--self-insert) + (define-key map (kbd "M-,") #'vterm--self-insert) + (define-key map (kbd "C-c C-y") #'vterm--self-insert) + (define-key map (kbd "C-c C-c") #'vterm--self-insert) + (define-key map (kbd "C-c C-l") #'vterm-clear-scrollback) + (define-key map (kbd "C-l") #'vterm-clear) + (define-key map (kbd "C-\\") #'vterm--self-insert) + (define-key map (kbd "C-c C-g") #'vterm--self-insert) + (define-key map (kbd "C-c C-u") #'vterm--self-insert) + (define-key map [remap self-insert-command] #'vterm--self-insert) + (define-key map (kbd "C-c C-r") #'vterm-reset-cursor-point) + (define-key map (kbd "C-c C-n") #'vterm-next-prompt) + (define-key map (kbd "C-c C-p") #'vterm-previous-prompt) + (define-key map (kbd "C-c C-t") #'vterm-copy-mode) + map)) + +(defvar vterm-copy-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-t") #'vterm-copy-mode) + (define-key map [return] #'vterm-copy-mode-done) + (define-key map (kbd "RET") #'vterm-copy-mode-done) + (define-key map (kbd "C-c C-r") #'vterm-reset-cursor-point) + (define-key map (kbd "C-a") #'vterm-beginning-of-line) + (define-key map (kbd "C-e") #'vterm-end-of-line) + (define-key map (kbd "C-c C-n") #'vterm-next-prompt) + (define-key map (kbd "C-c C-p") #'vterm-previous-prompt) + map)) + + +;;; Mode + +(define-derived-mode vterm-mode fundamental-mode "VTerm" + "Major mode for vterm buffer." + (buffer-disable-undo) + (and (boundp 'display-line-numbers) + (let ((font-height (expt text-scale-mode-step text-scale-mode-amount))) + (setq vterm--linenum-remapping + (face-remap-add-relative 'line-number :height font-height)))) + (hack-dir-local-variables) + (let ((vterm-env (assq 'vterm-environment dir-local-variables-alist))) + (when vterm-env + (make-local-variable 'vterm-environment) + (setq vterm-environment (cdr vterm-env)))) + (let ((process-environment (append vterm-environment + `(,(concat "TERM=" + vterm-term-environment-variable) + ,(concat "EMACS_VTERM_PATH=" + (file-name-directory (find-library-name "vterm"))) + "INSIDE_EMACS=vterm" + "LINES" + "COLUMNS") + process-environment)) + ;; TODO: Figure out why inhibit is needed for curses to render correctly. + (inhibit-eol-conversion nil) + (coding-system-for-read 'binary) + (process-adaptive-read-buffering nil) + (width (max (- (window-max-chars-per-line) (vterm--get-margin-width)) + vterm-min-window-width))) + (setq vterm--term (vterm--new (window-body-height) + width vterm-max-scrollback + vterm-disable-bold-font + vterm-disable-underline + vterm-disable-inverse-video + vterm-ignore-blink-cursor + vterm-set-bold-hightbright)) + (setq buffer-read-only t) + (setq-local scroll-conservatively 101) + (setq-local scroll-margin 0) + (setq-local hscroll-margin 0) + (setq-local hscroll-step 1) + (setq-local truncate-lines t) + + + ;; Disable all automatic fontification + (setq-local font-lock-defaults '(nil t)) + + (add-function :filter-return + (local 'filter-buffer-substring-function) + #'vterm--filter-buffer-substring) + (setq vterm--process + (make-process + :name "vterm" + :buffer (current-buffer) + :command + `("/bin/sh" "-c" + ,(format + "stty -nl sane %s erase ^? rows %d columns %d >/dev/null && exec %s" + ;; Some stty implementations (i.e. that of *BSD) do not + ;; support the iutf8 option. to handle that, we run some + ;; heuristics to work out if the system supports that + ;; option and set the arg string accordingly. This is a + ;; gross hack but FreeBSD doesn't seem to want to fix it. + ;; + ;; See: https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=220009 + (if (eq system-type 'berkeley-unix) "" "iutf8") + (window-body-height) + width (vterm--get-shell))) + ;; :coding 'no-conversion + :connection-type 'pty + :file-handler t + :filter #'vterm--filter + ;; The sentinel is needed if there are exit functions or if + ;; vterm-kill-buffer-on-exit is set to t. In this latter case, + ;; vterm--sentinel will kill the buffer + :sentinel (when (or vterm-exit-functions + vterm-kill-buffer-on-exit) + #'vterm--sentinel)))) + + ;; Change major-mode is not allowed + ;; Vterm interfaces with an underlying process. Changing the major + ;; mode can break this, leading to segmentation faults. + (add-hook 'change-major-mode-hook + (lambda () (interactive) + (user-error "You cannot change major mode in vterm buffers")) nil t) + + (vterm--set-pty-name vterm--term (process-tty-name vterm--process)) + (process-put vterm--process 'adjust-window-size-function + #'vterm--window-adjust-process-window-size) + + ;; Set the truncation slot for 'buffer-display-table' to the ASCII code for a + ;; space character (32) to make the vterm buffer display a space instead of + ;; the default truncation character ($) when a line is truncated. + (let* ((display-table (or buffer-display-table (make-display-table)))) + (set-display-table-slot display-table 'truncation 32) + (setq buffer-display-table display-table)) + + ;; Support to compilation-shell-minor-mode + ;; Is this necessary? See vterm--compilation-setup + (setq next-error-function 'vterm-next-error-function) + (setq-local bookmark-make-record-function 'vterm--bookmark-make-record)) + +(defun vterm--get-shell () + "Get the shell that gets run in the vterm." + (if (ignore-errors (file-remote-p default-directory)) + (with-parsed-tramp-file-name default-directory nil + (or (cadr (assoc method vterm-tramp-shells)) + (with-connection-local-variables shell-file-name) + vterm-shell)) + vterm-shell)) + +(defun vterm--bookmark-make-record () + "Create a vterm bookmark. + +Notes down the current directory and buffer name." + `(nil + (handler . vterm--bookmark-handler) + (thisdir . ,default-directory) + (buf-name . ,(buffer-name)) + (defaults . nil))) + + +;;;###autoload +(defun vterm--bookmark-handler (bmk) + "Handler to restore a vterm bookmark BMK. + +If a vterm buffer of the same name does not exist, the function will create a +new vterm buffer of the name. It also checks the current directory and sets +it to the bookmarked directory if needed." + (let* ((thisdir (bookmark-prop-get bmk 'thisdir)) + (buf-name (bookmark-prop-get bmk 'buf-name)) + (buf (get-buffer buf-name)) + (thismode (and buf (with-current-buffer buf major-mode)))) + ;; create if no such vterm buffer exists + (when (or (not buf) (not (eq thismode 'vterm-mode))) + (setq buf (generate-new-buffer buf-name)) + (with-current-buffer buf + (when vterm-bookmark-check-dir + (setq default-directory thisdir)) + (vterm-mode))) + ;; check the current directory + (with-current-buffer buf + (when (and vterm-bookmark-check-dir + (not (string-equal default-directory thisdir))) + (when vterm-copy-mode + (vterm-copy-mode-done nil)) + (vterm-insert (concat "cd " thisdir)) + (vterm-send-return))) + ;; set to this vterm buf + (set-buffer buf))) + +(defun vterm--compilation-setup () + "Function to enable the option `compilation-shell-minor-mode' for vterm. +`'compilation-shell-minor-mode' would change the value of local +variable `next-error-function', so we should call this function in +`compilation-shell-minor-mode-hook'." + (when (or (eq major-mode 'vterm-mode) + (derived-mode-p 'vterm-mode)) + (setq next-error-function 'vterm-next-error-function))) + +(add-hook 'compilation-shell-minor-mode-hook #'vterm--compilation-setup) + +;;;###autoload +(defun vterm-next-error-function (n &optional reset) + "Advance to the next error message and visit the file where the error was. +This is the value of `next-error-function' in Compilation +buffers. Prefix arg N says how many error messages to move +forwards (or backwards, if negative). + +Optional argument RESET clears all the errors." + (interactive "p") + (let* ((pt (point)) + (default-directory default-directory) + (pwd (vterm--get-pwd))) + (when pwd + (setq default-directory pwd)) + (goto-char pt) + (compilation-next-error-function n reset))) + +;;; Copy Mode + +(defun vterm--enter-copy-mode () + (use-local-map nil) + (vterm-send-stop) + (when vterm-copy-mode-remove-fake-newlines + (save-excursion + (setq truncate-lines nil) + (vterm--remove-fake-newlines t)))) + + +(defun vterm--exit-copy-mode () + (when vterm-copy-mode-remove-fake-newlines + (save-excursion + (setq truncate-lines t) + (vterm--reinsert-fake-newlines))) + (vterm-reset-cursor-point) + (use-local-map vterm-mode-map) + (vterm-send-start)) + +(define-minor-mode vterm-copy-mode + "Toggle `vterm-copy-mode'. + +When `vterm-copy-mode' is enabled, the terminal will not display +additional output received from the underlying process and will +behave similarly to buffer in `fundamental-mode'. This mode is +typically used to copy text from vterm buffers. + +A conventient way to exit `vterm-copy-mode' is with +`vterm-copy-mode-done', which copies the selected text and exit +`vterm-copy-mode'." + :group 'vterm + :lighter " VTermCopy" + :keymap vterm-copy-mode-map + (if (or (equal major-mode 'vterm-mode) + (derived-mode-p 'vterm-mode)) + (if vterm-copy-mode + (vterm--enter-copy-mode) + (vterm--exit-copy-mode)) + (user-error "You cannot enable vterm-copy-mode outside vterm buffers"))) + +(defun vterm-copy-mode-done (arg) + "Save the active region or line to the kill ring and exit `vterm-copy-mode'. + +If a region is defined then that region is killed, with no region then +current line is killed from start to end. + +The option `vterm-copy-exclude-prompt' controls if the prompt +should be included in a line copy. Using the universal prefix ARG +will invert `vterm-copy-exclude-prompt' for that call." + (interactive "P") + (unless vterm-copy-mode + (user-error "This command is effective only in vterm-copy-mode")) + (unless (use-region-p) + (goto-char (vterm--get-beginning-of-line)) + ;; Are we excluding the prompt? + (if (or (and vterm-copy-exclude-prompt (not arg)) + (and (not vterm-copy-exclude-prompt) arg)) + (goto-char (max (or (vterm--get-prompt-point) 0) + (vterm--get-beginning-of-line)))) + (set-mark (point)) + (goto-char (vterm--get-end-of-line))) + (kill-ring-save (region-beginning) (region-end)) + (vterm-copy-mode -1)) + +;;; Commands + +(defun vterm--self-insert-meta () + (interactive) + (when vterm--term + (dolist (key (vterm--translate-event-to-args + last-command-event :meta)) + (apply #'vterm-send-key key)))) + +(defun vterm--self-insert () + "Send invoking key to libvterm." + (interactive) + (when vterm--term + (dolist (key (vterm--translate-event-to-args + last-command-event)) + (apply #'vterm-send-key key)))) + +(defun vterm-send-key (key &optional shift meta ctrl accept-proc-output) + "Send KEY to libvterm with optional modifiers SHIFT, META and CTRL." + (deactivate-mark) + (when vterm--term + (let ((inhibit-redisplay t) + (inhibit-read-only t)) + (vterm--update vterm--term key shift meta ctrl) + (setq vterm--redraw-immididately t) + (when accept-proc-output + (accept-process-output vterm--process vterm-timer-delay nil t))))) + +(defun vterm-send (key) + "Send KEY to libvterm. KEY can be anything `kbd' understands." + (dolist (key (vterm--translate-event-to-args + (listify-key-sequence (kbd key)))) + (apply #'vterm-send-key key))) + +(defun vterm-send-next-key () + "Read next input event and send it to the libvterm. + +With this you can directly send modified keys to applications +running in the terminal (like Emacs or Nano)." + (interactive) + (dolist (key (vterm--translate-event-to-args + (read-event))) + (apply #'vterm-send-key key))) + +(defun vterm-send-start () + "Output from the system is started when the system receives START." + (interactive) + (vterm-send-key "<start>")) + +(defun vterm-send-stop () + "Output from the system is stopped when the system receives STOP." + (interactive) + (vterm-send-key "<stop>")) + +(defun vterm-send-return () + "Send `C-m' to the libvterm." + (interactive) + (deactivate-mark) + (when vterm--term + (if (vterm--get-icrnl vterm--term) + (process-send-string vterm--process "\C-j") + (process-send-string vterm--process "\C-m")))) + +(defun vterm-send-tab () + "Send `<tab>' to the libvterm." + (interactive) + (vterm-send-key "<tab>")) + +(defun vterm-send-space () + "Send `<space>' to the libvterm." + (interactive) + (vterm-send-key " ")) + +(defun vterm-send-backspace () + "Send `<backspace>' to the libvterm." + (interactive) + (vterm-send-key "<backspace>")) + +(defun vterm-send-delete () + "Send `<delete>' to the libvterm." + (interactive) + (vterm-send-key "<delete>")) + +(defun vterm-send-meta-backspace () + "Send `M-<backspace>' to the libvterm." + (interactive) + (vterm-send-key "<backspace>" nil t)) + +(defun vterm-send-up () + "Send `<up>' to the libvterm." + (interactive) + (vterm-send-key "<up>")) +(make-obsolete 'vterm-send-up 'vterm--self-insert "v0.1") + +(defun vterm-send-down () + "Send `<down>' to the libvterm." + (interactive) + (vterm-send-key "<down>")) +(make-obsolete 'vterm-send-down 'vterm--self-insert "v0.1") + +(defun vterm-send-left () + "Send `<left>' to the libvterm." + (interactive) + (vterm-send-key "<left>")) +(make-obsolete 'vterm-send-left 'vterm--self-insert "v0.1") + +(defun vterm-send-right () + "Send `<right>' to the libvterm." + (interactive) + (vterm-send-key "<right>")) +(make-obsolete 'vterm-send-right 'vterm--self-insert "v0.1") + +(defun vterm-send-prior () + "Send `<prior>' to the libvterm." + (interactive) + (vterm-send-key "<prior>")) +(make-obsolete 'vterm-send-prior 'vterm--self-insert "v0.1") + +(defun vterm-send-next () + "Send `<next>' to the libvterm." + (interactive) + (vterm-send-key "<next>")) +(make-obsolete 'vterm-send-next 'vterm--self-insert "v0.1") + +(defun vterm-send-meta-dot () + "Send `M-.' to the libvterm." + (interactive) + (vterm-send-key "." nil t)) +(make-obsolete 'vterm-send-meta-dot 'vterm--self-insert "v0.1") + +(defun vterm-send-meta-comma () + "Send `M-,' to the libvterm." + (interactive) + (vterm-send-key "," nil t)) +(make-obsolete 'vterm-send-meta-comma 'vterm--self-insert "v0.1") + +(defun vterm-send-ctrl-slash () + "Send `C-\' to the libvterm." + (interactive) + (vterm-send-key "\\" nil nil t)) +(make-obsolete 'vterm-send-ctrl-slash 'vterm--self-insert "v0.1") + +(defun vterm-send-escape () + "Send `<escape>' to the libvterm." + (interactive) + (vterm-send-key "<escape>")) + +(defun vterm-clear-scrollback () + "Send `<clear-scrollback>' to the libvterm." + (interactive) + (vterm-send-key "<clear_scrollback>")) + +(defun vterm-clear (&optional arg) + "Send `<clear>' to the libvterm. + +`vterm-clear-scrollback' determines whether +`vterm-clear' should also clear the scrollback or not. + +This behavior can be altered by calling `vterm-clear' with a +prefix argument ARG or with \\[universal-argument]." + (interactive "P") + (if (or + (and vterm-clear-scrollback-when-clearing (not arg)) + (and arg (not vterm-clear-scrollback-when-clearing))) + (vterm-clear-scrollback)) + (vterm-send-key "l" nil nil :ctrl)) + +(defun vterm-undo () + "Send `C-_' to the libvterm." + (interactive) + (vterm-send-key "_" nil nil t)) + +(defun vterm-yank (&optional arg) + "Yank (paste) text in vterm. + +Argument ARG is passed to `yank'." + (interactive "P") + (deactivate-mark) + (vterm-goto-char (point)) + (let ((inhibit-read-only t)) + (cl-letf (((symbol-function 'insert-for-yank) #'vterm-insert)) + (yank arg)))) + +(defun vterm-yank-primary () + "Yank text from the primary selection in vterm." + (interactive) + (vterm-goto-char (point)) + (let ((inhibit-read-only t) + (primary (gui-get-primary-selection))) + (cl-letf (((symbol-function 'insert-for-yank) #'vterm-insert)) + (insert-for-yank primary)))) + +(defun vterm-yank-pop (&optional arg) + "Replaced text just yanked with the next entry in the kill ring. + +Argument ARG is passed to `yank'" + (interactive "p") + (vterm-goto-char (point)) + (let ((inhibit-read-only t) + (yank-undo-function #'(lambda (_start _end) (vterm-undo)))) + (cl-letf (((symbol-function 'insert-for-yank) #'vterm-insert)) + (yank-pop arg)))) + +(defun vterm-mouse-set-point (event &optional promote-to-region) + "Move point to the position clicked on with the mouse. +But when clicking to the unused area below the last prompt, +move the cursor to the prompt area." + (interactive "e\np") + (let ((pt (mouse-set-point event promote-to-region))) + (if (= (count-words pt (point-max)) 0) + (vterm-reset-cursor-point) + pt)) + ;; Otherwise it selects text for every other click + (keyboard-quit)) + +(defun vterm-send-string (string &optional paste-p) + "Send the string STRING to vterm. +Optional argument PASTE-P paste-p." + (when vterm--term + (when paste-p + (vterm--update vterm--term "<start_paste>" )) + (dolist (char (string-to-list string)) + (vterm--update vterm--term (char-to-string char))) + (when paste-p + (vterm--update vterm--term "<end_paste>"))) + (setq vterm--redraw-immididately t) + (accept-process-output vterm--process vterm-timer-delay nil t)) + +(defun vterm-insert (&rest contents) + "Insert the arguments, either strings or characters, at point. + +Provide similar behavior as `insert' for vterm." + (when vterm--term + (vterm--update vterm--term "<start_paste>") + (dolist (c contents) + (if (characterp c) + (vterm--update vterm--term (char-to-string c)) + (dolist (char (string-to-list c)) + (vterm--update vterm--term (char-to-string char))))) + (vterm--update vterm--term "<end_paste>") + (setq vterm--redraw-immididately t) + (accept-process-output vterm--process vterm-timer-delay nil t))) + +(defun vterm-delete-region (start end) + "Delete the text between START and END for vterm. " + (when vterm--term + (save-excursion + (when (get-text-property start 'vterm-line-wrap) + ;; skip over the fake newline when start there. + (setq start (1+ start)))) + ;; count of chars after fake newline removed + (let ((count (length (filter-buffer-substring start end)))) + (if (vterm-goto-char start) + (cl-loop repeat count do + (vterm-send-key "<delete>" nil nil nil t)) + (let ((inhibit-read-only nil)) + (vterm--delete-region start end)))))) + +(defun vterm-goto-char (pos) + "Set point to POSITION for vterm. + +The return value is `t' when point moved successfully." + (when (and vterm--term + (vterm-cursor-in-command-buffer-p) + (vterm-cursor-in-command-buffer-p pos)) + (vterm-reset-cursor-point) + (let ((diff (- pos (point)))) + (cond + ((zerop diff) t) ;do not need move + ((< diff 0) ;backward + (while (and + (vterm--backward-char) + (> (point) pos))) + (<= (point) pos)) + (t + (while (and (vterm--forward-char) + (< (point) pos))) + (>= (point) pos)))))) + +;;; Internal + +(defun vterm--forward-char () + "Move point 1 character forward (). + +the return value is `t' when cursor moved." + (vterm-reset-cursor-point) + (let ((pt (point))) + (vterm-send-key "<right>" nil nil nil t) + (cond + ((= (point) (1+ pt)) t) + ((and (> (point) pt) + ;; move over the fake newline + (get-text-property (1- (point)) 'vterm-line-wrap)) + t) + ((and (= (point) (+ 4 pt)) + (looking-back (regexp-quote "^[[C") nil)) ;escape code for <right> + (dotimes (_ 3) (vterm-send-key "<backspace>" nil nil nil t)) ;;delete "^[[C" + nil) + ((> (point) (1+ pt)) ;auto suggest + (vterm-send-key "_" nil nil t t) ;undo C-_ + nil) + (t nil)))) + + + +(defun vterm--backward-char () + "Move point N characters backward. + +Return count of moved characeters." + (vterm-reset-cursor-point) + (let ((pt (point))) + (vterm-send-key "<left>" nil nil nil t) + (cond + ((= (point) (1- pt)) t) + ((and (= (point) (- pt 2)) + ;; backward cross fake newline + (string-equal (buffer-substring-no-properties + (1+ (point)) (+ 2 (point))) + "\n")) + t) + ((and (= (point) (+ 4 pt)) + (looking-back (regexp-quote "^[[D") nil)) ;escape code for <left> + (dotimes (_ 3) (vterm-send-key "<backspace>" nil nil nil t)) ;;delete "^[[D" + nil) + (t nil)))) + +(defun vterm--delete-region(start end) + "A wrapper for `delete-region'." + (funcall vterm--delete-region-function start end)) + +(defun vterm--insert(&rest content) + "A wrapper for `insert'." + (apply vterm--insert-function content)) + +(defun vterm--delete-char(n &optional killflag) + "A wrapper for `delete-char'." + (funcall vterm--delete-char-function n killflag)) + +(defun vterm--translate-event-to-args (event &optional meta) + "Translate EVENT as list of args for `vterm-send-key'. + +When some input method is enabled, one key may generate +several characters, so the result of this function is a list, +looks like: ((\"m\" :shift ))" + (let* ((modifiers (event-modifiers event)) + (shift (memq 'shift modifiers)) + (meta (or meta (memq 'meta modifiers))) + (ctrl (memq 'control modifiers)) + (raw-key (event-basic-type event)) + (ev-keys) keys) + (if input-method-function + (let ((inhibit-read-only t)) + (setq ev-keys (funcall input-method-function raw-key)) + (when (listp ev-keys) + (dolist (k ev-keys) + (when-let ((key (key-description (vector k)))) + (when (and (not (symbolp event)) shift (not meta) (not ctrl)) + (setq key (upcase key))) + (setq keys (append keys (list (list key shift meta ctrl)))))))) + (when-let ((key (key-description (vector raw-key)))) + (when (and (not (symbolp event)) shift (not meta) (not ctrl)) + (setq key (upcase key))) + (setq keys (list (list key shift meta ctrl))))) + keys)) + +(defun vterm--invalidate () + "The terminal buffer is invalidated, the buffer needs redrawing." + (if (and (not vterm--redraw-immididately) + vterm-timer-delay) + (unless vterm--redraw-timer + (setq vterm--redraw-timer + (run-with-timer vterm-timer-delay nil + #'vterm--delayed-redraw (current-buffer)))) + (vterm--delayed-redraw (current-buffer)) + (setq vterm--redraw-immididately nil))) + +(defun vterm-check-proc (&optional buffer) + "Check if there is a running process associated to the vterm buffer BUFFER. + +BUFFER can be either a buffer or the name of one." + (let* ((buffer (get-buffer (or buffer (current-buffer)))) + (proc (get-buffer-process buffer))) + (and proc + (memq (process-status proc) '(run stop open listen connect)) + (buffer-local-value 'vterm--term buffer)))) + +(defun vterm--delayed-redraw (buffer) + "Redraw the terminal buffer. +Argument BUFFER the terminal buffer." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (let ((inhibit-redisplay t) + (inhibit-read-only t) + (windows (get-buffer-window-list))) + (setq vterm--redraw-timer nil) + (when vterm--term + (vterm--redraw vterm--term) + (unless (zerop (window-hscroll)) + (when (cl-member (selected-window) windows :test #'eq) + (set-window-hscroll (selected-window) 0)))))))) + +;; see VTermSelectionMask in vterm.el +;; VTERM_SELECTION_CLIPBOARD = (1<<0), +;; VTERM_SELECTION_PRIMARY = (1<<1), +(defconst vterm--selection-clipboard 1) ;(1<<0) +(defconst vterm--selection-primary 2) ;(1<<1) +(defun vterm--set-selection (mask data) + "OSC 52 Manipulate Selection Data. +Search Manipulate Selection Data in + https://invisible-island.net/xterm/ctlseqs/ctlseqs.html ." + (when vterm-enable-manipulate-selection-data-by-osc52 + (let ((select-enable-clipboard select-enable-clipboard) + (select-enable-primary select-enable-primary)) + (setq select-enable-clipboard + (logand mask vterm--selection-clipboard)) + (setq select-enable-primary + (logand mask vterm--selection-primary)) + (kill-new data) + (message "kill-ring is updated by vterm OSC 52(Manipulate Selection Data)")) + )) + +;;; Entry Points + +;;;###autoload +(defun vterm (&optional arg) + "Create an interactive Vterm buffer. +Start a new Vterm session, or switch to an already active +session. Return the buffer selected (or created). + +With a nonnumeric prefix arg, create a new session. + +With a string prefix arg, create a new session with arg as buffer name. + +With a numeric prefix arg (as in `C-u 42 M-x vterm RET'), switch +to the session with that number, or create it if it doesn't +already exist. + +The buffer name used for Vterm sessions is determined by the +value of `vterm-buffer-name'." + (interactive "P") + (vterm--internal #'pop-to-buffer-same-window arg)) + +;;;###autoload +(defun vterm-other-window (&optional arg) + "Create an interactive Vterm buffer in another window. +Start a new Vterm session, or switch to an already active +session. Return the buffer selected (or created). + +With a nonnumeric prefix arg, create a new session. + +With a string prefix arg, create a new session with arg as buffer name. + +With a numeric prefix arg (as in `C-u 42 M-x vterm RET'), switch +to the session with that number, or create it if it doesn't +already exist. + +The buffer name used for Vterm sessions is determined by the +value of `vterm-buffer-name'." + (interactive "P") + (vterm--internal #'pop-to-buffer arg)) + +(defun vterm--internal (pop-to-buf-fun &optional arg) + (cl-assert vterm-buffer-name) + (let ((buf (cond ((numberp arg) + (get-buffer-create (format "%s<%d>" + vterm-buffer-name + arg))) + ((stringp arg) (generate-new-buffer arg)) + (arg (generate-new-buffer vterm-buffer-name)) + (t + (get-buffer-create vterm-buffer-name))))) + (cl-assert (and buf (buffer-live-p buf))) + (funcall pop-to-buf-fun buf) + (with-current-buffer buf + (unless (derived-mode-p 'vterm-mode) + (vterm-mode))) + buf)) + +;;; Internal + +(defun vterm--flush-output (output) + "Send the virtual terminal's OUTPUT to the shell." + (process-send-string vterm--process output)) +;; Terminal emulation +;; This is the standard process filter for term buffers. +;; It emulates (most of the features of) a VT100/ANSI-style terminal. + +;; References: +;; [ctlseqs]: http://invisible-island.net/xterm/ctlseqs/ctlseqs.html +;; [ECMA-48]: https://www.ecma-international.org/publications/standards/Ecma-048.htm +;; [vt100]: https://vt100.net/docs/vt100-ug/chapter3.html + +(defconst vterm-control-seq-regexp + (concat + ;; A control character, + "\\(?:[\r\n\000\007\t\b\016\017]\\|" + ;; a C1 escape coded character (see [ECMA-48] section 5.3 "Elements + ;; of the C1 set"), + "\e\\(?:[DM78c=]\\|" + ;; another Emacs specific control sequence for term.el, + "AnSiT[^\n]+\n\\|" + ;; another Emacs specific control sequence for vterm.el + ;; printf "\e]%s\e\\" + "\\][^\e]+\e\\\\\\|" + ;; or an escape sequence (section 5.4 "Control Sequences"), + "\\[\\([\x30-\x3F]*\\)[\x20-\x2F]*[\x40-\x7E]\\)\\)") + "Regexp matching control sequences handled by term.el.") + +(defconst vterm-control-seq-prefix-regexp + "[\032\e]") + +(defun vterm--filter (process input) + "I/O Event. Feeds PROCESS's INPUT to the virtual terminal. + +Then triggers a redraw from the module." + (let ((inhibit-redisplay t) + (inhibit-eol-conversion t) + (inhibit-read-only t) + (buf (process-buffer process)) + (i 0) + (str-length (length input)) + decoded-substring + funny) + (when (buffer-live-p buf) + (with-current-buffer buf + ;; borrowed from term.el + ;; Handle non-control data. Decode the string before + ;; counting characters, to avoid garbling of certain + ;; multibyte characters (https://github.com/akermu/emacs-libvterm/issues/394). + ;; same bug of term.el https://debbugs.gnu.org/cgi/bugreport.cgi?bug=1006 + (when vterm--undecoded-bytes + (setq input (concat vterm--undecoded-bytes input)) + (setq vterm--undecoded-bytes nil) + (setq str-length (length input))) + (while (< i str-length) + (setq funny (string-match vterm-control-seq-regexp input i)) + (let ((ctl-end (if funny (match-end 0) + (setq funny (string-match vterm-control-seq-prefix-regexp input i)) + (if funny + (setq vterm--undecoded-bytes + (substring input funny)) + (setq funny str-length)) + ;; The control sequence ends somewhere + ;; past the end of this string. + (1+ str-length)))) + (when (> funny i) + ;; Handle non-control data. Decode the string before + ;; counting characters, to avoid garbling of certain + ;; multibyte characters (emacs bug#1006). + (setq decoded-substring + (decode-coding-string + (substring input i funny) + locale-coding-system t)) + ;; Check for multibyte characters that ends + ;; before end of string, and save it for + ;; next time. + (when (= funny str-length) + (let ((partial 0) + (count (length decoded-substring))) + (while (and (< partial count) + (eq (char-charset (aref decoded-substring + (- count 1 partial))) + 'eight-bit)) + (cl-incf partial)) + (when (> (1+ count) partial 0) + (setq vterm--undecoded-bytes + (substring decoded-substring (- partial))) + (setq decoded-substring + (substring decoded-substring 0 (- partial))) + (cl-decf str-length partial) + (cl-decf funny partial)))) + (ignore-errors (vterm--write-input vterm--term decoded-substring)) + (setq i funny)) + (when (<= ctl-end str-length) + (ignore-errors (vterm--write-input vterm--term (substring input i ctl-end)))) + (setq i ctl-end))) + (vterm--update vterm--term))))) + +(defun vterm--sentinel (process event) + "Sentinel of vterm PROCESS. +Argument EVENT process event." + (let ((buf (process-buffer process))) + (run-hook-with-args 'vterm-exit-functions + (if (buffer-live-p buf) buf nil) + event) + (if (and vterm-kill-buffer-on-exit (buffer-live-p buf)) + (kill-buffer buf)))) + +(defun vterm--text-scale-mode (&optional _argv) + "Fix `line-number' height for scaled text." + (and text-scale-mode + (or (equal major-mode 'vterm-mode) + (derived-mode-p 'vterm-mode)) + (boundp 'display-line-numbers) + (let ((height (expt text-scale-mode-step + text-scale-mode-amount))) + (when vterm--linenum-remapping + (face-remap-remove-relative vterm--linenum-remapping)) + (setq vterm--linenum-remapping + (face-remap-add-relative 'line-number :height height)))) + (window--adjust-process-windows)) + +(advice-add #'text-scale-mode :after #'vterm--text-scale-mode) + +(defun vterm--window-adjust-process-window-size (process windows) + "Adjust width of window WINDOWS associated to process PROCESS. + +`vterm-min-window-width' determines the minimum width allowed." + ;; We want `vterm-copy-mode' to resemble a fundamental buffer as much as + ;; possible. Hence, we must not call this function when the minor mode is + ;; enabled, otherwise the buffer would be redrawn, messing around with the + ;; position of the point. + (unless vterm-copy-mode + (let* ((size (funcall window-adjust-process-window-size-function + process windows)) + (width (car size)) + (height (cdr size)) + (inhibit-read-only t)) + (setq width (- width (vterm--get-margin-width))) + (setq width (max width vterm-min-window-width)) + (when (and (processp process) + (process-live-p process) + (> width 0) + (> height 0)) + (vterm--set-size vterm--term height width) + (cons width height))))) + +(defun vterm--get-margin-width () + "Get margin width of vterm buffer when `display-line-numbers-mode' is enabled." + (let ((width 0) + (max-line-num (+ (frame-height) vterm-max-scrollback))) + (when (bound-and-true-p display-line-numbers) + (setq width (+ width 4 + (string-width (number-to-string max-line-num))))) + width)) + +(defun vterm--delete-lines (line-num count &optional delete-whole-line) + "Delete COUNT lines from LINE-NUM. +If LINE-NUM is negative backward-line from end of buffer. +If option DELETE-WHOLE-LINE is non-nil, then this command kills +the whole line including its terminating newline" + (save-excursion + (when (vterm--goto-line line-num) + (vterm--delete-region (point) (line-end-position count)) + (when (and delete-whole-line + (looking-at "\n")) + (vterm--delete-char 1))))) + +(defun vterm--goto-line (n) + "Go to line N and return true on success. +If N is negative backward-line from end of buffer." + (cond + ((> n 0) + (goto-char (point-min)) + (eq 0 (forward-line (1- n)))) + (t + (goto-char (point-max)) + (eq 0 (forward-line n))))) + +(defun vterm--set-title (title) + "Use TITLE to set the buffer name according to `vterm-buffer-name-string'." + (when vterm-buffer-name-string + (rename-buffer (format vterm-buffer-name-string title) t))) + +(defun vterm--set-directory (path) + "Set `default-directory' to PATH." + (let ((dir (vterm--get-directory path))) + (when dir (setq default-directory dir)))) + +(defun vterm--get-directory (path) + "Get normalized directory to PATH." + (when path + (let (directory) + (if (string-match "^\\(.*?\\)@\\(.*?\\):\\(.*?\\)$" path) + (progn + (let ((user (match-string 1 path)) + (host (match-string 2 path)) + (dir (match-string 3 path))) + (if (and (string-equal user user-login-name) + (string-equal host (system-name))) + (progn + (when (file-directory-p dir) + (setq directory (file-name-as-directory dir)))) + (setq directory (file-name-as-directory (concat "/-:" path)))))) + (when (file-directory-p path) + (setq directory (file-name-as-directory path)))) + directory))) + +(defun vterm--get-pwd (&optional linenum) + "Get working directory at LINENUM." + (when vterm--term + (let ((raw-pwd (vterm--get-pwd-raw + vterm--term + (or linenum (line-number-at-pos))))) + (when raw-pwd + (vterm--get-directory raw-pwd))))) + +(defun vterm--get-color (index &rest args) + "Get color by INDEX from `vterm-color-palette'. + +Special INDEX of -1 is used to represent default colors. ARGS +may optionally contain `:underline' or `:inverse-video' for cells +with underline or inverse video attribute. If ARGS contains +`:foreground', use foreground color of the respective face +instead of background." + (let ((foreground (member :foreground args)) + (underline (member :underline args)) + (inverse-video (member :inverse-video args))) + (funcall (if foreground #'face-foreground #'face-background) + (cond + ((and (>= index 0) (< index 16)) + (elt vterm-color-palette index)) + ((and (= index -1) foreground underline) + 'vterm-color-underline) + ((and (= index -1) (not foreground) inverse-video) + 'vterm-color-inverse-video) + (t 'default)) + nil 'default))) + +(defun vterm--eval (str) + "Check if string STR is `vterm-eval-cmds' and execute command. + +All passed in arguments are strings and forwarded as string to +the called functions." + (let* ((parts (split-string-and-unquote str)) + (command (car parts)) + (args (cdr parts)) + (f (assoc command vterm-eval-cmds))) + (if f + (apply (cadr f) args) + (message "Failed to find command: %s. To execute a command, + add it to the `vterm-eval-cmd' list" command)))) + +;; TODO: Improve doc string, it should not point to the readme but it should +;; be self-contained. +(defun vterm--prompt-tracking-enabled-p () + "Return t if tracking the prompt is enabled. + +Prompt tracking need shell side configurations. + +For zsh user, this is done by PROMPT=$PROMPT'%{$(vterm_prompt_end)%}'. + +The shell send semantic information about where the prompt ends via properly +escaped sequences to Emacs. + +More information see `Shell-side configuration' and `Directory tracking' +in README." + (or vterm--prompt-tracking-enabled-p + (save-excursion + (setq vterm--prompt-tracking-enabled-p + (next-single-property-change (point-min) 'vterm-prompt))))) + +(defun vterm-next-prompt (n) + "Move to end of Nth next prompt in the buffer." + (interactive "p") + (if (and vterm-use-vterm-prompt-detection-method + (vterm--prompt-tracking-enabled-p)) + (let ((pt (point)) + (promp-pt (vterm--get-prompt-point))) + (when promp-pt (goto-char promp-pt)) + (cl-loop repeat (or n 1) do + (setq pt (next-single-property-change (line-beginning-position 2) 'vterm-prompt)) + (when pt (goto-char pt)))) + (term-next-prompt n))) + +(defun vterm-previous-prompt (n) + "Move to end of Nth previous prompt in the buffer." + (interactive "p") + (if (and vterm-use-vterm-prompt-detection-method + (vterm--prompt-tracking-enabled-p)) + (let ((pt (point)) + (prompt-pt (vterm--get-prompt-point))) + (when prompt-pt + (goto-char prompt-pt) + (when (> pt (point)) + (setq n (1- (or n 1)))) + (cl-loop repeat n do + (setq pt (previous-single-property-change (1- (point)) 'vterm-prompt)) + (when pt (goto-char (1- pt)))))) + (term-previous-prompt n))) + +(defun vterm--get-beginning-of-line (&optional pt) + "Find the start of the line, bypassing line wraps. +If PT is specified, find it's beginning of the line instead of the beginning +of the line at cursor." + (save-excursion + (when pt (goto-char pt)) + (beginning-of-line) + (while (and (not (bobp)) + (get-text-property (1- (point)) 'vterm-line-wrap)) + (forward-char -1) + (beginning-of-line)) + (point))) + +(defun vterm--get-end-of-line (&optional pt) + "Find the start of the line, bypassing line wraps. +If PT is specified, find it's end of the line instead of the end +of the line at cursor." + (save-excursion + (when pt (goto-char pt)) + (end-of-line) + (while (get-text-property (point) 'vterm-line-wrap) + (forward-char) + (end-of-line)) + (point))) + +;; TODO: Improve doc string, it should not point to the readme but it should +;; be self-contained. +(defun vterm--get-prompt-point () + "Get the position of the end of current prompt. +More information see `vterm--prompt-tracking-enabled-p' and +`Directory tracking and Prompt tracking'in README." + (let ((end-point (vterm--get-end-of-line)) + prompt-point) + (save-excursion + (if (and vterm-use-vterm-prompt-detection-method + (vterm--prompt-tracking-enabled-p)) + (if (get-text-property end-point 'vterm-prompt) + end-point + (setq prompt-point (previous-single-property-change end-point 'vterm-prompt)) + (when prompt-point (setq prompt-point (1- prompt-point)))) + (goto-char end-point) + (if (search-backward-regexp term-prompt-regexp nil t) + (goto-char (match-end 0)) + (vterm--get-beginning-of-line)))))) + +(defun vterm--at-prompt-p () + "Return t if the cursor position is at shell prompt." + (= (point) (or (vterm--get-prompt-point) 0))) + +(defun vterm-cursor-in-command-buffer-p (&optional pt) + "Check whether cursor in command buffer area." + (save-excursion + (vterm-reset-cursor-point) + (let ((promp-pt (vterm--get-prompt-point))) + (when promp-pt + (<= promp-pt (or pt (vterm--get-cursor-point))))))) + +(defun vterm-beginning-of-line () + "Move point to the beginning of the line. + +Move the point to the first character after the shell prompt on this line. +If the point is already there, move to the beginning of the line. +Effectively toggle between the two positions." + (interactive "^") + (if (vterm--at-prompt-p) + (goto-char (vterm--get-beginning-of-line)) + (goto-char (max (or (vterm--get-prompt-point) 0) + (vterm--get-beginning-of-line))))) + +(defun vterm-end-of-line () + "Move point to the end of the line, bypassing line wraps." + (interactive "^") + (goto-char (vterm--get-end-of-line))) + +(defun vterm-reset-cursor-point () + "Make sure the cursor at the right position." + (interactive) + (when vterm--term + (let ((inhibit-read-only t)) + (vterm--reset-point vterm--term)))) + +(defun vterm--get-cursor-point () + "Get term cursor position." + (when vterm--term + (save-excursion + (vterm-reset-cursor-point)))) + +(defun vterm--reinsert-fake-newlines () + "Reinsert fake newline from `vterm--copy-mode-fake-newlines'." + (let ((inhibit-read-only t) + (inhibit-redisplay t) + (fake-newline-text "\n") + fake-newline-pos) + (add-text-properties 0 1 '(vterm-line-wrap t rear-nonsticky t) + fake-newline-text) + (while vterm--copy-mode-fake-newlines + (setq fake-newline-pos (car vterm--copy-mode-fake-newlines)) + (setq vterm--copy-mode-fake-newlines (cdr vterm--copy-mode-fake-newlines)) + (goto-char fake-newline-pos) + (insert fake-newline-text)))) + +(defun vterm--remove-fake-newlines (&optional remembering-pos-p) + "Filter out injected newlines were injected when rendering the terminal. + +These newlines were tagged with \\='vterm-line-wrap property so we +can find them and remove them. +If REMEMBERING-POS-P is not nil remembering their positions in a buffer-local +`vterm--copy-mode-fake-newlines'." + (let (fake-newline + (inhibit-read-only t) + (inhibit-redisplay t)) + (when remembering-pos-p + (setq vterm--copy-mode-fake-newlines nil)) + + (goto-char (point-max)) + (when (and (bolp) + (not (bobp)) + (get-text-property (1- (point)) 'vterm-line-wrap)) + (forward-char -1) + (when remembering-pos-p + (setq vterm--copy-mode-fake-newlines + (cons (point) vterm--copy-mode-fake-newlines))) + (vterm--delete-char 1)) + + (while (and (not (bobp)) + (setq fake-newline (previous-single-property-change + (point) 'vterm-line-wrap))) + (goto-char (1- fake-newline)) + (cl-assert (eq ?\n (char-after))) + (when remembering-pos-p + (setq vterm--copy-mode-fake-newlines + (cons (point) vterm--copy-mode-fake-newlines))) + (vterm--delete-char 1)))) + +(defun vterm--filter-buffer-substring (content) + "Filter string CONTENT of fake/injected newlines." + (with-temp-buffer + (vterm--insert content) + (vterm--remove-fake-newlines nil) + (buffer-string))) + + +(provide 'vterm) +;; Local Variables: +;; indent-tabs-mode: nil +;; End: +;;; vterm.el ends here diff --git a/emacs/elpa/vterm-20241118.1627/vterm.elc b/emacs/elpa/vterm-20241118.1627/vterm.elc Binary files differ.