From 68ebdcb4cd2786bc914fbb80639d97a922ff51ff Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Fri, 5 May 2023 16:47:57 +0200 Subject: [PATCH] spring cleanup of elpa packages Signed-off-by: Andreas Gerler --- elpa/bicycle-20210615.1459/bicycle-pkg.el | 2 - .../bicycle-autoloads.el | 4 +- elpa/bicycle-20230212.2019/bicycle-pkg.el | 2 + .../bicycle.el | 32 +- elpa/compat-28.1.2.2.signed | 1 - elpa/compat-28.1.2.2/.dir-locals.el | 7 - elpa/compat-28.1.2.2/NEWS.org | 108 - elpa/compat-28.1.2.2/compat-24.el | 495 - elpa/compat-28.1.2.2/compat-25.el | 322 - elpa/compat-28.1.2.2/compat-26.el | 675 -- elpa/compat-28.1.2.2/compat-27.el | 764 -- elpa/compat-28.1.2.2/compat-font-lock.el | 48 - elpa/compat-28.1.2.2/compat-help.el | 57 - elpa/compat-28.1.2.2/compat-macs.el | 316 - elpa/compat-28.1.2.2/compat-pkg.el | 2 - elpa/compat-28.1.2.2/compat.el | 58 - elpa/compat-28.1.2.2/compat.info | 2070 ---- elpa/compat-29.1.3.4.signed | 1 + elpa/compat-29.1.3.4/NEWS.org | 268 + elpa/compat-29.1.3.4/compat-25.el | 271 + elpa/compat-29.1.3.4/compat-26.el | 554 + elpa/compat-29.1.3.4/compat-27.el | 898 ++ .../compat-28.el | 579 +- elpa/compat-29.1.3.4/compat-29.el | 1503 +++ .../compat-autoloads.el | 18 +- elpa/compat-29.1.3.4/compat-macs.el | 266 + elpa/compat-29.1.3.4/compat-pkg.el | 2 + elpa/compat-29.1.3.4/compat.el | 93 + elpa/compat-29.1.3.4/compat.info | 2888 ++++++ elpa/{compat-28.1.2.2 => compat-29.1.3.4}/dir | 0 .../dash-autoloads.el | 29 +- .../dash-pkg.el | 6 +- .../dash.el | 1373 ++- .../dash.info | 1518 +-- .../dir | 0 elpa/f-20191110.1357/f-pkg.el | 2 - .../f-autoloads.el | 8 +- elpa/f-20230116.1032/f-pkg.el | 14 + elpa/f-20230116.1032/f-shortdoc.el | 439 + .../{f-20191110.1357 => f-20230116.1032}/f.el | 455 +- .../dir | 2 +- elpa/forge-20230505.926/forge-autoloads.el | 443 + elpa/forge-20230505.926/forge-bitbucket.el | 46 + elpa/forge-20230505.926/forge-commands.el | 1139 +++ elpa/forge-20230505.926/forge-core.el | 370 + elpa/forge-20230505.926/forge-db.el | 446 + elpa/forge-20230505.926/forge-gitea.el | 47 + elpa/forge-20230505.926/forge-github.el | 801 ++ elpa/forge-20230505.926/forge-gitlab.el | 672 ++ elpa/forge-20230505.926/forge-gogs.el | 46 + elpa/forge-20230505.926/forge-issue.el | 225 + elpa/forge-20230505.926/forge-list.el | 465 + elpa/forge-20230505.926/forge-notify.el | 151 + elpa/forge-20230505.926/forge-pkg.el | 22 + elpa/forge-20230505.926/forge-post.el | 286 + elpa/forge-20230505.926/forge-pullreq.el | 330 + elpa/forge-20230505.926/forge-repo.el | 378 + elpa/forge-20230505.926/forge-revnote.el | 47 + elpa/forge-20230505.926/forge-semi.el | 81 + elpa/forge-20230505.926/forge-topic.el | 977 ++ elpa/forge-20230505.926/forge.el | 169 + elpa/forge-20230505.926/forge.info | 1504 +++ elpa/ghub-20191007.1420/buck.el | 128 - elpa/ghub-20191007.1420/dir | 18 - elpa/ghub-20191007.1420/ghub-autoloads.el | 51 - elpa/ghub-20191007.1420/ghub-graphql.el | 454 - elpa/ghub-20191007.1420/ghub-pkg.el | 8 - elpa/ghub-20191007.1420/ghub.el | 1041 -- elpa/ghub-20191007.1420/ghub.info | 1319 --- elpa/ghub-20191007.1420/glab.el | 155 - elpa/ghub-20191007.1420/gogs.el | 140 - elpa/ghub-20191007.1420/gsexp.el | 94 - elpa/ghub-20191007.1420/gtea.el | 140 - .../git-commit-autoloads.el | 52 - .../git-commit-pkg.el | 2 - elpa/git-commit-20201222.1527/git-commit.el | 1025 -- .../git-commit-autoloads.el | 4 +- .../git-commit-pkg.el | 5 +- .../git-commit.el | 304 +- elpa/kubel-20220509.104/kubel-pkg.el | 2 - .../kubel-autoloads.el | 0 elpa/kubel-20220723.1655/kubel-pkg.el | 2 + .../kubel.el | 6 +- .../lsp-mode-20220201.852/lsp-actionscript.el | 134 - elpa/lsp-mode-20220201.852/lsp-ada.el | 106 - elpa/lsp-mode-20220201.852/lsp-angular.el | 101 - elpa/lsp-mode-20220201.852/lsp-bash.el | 90 - elpa/lsp-mode-20220201.852/lsp-beancount.el | 71 - elpa/lsp-mode-20220201.852/lsp-clangd.el | 315 - elpa/lsp-mode-20220201.852/lsp-clojure.el | 418 - elpa/lsp-mode-20220201.852/lsp-cmake.el | 43 - elpa/lsp-mode-20220201.852/lsp-completion.el | 809 -- elpa/lsp-mode-20220201.852/lsp-crystal.el | 48 - elpa/lsp-mode-20220201.852/lsp-csharp.el | 443 - elpa/lsp-mode-20220201.852/lsp-css.el | 254 - elpa/lsp-mode-20220201.852/lsp-d.el | 37 - elpa/lsp-mode-20220201.852/lsp-dhall.el | 43 - elpa/lsp-mode-20220201.852/lsp-diagnostics.el | 370 - elpa/lsp-mode-20220201.852/lsp-dired.el | 178 - elpa/lsp-mode-20220201.852/lsp-dockerfile.el | 66 - elpa/lsp-mode-20220201.852/lsp-elixir.el | 190 - elpa/lsp-mode-20220201.852/lsp-elm.el | 137 - elpa/lsp-mode-20220201.852/lsp-erlang.el | 67 - elpa/lsp-mode-20220201.852/lsp-eslint.el | 408 - elpa/lsp-mode-20220201.852/lsp-fortran.el | 61 - elpa/lsp-mode-20220201.852/lsp-fsharp.el | 331 - elpa/lsp-mode-20220201.852/lsp-gdscript.el | 61 - elpa/lsp-mode-20220201.852/lsp-go.el | 337 - elpa/lsp-mode-20220201.852/lsp-graphql.el | 73 - elpa/lsp-mode-20220201.852/lsp-groovy.el | 66 - elpa/lsp-mode-20220201.852/lsp-hack.el | 54 - elpa/lsp-mode-20220201.852/lsp-haxe.el | 226 - elpa/lsp-mode-20220201.852/lsp-headerline.el | 473 - elpa/lsp-mode-20220201.852/lsp-html.el | 198 - elpa/lsp-mode-20220201.852/lsp-icons.el | 96 - elpa/lsp-mode-20220201.852/lsp-ido.el | 142 - elpa/lsp-mode-20220201.852/lsp-iedit.el | 149 - elpa/lsp-mode-20220201.852/lsp-javascript.el | 371 - elpa/lsp-mode-20220201.852/lsp-json.el | 131 - elpa/lsp-mode-20220201.852/lsp-kotlin.el | 149 - elpa/lsp-mode-20220201.852/lsp-lens.el | 448 - elpa/lsp-mode-20220201.852/lsp-lua.el | 678 -- elpa/lsp-mode-20220201.852/lsp-markdown.el | 103 - .../lsp-mode-autoloads.el | 807 -- elpa/lsp-mode-20220201.852/lsp-mode-pkg.el | 18 - elpa/lsp-mode-20220201.852/lsp-mode.el | 8890 ----------------- elpa/lsp-mode-20220201.852/lsp-modeline.el | 354 - elpa/lsp-mode-20220201.852/lsp-nginx.el | 53 - elpa/lsp-mode-20220201.852/lsp-nim.el | 45 - elpa/lsp-mode-20220201.852/lsp-nix.el | 48 - elpa/lsp-mode-20220201.852/lsp-ocaml.el | 84 - elpa/lsp-mode-20220201.852/lsp-perl.el | 117 - elpa/lsp-mode-20220201.852/lsp-php.el | 450 - elpa/lsp-mode-20220201.852/lsp-prolog.el | 55 - elpa/lsp-mode-20220201.852/lsp-protocol.el | 766 -- elpa/lsp-mode-20220201.852/lsp-purescript.el | 72 - elpa/lsp-mode-20220201.852/lsp-pwsh.el | 363 - elpa/lsp-mode-20220201.852/lsp-pyls.el | 504 - elpa/lsp-mode-20220201.852/lsp-pylsp.el | 434 - elpa/lsp-mode-20220201.852/lsp-r.el | 49 - elpa/lsp-mode-20220201.852/lsp-racket.el | 77 - elpa/lsp-mode-20220201.852/lsp-remark.el | 69 - elpa/lsp-mode-20220201.852/lsp-rf.el | 147 - elpa/lsp-mode-20220201.852/lsp-rust.el | 1173 --- .../lsp-semantic-tokens.el | 870 -- elpa/lsp-mode-20220201.852/lsp-solargraph.el | 166 - elpa/lsp-mode-20220201.852/lsp-sorbet.el | 59 - elpa/lsp-mode-20220201.852/lsp-sqls.el | 190 - elpa/lsp-mode-20220201.852/lsp-steep.el | 73 - elpa/lsp-mode-20220201.852/lsp-svelte.el | 307 - elpa/lsp-mode-20220201.852/lsp-terraform.el | 99 - elpa/lsp-mode-20220201.852/lsp-tex.el | 68 - elpa/lsp-mode-20220201.852/lsp-toml.el | 258 - elpa/lsp-mode-20220201.852/lsp-v.el | 50 - elpa/lsp-mode-20220201.852/lsp-vala.el | 51 - elpa/lsp-mode-20220201.852/lsp-verilog.el | 186 - elpa/lsp-mode-20220201.852/lsp-vetur.el | 886 -- elpa/lsp-mode-20220201.852/lsp-vhdl.el | 121 - elpa/lsp-mode-20220201.852/lsp-vimscript.el | 75 - elpa/lsp-mode-20220201.852/lsp-xml.el | 245 - elpa/lsp-mode-20220201.852/lsp-yaml.el | 242 - elpa/lsp-mode-20220201.852/lsp-zig.el | 50 - elpa/lsp-mode-20220201.852/lsp.el | 8 - elpa/lsp-mode-readme.txt | 1 - elpa/lsp-ui-20220104.1635/lsp-ui-autoloads.el | 80 - elpa/lsp-ui-20220104.1635/lsp-ui-doc.el | 1213 --- elpa/lsp-ui-20220104.1635/lsp-ui-doc.html | 52 - elpa/lsp-ui-20220104.1635/lsp-ui-flycheck.el | 171 - elpa/lsp-ui-20220104.1635/lsp-ui-imenu.el | 412 - elpa/lsp-ui-20220104.1635/lsp-ui-peek.el | 759 -- elpa/lsp-ui-20220104.1635/lsp-ui-pkg.el | 15 - elpa/lsp-ui-20220104.1635/lsp-ui-sideline.el | 768 -- elpa/lsp-ui-20220104.1635/lsp-ui-util.el | 71 - elpa/lsp-ui-20220104.1635/lsp-ui.el | 177 - .../resources/lightbulb.png | Bin 2058 -> 0 bytes elpa/lsp-ui-readme.txt | 2 - elpa/magit-20220518.2359/magit-obsolete.el | 111 - .../AUTHORS.md | 15 + .../LICENSE | 0 .../dir | 0 .../git-rebase.el | 105 +- .../magit-apply.el | 11 +- .../magit-autoloads.el | 70 +- .../magit-autorevert.el | 38 +- .../magit-base.el | 181 +- .../magit-bisect.el | 55 +- .../magit-blame.el | 59 +- .../magit-bookmark.el | 2 +- .../magit-branch.el | 101 +- .../magit-bundle.el | 8 +- .../magit-clone.el | 75 +- .../magit-commit.el | 155 +- .../magit-core.el | 2 +- .../magit-diff.el | 528 +- .../magit-ediff.el | 69 +- .../magit-extras.el | 37 +- .../magit-fetch.el | 15 +- .../magit-files.el | 38 +- .../magit-git.el | 515 +- .../magit-gitignore.el | 4 +- .../magit-log.el | 204 +- .../magit-margin.el | 6 +- .../magit-merge.el | 35 +- .../magit-mode.el | 372 +- .../magit-notes.el | 4 +- .../magit-patch.el | 2 +- .../magit-pkg.el | 16 +- .../magit-process.el | 71 +- .../magit-pull.el | 2 +- .../magit-push.el | 103 +- .../magit-reflog.el | 15 +- .../magit-refs.el | 68 +- .../magit-remote.el | 40 +- .../magit-repos.el | 22 +- .../magit-reset.el | 4 +- .../magit-sequence.el | 165 +- .../magit-sparse-checkout.el | 6 +- .../magit-stash.el | 46 +- .../magit-status.el | 42 +- .../magit-submodule.el | 89 +- .../magit-subtree.el | 2 +- .../magit-tag.el | 12 +- .../magit-transient.el | 14 +- .../magit-wip.el | 64 +- .../magit-worktree.el | 72 +- .../magit.el | 33 +- .../magit.info | 629 +- .../dir | 0 .../magit-section-autoloads.el | 0 .../magit-section-pkg.el | 8 +- .../magit-section.el | 238 +- .../magit-section.info | 14 +- .../org-chef-24kitchen.el | 90 - .../org-chef-all-recipes.el | 104 - .../org-chef-autoloads.el | 175 - .../org-chef-chef-koch.el | 134 - .../org-chef-cultures-for-health.el | 98 - .../org-chef-fine-cooking.el | 81 - .../org-chef-genius-kitchen.el | 95 - .../org-chef-marmiton.el | 128 - .../org-chef-martha-stewart.el | 106 - .../org-chef-nytimes.el | 128 - elpa/org-chef-20191201.1435/org-chef-pkg.el | 13 - .../org-chef-reluctant-gourmet.el | 122 - .../org-chef-20191201.1435/org-chef-saveur.el | 139 - .../org-chef-serious-eats.el | 112 - .../org-chef-simply-recipes.el | 121 - .../org-chef-steamy-kitchen.el | 105 - elpa/org-chef-20191201.1435/org-chef-taste.el | 103 - elpa/org-chef-20191201.1435/org-chef-utils.el | 79 - .../org-chef-wordpress.el | 113 - .../org-chef-xiachufang.el | 118 - elpa/org-chef-20191201.1435/org-chef.el | 153 - .../citeproc/csl/acs-nano.csl | 214 - .../citeproc/csl/author-year.el | 92 - .../citeproc/csl/unsrt-footnote.el | 86 - .../citeproc/csl/unsrt-paren.el | 107 - .../citeproc/csl/unsrt.el | 111 - .../citeproc/readme-author-year.org | 92 - .../citeproc/readme-unsrt.org | 93 - elpa/org-ref-20191023.117/citeproc/readme.bib | 203 - elpa/org-ref-20191023.117/citeproc/readme.org | 1676 ---- elpa/org-ref-20191023.117/doi-utils.el | 1522 --- elpa/org-ref-20191023.117/nist-webbook.el | 42 - elpa/org-ref-20191023.117/org-ref-arxiv.el | 237 - .../org-ref-20191023.117/org-ref-autoloads.el | 1047 -- elpa/org-ref-20191023.117/org-ref-bibtex.el | 1380 --- elpa/org-ref-20191023.117/org-ref-citeproc.el | 919 -- elpa/org-ref-20191023.117/org-ref-core.el | 4039 -------- elpa/org-ref-20191023.117/org-ref-glossary.el | 496 - .../org-ref-helm-bibtex.el | 736 -- .../org-ref-20191023.117/org-ref-helm-cite.el | 770 -- elpa/org-ref-20191023.117/org-ref-helm.el | 474 - elpa/org-ref-20191023.117/org-ref-isbn.el | 192 - elpa/org-ref-20191023.117/org-ref-ivy-cite.el | 562 -- elpa/org-ref-20191023.117/org-ref-ivy.el | 35 - elpa/org-ref-20191023.117/org-ref-latex.el | 147 - elpa/org-ref-20191023.117/org-ref-pdf.el | 282 - elpa/org-ref-20191023.117/org-ref-pgk.el | 16 - elpa/org-ref-20191023.117/org-ref-pkg.el | 22 - elpa/org-ref-20191023.117/org-ref-pubmed.el | 292 - elpa/org-ref-20191023.117/org-ref-reftex.el | 274 - elpa/org-ref-20191023.117/org-ref-sci-id.el | 54 - .../org-ref-20191023.117/org-ref-scifinder.el | 35 - elpa/org-ref-20191023.117/org-ref-scopus.el | 222 - .../org-ref-20191023.117/org-ref-url-utils.el | 408 - elpa/org-ref-20191023.117/org-ref-utils.el | 920 -- elpa/org-ref-20191023.117/org-ref-worldcat.el | 20 - elpa/org-ref-20191023.117/org-ref-wos.el | 107 - elpa/org-ref-20191023.117/org-ref.bib | 332 - elpa/org-ref-20191023.117/org-ref.el | 45 - elpa/org-ref-20191023.117/org-ref.org | 989 -- elpa/org-ref-20191023.117/x2bib.el | 132 - .../ox-jira-20161026.429/ox-jira-autoloads.el | 15 - elpa/ox-jira-20161026.429/ox-jira-pkg.el | 2 - elpa/ox-jira-20161026.429/ox-jira.el | 525 - .../pcre2el-autoloads.el | 217 - elpa/pcre2el-20161120.2103/pcre2el-pkg.el | 2 - elpa/pcre2el-20161120.2103/pcre2el.el | 3157 ------ elpa/sqlite3-20230315.1221/Makefile | 60 + elpa/sqlite3-20230315.1221/consts.c | 1283 +++ elpa/sqlite3-20230315.1221/emacs-module.h | 204 + elpa/sqlite3-20230315.1221/sqlite3-api.c | 973 ++ .../sqlite3-autoloads.el | 26 + elpa/sqlite3-20230315.1221/sqlite3-pkg.el | 14 + elpa/sqlite3-20230315.1221/sqlite3.el | 58 + .../transient-autoloads.el | 26 - elpa/transient-20200125.1308/transient-pkg.el | 12 - elpa/transient-20200125.1308/transient.el | 3189 ------ elpa/transient-20200125.1308/transient.info | 2440 ----- elpa/transient-20220130.1941/dir | 18 - .../transient-autoloads.el | 80 - elpa/transient-20220130.1941/transient-pkg.el | 12 - elpa/transient-20220130.1941/transient.el | 4015 -------- elpa/transient-20220130.1941/transient.info | 2593 ----- elpa/with-editor-20200102.2147/dir | 18 - .../with-editor-autoloads.el | 99 - .../with-editor-pkg.el | 13 - elpa/with-editor-20200102.2147/with-editor.el | 873 -- .../with-editor.info | 343 - elpa/with-editor-20220130.1942/dir | 18 - .../with-editor-autoloads.el | 101 - .../with-editor-pkg.el | 12 - elpa/with-editor-20220130.1942/with-editor.el | 954 -- .../with-editor.info | 382 - 325 files changed, 23610 insertions(+), 84975 deletions(-) delete mode 100644 elpa/bicycle-20210615.1459/bicycle-pkg.el rename elpa/{bicycle-20210615.1459 => bicycle-20230212.2019}/bicycle-autoloads.el (86%) create mode 100644 elpa/bicycle-20230212.2019/bicycle-pkg.el rename elpa/{bicycle-20210615.1459 => bicycle-20230212.2019}/bicycle.el (94%) delete mode 100644 elpa/compat-28.1.2.2.signed delete mode 100644 elpa/compat-28.1.2.2/.dir-locals.el delete mode 100644 elpa/compat-28.1.2.2/NEWS.org delete mode 100644 elpa/compat-28.1.2.2/compat-24.el delete mode 100644 elpa/compat-28.1.2.2/compat-25.el delete mode 100644 elpa/compat-28.1.2.2/compat-26.el delete mode 100644 elpa/compat-28.1.2.2/compat-27.el delete mode 100644 elpa/compat-28.1.2.2/compat-font-lock.el delete mode 100644 elpa/compat-28.1.2.2/compat-help.el delete mode 100644 elpa/compat-28.1.2.2/compat-macs.el delete mode 100644 elpa/compat-28.1.2.2/compat-pkg.el delete mode 100644 elpa/compat-28.1.2.2/compat.el delete mode 100644 elpa/compat-28.1.2.2/compat.info create mode 100644 elpa/compat-29.1.3.4.signed create mode 100644 elpa/compat-29.1.3.4/NEWS.org create mode 100644 elpa/compat-29.1.3.4/compat-25.el create mode 100644 elpa/compat-29.1.3.4/compat-26.el create mode 100644 elpa/compat-29.1.3.4/compat-27.el rename elpa/{compat-28.1.2.2 => compat-29.1.3.4}/compat-28.el (64%) create mode 100644 elpa/compat-29.1.3.4/compat-29.el rename elpa/{compat-28.1.2.2 => compat-29.1.3.4}/compat-autoloads.el (52%) create mode 100644 elpa/compat-29.1.3.4/compat-macs.el create mode 100644 elpa/compat-29.1.3.4/compat-pkg.el create mode 100644 elpa/compat-29.1.3.4/compat.el create mode 100644 elpa/compat-29.1.3.4/compat.info rename elpa/{compat-28.1.2.2 => compat-29.1.3.4}/dir (100%) rename elpa/{dash-20210826.1149 => dash-20230502.1324}/dash-autoloads.el (65%) rename elpa/{dash-20210826.1149 => dash-20230502.1324}/dash-pkg.el (58%) rename elpa/{dash-20210826.1149 => dash-20230502.1324}/dash.el (73%) rename elpa/{dash-20210826.1149 => dash-20230502.1324}/dash.info (85%) rename elpa/{dash-20210826.1149 => dash-20230502.1324}/dir (100%) delete mode 100644 elpa/f-20191110.1357/f-pkg.el rename elpa/{f-20191110.1357 => f-20230116.1032}/f-autoloads.el (64%) create mode 100644 elpa/f-20230116.1032/f-pkg.el create mode 100644 elpa/f-20230116.1032/f-shortdoc.el rename elpa/{f-20191110.1357 => f-20230116.1032}/f.el (53%) rename elpa/{transient-20200125.1308 => forge-20230505.926}/dir (89%) create mode 100644 elpa/forge-20230505.926/forge-autoloads.el create mode 100644 elpa/forge-20230505.926/forge-bitbucket.el create mode 100644 elpa/forge-20230505.926/forge-commands.el create mode 100644 elpa/forge-20230505.926/forge-core.el create mode 100644 elpa/forge-20230505.926/forge-db.el create mode 100644 elpa/forge-20230505.926/forge-gitea.el create mode 100644 elpa/forge-20230505.926/forge-github.el create mode 100644 elpa/forge-20230505.926/forge-gitlab.el create mode 100644 elpa/forge-20230505.926/forge-gogs.el create mode 100644 elpa/forge-20230505.926/forge-issue.el create mode 100644 elpa/forge-20230505.926/forge-list.el create mode 100644 elpa/forge-20230505.926/forge-notify.el create mode 100644 elpa/forge-20230505.926/forge-pkg.el create mode 100644 elpa/forge-20230505.926/forge-post.el create mode 100644 elpa/forge-20230505.926/forge-pullreq.el create mode 100644 elpa/forge-20230505.926/forge-repo.el create mode 100644 elpa/forge-20230505.926/forge-revnote.el create mode 100644 elpa/forge-20230505.926/forge-semi.el create mode 100644 elpa/forge-20230505.926/forge-topic.el create mode 100644 elpa/forge-20230505.926/forge.el create mode 100644 elpa/forge-20230505.926/forge.info delete mode 100644 elpa/ghub-20191007.1420/buck.el delete mode 100644 elpa/ghub-20191007.1420/dir delete mode 100644 elpa/ghub-20191007.1420/ghub-autoloads.el delete mode 100644 elpa/ghub-20191007.1420/ghub-graphql.el delete mode 100644 elpa/ghub-20191007.1420/ghub-pkg.el delete mode 100644 elpa/ghub-20191007.1420/ghub.el delete mode 100644 elpa/ghub-20191007.1420/ghub.info delete mode 100644 elpa/ghub-20191007.1420/glab.el delete mode 100644 elpa/ghub-20191007.1420/gogs.el delete mode 100644 elpa/ghub-20191007.1420/gsexp.el delete mode 100644 elpa/ghub-20191007.1420/gtea.el delete mode 100644 elpa/git-commit-20201222.1527/git-commit-autoloads.el delete mode 100644 elpa/git-commit-20201222.1527/git-commit-pkg.el delete mode 100644 elpa/git-commit-20201222.1527/git-commit.el rename elpa/{git-commit-20220130.2254 => git-commit-20230103.2224}/git-commit-autoloads.el (85%) rename elpa/{git-commit-20220130.2254 => git-commit-20230103.2224}/git-commit-pkg.el (75%) rename elpa/{git-commit-20220130.2254 => git-commit-20230103.2224}/git-commit.el (82%) delete mode 100644 elpa/kubel-20220509.104/kubel-pkg.el rename elpa/{kubel-20220509.104 => kubel-20220723.1655}/kubel-autoloads.el (100%) create mode 100644 elpa/kubel-20220723.1655/kubel-pkg.el rename elpa/{kubel-20220509.104 => kubel-20220723.1655}/kubel.el (99%) delete mode 100644 elpa/lsp-mode-20220201.852/lsp-actionscript.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-ada.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-angular.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-bash.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-beancount.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-clangd.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-clojure.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-cmake.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-completion.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-crystal.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-csharp.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-css.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-d.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-dhall.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-diagnostics.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-dired.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-dockerfile.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-elixir.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-elm.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-erlang.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-eslint.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-fortran.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-fsharp.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-gdscript.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-go.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-graphql.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-groovy.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-hack.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-haxe.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-headerline.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-html.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-icons.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-ido.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-iedit.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-javascript.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-json.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-kotlin.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-lens.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-lua.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-markdown.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-mode-autoloads.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-mode-pkg.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-mode.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-modeline.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-nginx.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-nim.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-nix.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-ocaml.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-perl.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-php.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-prolog.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-protocol.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-purescript.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-pwsh.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-pyls.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-pylsp.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-r.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-racket.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-remark.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-rf.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-rust.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-semantic-tokens.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-solargraph.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-sorbet.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-sqls.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-steep.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-svelte.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-terraform.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-tex.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-toml.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-v.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-vala.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-verilog.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-vetur.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-vhdl.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-vimscript.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-xml.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-yaml.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp-zig.el delete mode 100644 elpa/lsp-mode-20220201.852/lsp.el delete mode 100644 elpa/lsp-mode-readme.txt delete mode 100644 elpa/lsp-ui-20220104.1635/lsp-ui-autoloads.el delete mode 100644 elpa/lsp-ui-20220104.1635/lsp-ui-doc.el delete mode 100644 elpa/lsp-ui-20220104.1635/lsp-ui-doc.html delete mode 100644 elpa/lsp-ui-20220104.1635/lsp-ui-flycheck.el delete mode 100644 elpa/lsp-ui-20220104.1635/lsp-ui-imenu.el delete mode 100644 elpa/lsp-ui-20220104.1635/lsp-ui-peek.el delete mode 100644 elpa/lsp-ui-20220104.1635/lsp-ui-pkg.el delete mode 100644 elpa/lsp-ui-20220104.1635/lsp-ui-sideline.el delete mode 100644 elpa/lsp-ui-20220104.1635/lsp-ui-util.el delete mode 100644 elpa/lsp-ui-20220104.1635/lsp-ui.el delete mode 100644 elpa/lsp-ui-20220104.1635/resources/lightbulb.png delete mode 100644 elpa/lsp-ui-readme.txt delete mode 100644 elpa/magit-20220518.2359/magit-obsolete.el rename elpa/{magit-20220518.2359 => magit-20230502.1321}/AUTHORS.md (96%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/LICENSE (100%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/dir (100%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/git-rebase.el (92%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-apply.el (99%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-autoloads.el (97%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-autorevert.el (90%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-base.el (91%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-bisect.el (86%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-blame.el (96%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-bookmark.el (98%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-branch.el (92%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-bundle.el (95%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-clone.el (84%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-commit.el (84%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-core.el (98%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-diff.el (90%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-ediff.el (93%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-extras.el (97%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-fetch.el (93%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-files.el (95%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-git.el (86%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-gitignore.el (98%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-log.el (94%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-margin.el (97%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-merge.el (92%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-mode.el (85%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-notes.el (98%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-patch.el (99%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-pkg.el (51%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-process.el (96%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-pull.el (99%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-push.el (77%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-reflog.el (95%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-refs.el (94%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-remote.el (90%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-repos.el (97%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-reset.el (97%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-sequence.el (89%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-sparse-checkout.el (97%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-stash.el (94%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-status.el (97%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-submodule.el (93%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-subtree.el (99%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-tag.el (96%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-transient.el (94%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-wip.el (88%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit-worktree.el (75%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit.el (97%) rename elpa/{magit-20220518.2359 => magit-20230502.1321}/magit.info (97%) rename elpa/{magit-section-20220513.1429 => magit-section-20230428.1518}/dir (100%) rename elpa/{magit-section-20220513.1429 => magit-section-20230428.1518}/magit-section-autoloads.el (100%) rename elpa/{magit-section-20220513.1429 => magit-section-20230428.1518}/magit-section-pkg.el (59%) rename elpa/{magit-section-20220513.1429 => magit-section-20230428.1518}/magit-section.el (93%) rename elpa/{magit-section-20220513.1429 => magit-section-20230428.1518}/magit-section.info (97%) delete mode 100644 elpa/org-chef-20191201.1435/org-chef-24kitchen.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-all-recipes.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-autoloads.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-chef-koch.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-cultures-for-health.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-fine-cooking.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-genius-kitchen.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-marmiton.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-martha-stewart.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-nytimes.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-pkg.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-reluctant-gourmet.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-saveur.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-serious-eats.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-simply-recipes.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-steamy-kitchen.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-taste.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-utils.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-wordpress.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef-xiachufang.el delete mode 100644 elpa/org-chef-20191201.1435/org-chef.el delete mode 100644 elpa/org-ref-20191023.117/citeproc/csl/acs-nano.csl delete mode 100644 elpa/org-ref-20191023.117/citeproc/csl/author-year.el delete mode 100644 elpa/org-ref-20191023.117/citeproc/csl/unsrt-footnote.el delete mode 100644 elpa/org-ref-20191023.117/citeproc/csl/unsrt-paren.el delete mode 100644 elpa/org-ref-20191023.117/citeproc/csl/unsrt.el delete mode 100644 elpa/org-ref-20191023.117/citeproc/readme-author-year.org delete mode 100644 elpa/org-ref-20191023.117/citeproc/readme-unsrt.org delete mode 100644 elpa/org-ref-20191023.117/citeproc/readme.bib delete mode 100644 elpa/org-ref-20191023.117/citeproc/readme.org delete mode 100644 elpa/org-ref-20191023.117/doi-utils.el delete mode 100644 elpa/org-ref-20191023.117/nist-webbook.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-arxiv.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-autoloads.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-bibtex.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-citeproc.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-core.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-glossary.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-helm-bibtex.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-helm-cite.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-helm.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-isbn.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-ivy-cite.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-ivy.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-latex.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-pdf.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-pgk.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-pkg.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-pubmed.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-reftex.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-sci-id.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-scifinder.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-scopus.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-url-utils.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-utils.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-worldcat.el delete mode 100644 elpa/org-ref-20191023.117/org-ref-wos.el delete mode 100644 elpa/org-ref-20191023.117/org-ref.bib delete mode 100644 elpa/org-ref-20191023.117/org-ref.el delete mode 100644 elpa/org-ref-20191023.117/org-ref.org delete mode 100644 elpa/org-ref-20191023.117/x2bib.el delete mode 100644 elpa/ox-jira-20161026.429/ox-jira-autoloads.el delete mode 100644 elpa/ox-jira-20161026.429/ox-jira-pkg.el delete mode 100644 elpa/ox-jira-20161026.429/ox-jira.el delete mode 100644 elpa/pcre2el-20161120.2103/pcre2el-autoloads.el delete mode 100644 elpa/pcre2el-20161120.2103/pcre2el-pkg.el delete mode 100644 elpa/pcre2el-20161120.2103/pcre2el.el create mode 100644 elpa/sqlite3-20230315.1221/Makefile create mode 100644 elpa/sqlite3-20230315.1221/consts.c create mode 100644 elpa/sqlite3-20230315.1221/emacs-module.h create mode 100644 elpa/sqlite3-20230315.1221/sqlite3-api.c create mode 100644 elpa/sqlite3-20230315.1221/sqlite3-autoloads.el create mode 100644 elpa/sqlite3-20230315.1221/sqlite3-pkg.el create mode 100644 elpa/sqlite3-20230315.1221/sqlite3.el delete mode 100644 elpa/transient-20200125.1308/transient-autoloads.el delete mode 100644 elpa/transient-20200125.1308/transient-pkg.el delete mode 100644 elpa/transient-20200125.1308/transient.el delete mode 100644 elpa/transient-20200125.1308/transient.info delete mode 100644 elpa/transient-20220130.1941/dir delete mode 100644 elpa/transient-20220130.1941/transient-autoloads.el delete mode 100644 elpa/transient-20220130.1941/transient-pkg.el delete mode 100644 elpa/transient-20220130.1941/transient.el delete mode 100644 elpa/transient-20220130.1941/transient.info delete mode 100644 elpa/with-editor-20200102.2147/dir delete mode 100644 elpa/with-editor-20200102.2147/with-editor-autoloads.el delete mode 100644 elpa/with-editor-20200102.2147/with-editor-pkg.el delete mode 100644 elpa/with-editor-20200102.2147/with-editor.el delete mode 100644 elpa/with-editor-20200102.2147/with-editor.info delete mode 100644 elpa/with-editor-20220130.1942/dir delete mode 100644 elpa/with-editor-20220130.1942/with-editor-autoloads.el delete mode 100644 elpa/with-editor-20220130.1942/with-editor-pkg.el delete mode 100644 elpa/with-editor-20220130.1942/with-editor.el delete mode 100644 elpa/with-editor-20220130.1942/with-editor.info diff --git a/elpa/bicycle-20210615.1459/bicycle-pkg.el b/elpa/bicycle-20210615.1459/bicycle-pkg.el deleted file mode 100644 index a19ee79b..00000000 --- a/elpa/bicycle-20210615.1459/bicycle-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; Generated package description from bicycle.el -*- no-byte-compile: t -*- -(define-package "bicycle" "20210615.1459" "cycle outline and code visibility" '((emacs "25.1")) :commit "2f0d6fbe0e363a0ed1f878316d1c0d7c1d6e1082" :authors '(("Jonas Bernoulli" . "jonas@bernoul.li")) :maintainer '("Jonas Bernoulli" . "jonas@bernoul.li") :keywords '("outlines") :url "https://github.com/tarsius/bicycle") diff --git a/elpa/bicycle-20210615.1459/bicycle-autoloads.el b/elpa/bicycle-20230212.2019/bicycle-autoloads.el similarity index 86% rename from elpa/bicycle-20210615.1459/bicycle-autoloads.el rename to elpa/bicycle-20230212.2019/bicycle-autoloads.el index 257d0b3f..8011bf32 100644 --- a/elpa/bicycle-20210615.1459/bicycle-autoloads.el +++ b/elpa/bicycle-20230212.2019/bicycle-autoloads.el @@ -1,4 +1,4 @@ -;;; bicycle-autoloads.el --- automatically extracted autoloads +;;; bicycle-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- ;; ;;; Code: @@ -30,7 +30,7 @@ Cycle visibility of all sections. collapsed individually (using a `hideshow' command or function)." t nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "bicycle" '("bicycle-" "outline-code-level"))) +(register-definition-prefixes "bicycle" '("bicycle-" "outline-code-level")) ;;;*** diff --git a/elpa/bicycle-20230212.2019/bicycle-pkg.el b/elpa/bicycle-20230212.2019/bicycle-pkg.el new file mode 100644 index 00000000..9fbb223a --- /dev/null +++ b/elpa/bicycle-20230212.2019/bicycle-pkg.el @@ -0,0 +1,2 @@ +;;; Generated package description from bicycle.el -*- no-byte-compile: t -*- +(define-package "bicycle" "20230212.2019" "Cycle outline and code visibility" '((emacs "25.1") (compat "29.1.3.4")) :commit "20f0637365a9bf0a899a7663b1f8caec609de19a" :authors '(("Jonas Bernoulli" . "jonas@bernoul.li")) :maintainer '("Jonas Bernoulli" . "jonas@bernoul.li") :keywords '("outlines") :url "https://github.com/tarsius/bicycle") diff --git a/elpa/bicycle-20210615.1459/bicycle.el b/elpa/bicycle-20230212.2019/bicycle.el similarity index 94% rename from elpa/bicycle-20210615.1459/bicycle.el rename to elpa/bicycle-20230212.2019/bicycle.el index 15e91466..220b1132 100644 --- a/elpa/bicycle-20210615.1459/bicycle.el +++ b/elpa/bicycle-20230212.2019/bicycle.el @@ -1,29 +1,29 @@ -;;; bicycle.el --- cycle outline and code visibility -*- lexical-binding: t -*- +;;; bicycle.el --- Cycle outline and code visibility -*- lexical-binding:t -*- -;; Copyright (C) 2018-2021 Jonas Bernoulli +;; Copyright (C) 2018-2023 Jonas Bernoulli ;; Author: Jonas Bernoulli ;; Homepage: https://github.com/tarsius/bicycle ;; Keywords: outlines -;; Package-Version: 20210615.1459 -;; Package-Commit: 2f0d6fbe0e363a0ed1f878316d1c0d7c1d6e1082 +;; Package-Version: 20230212.2019 +;; Package-Commit: 20f0637365a9bf0a899a7663b1f8caec609de19a -;; Package-Requires: ((emacs "25.1")) +;; Package-Requires: ((emacs "25.1") (compat "29.1.3.4")) -;; 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. +;; SPDX-License-Identifier: GPL-3.0-or-later +;; 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 of the License, +;; 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 . +;; along with this file. If not, see . ;;; Commentary: @@ -52,11 +52,13 @@ ;; ;; (use-package prog-mode ;; :config -;; (add-hook 'prog-mode-hook 'outline-minor-mode) -;; (add-hook 'prog-mode-hook 'hs-minor-mode)) +;; (add-hook 'prog-mode-hook #'outline-minor-mode) +;; (add-hook 'prog-mode-hook #'hs-minor-mode)) ;;; Code: +(require 'compat) + (require 'hideshow) (require 'outline) diff --git a/elpa/compat-28.1.2.2.signed b/elpa/compat-28.1.2.2.signed deleted file mode 100644 index 0973a8f4..00000000 --- a/elpa/compat-28.1.2.2.signed +++ /dev/null @@ -1 +0,0 @@ -Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) (trust undefined) created at 2022-08-25T23:05:04+0200 using RSA \ No newline at end of file diff --git a/elpa/compat-28.1.2.2/.dir-locals.el b/elpa/compat-28.1.2.2/.dir-locals.el deleted file mode 100644 index 900dee5f..00000000 --- a/elpa/compat-28.1.2.2/.dir-locals.el +++ /dev/null @@ -1,7 +0,0 @@ -;;; Directory Local Variables -;;; For more information see (info "(emacs) Directory Variables") - -((emacs-lisp-mode - (byte-compile-docstring-max-column . 100) - (show-trailing-whitespace . t) - (indent-tabs-mode . nil))) diff --git a/elpa/compat-28.1.2.2/NEWS.org b/elpa/compat-28.1.2.2/NEWS.org deleted file mode 100644 index abb3448d..00000000 --- a/elpa/compat-28.1.2.2/NEWS.org +++ /dev/null @@ -1,108 +0,0 @@ -#+options: toc:nil num:nil -#+link: compat https://todo.sr.ht/~pkal/compat/ - -* Release of "Compat" Version 28.1.2.2 - -This is a minor release that hopes to address [[compat:7]]. - -(Release <2022-08-25 Thu>) - -* Release of "Compat" Version 28.1.2.1 - -This is a minor release adding the following changes: - -- Add =derived-mode-p= defined in Emacs 27 -- Add =provided-mode-derived-p= defined in Emacs 27 -- Add =read-multiple-choice= defined in Emacs 26 -- Add =file-name-absolute-p= defined in Emacs 28 - -The only other notable change is that the manual has been rewritten to -include much more documentation that had been the case previously. - -(Release <2022-08-24 Wed>) - -* Release of "Compat" Version 28.1.2.0 - -The main change of this release has been the major simplification of -Compat's initialisation system, improving the situation around issues -people had been reporting ([[compat:4]], once again) with unconventional -or unpopular packaging systems. - -In addition to this, the following functional changes have been made: - -- Fix =format-prompt= of an empty string as "default" argument -- Add =decoded-time-period= defined in Emacs 28 -- Add =subr-primitive-p= defined in Emacs 28 - -Minor improvements to manual are also part of this release. - -(Release <2022-07-18 Mon>) - -* Release of "Compat" Version 28.1.1.3 - -This release just contains a hot-fix for an issue introduced in the -last version, where compat.el raises an error during byte compilation. -See [[compat:4]]. - -(Release <2022-06-19 Sun>) - -* Release of "Compat" Version 28.1.1.2 - -Two main changes have necessitated a new patch release: - -1. Fix issues related to the loading of compat when uncompiled. See - [[https://lists.sr.ht/~pkal/compat-devel/%3C20220530191000.2183047-1-jonas%40bernoul.li%3E][this thread]] for more details on the problem. -2. Fix issues related to the loading of compat on old pre-releases - (think of 28.0.50). See [[https://lists.sr.ht/~pkal/compat-devel/%3Cf8635d7d-e233-448f-b325-9e850363241c%40www.fastmail.com%3E][this thread]] for more details on the - problem. - -(Released <2022-06-22 Wed>) - -* Release of "Compat" Version 28.1.1.1 - -This is a minor release fixing a bug in =json-serialize=, that could -cause unintended side-effects, not related to packages using Compat -directly (see [[compat:2]]). - -(Released <2022-05-05 Thu>) - -* Release of "Compat" Version 28.1.1.0 - -This release mostly fixes a number of smaller bugs that were not -identified as of 28.1.0.0. Nevertheless these warrent a version bump, -as some of these changes a functional. These include: - -- The addition of the =file-attribute-*= accessor functions. -- The addition of =file-attribute-collect=. -- Improvements to the Texinfo manual (via Jonas Bernoulli's recent - work on =ox-texinfo=). For the time being, the Texinfo file is - maintained in the repository itself, next to the =MANUAL= file. - This might change in the future. -- Adding a prefix to =string-trim=, =string-trim-left= and - =string-trim-right= (i.e. now =compat-string-trim=, - =compat-string-trim-left= and =compat-string-trim-right=) -- Improving the version inference used in the =compat-*= macros. - This improves the compile-time optimisation that strips away - functions that are known to be defined for a specific version. -- The addition of generalised variable (=setf=) support for - =compat-alist-get=. -- The addition of =image-property= and generalised variable support - for =image-property=. -- The addition of the function =compat-executable-find=. -- The addition of the function =compat-dired-get-marked-files=. -- The addition of the function =exec-path=. -- The addition of the function =make-lock-file-name=. -- The addition of the function =null-device=. -- The addition of the function =time-equal-p=. -- The addition of the function =date-days-in-month=. -- Handling out-of-directory byte compilation better. -- Fixing the usage and edge-cases of =and-let*=. - -Furthermore a bug tracker was added: https://todo.sr.ht/~pkal/compat, -which is the preferred way to report issues or feature requests. -General problems, questions, etc. are still better discussed on the -development mailing list: https://lists.sr.ht/~pkal/compat-devel. - -(Released <2022-04-22 Fri>) - - diff --git a/elpa/compat-28.1.2.2/compat-24.el b/elpa/compat-28.1.2.2/compat-24.el deleted file mode 100644 index d38f0511..00000000 --- a/elpa/compat-28.1.2.2/compat-24.el +++ /dev/null @@ -1,495 +0,0 @@ -;;; compat-24.el --- Compatibility Layer for Emacs 24.4 -*- lexical-binding: t; -*- - -;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. - -;; Author: Philip Kaludercic -;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht> -;; URL: https://git.sr.ht/~pkal/compat/ -;; Keywords: lisp - -;; 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 . - -;;; Commentary: - -;; Find here the functionality added in Emacs 24.4, needed by older -;; versions. -;; -;; Only load this library if you need to use one of the following -;; functions: -;; -;; - `compat-=' -;; - `compat-<' -;; - `compat->' -;; - `compat-<=' -;; - `compat->=' -;; - `split-string'. - -;;; Code: - -(require 'compat-macs "compat-macs.el") - -(compat-declare-version "24.4") - -;;;; Defined in data.c - -(compat-defun = (number-or-marker &rest numbers-or-markers) - "Handle multiple arguments." - :prefix t - (catch 'fail - (while numbers-or-markers - (unless (= number-or-marker (car numbers-or-markers)) - (throw 'fail nil)) - (setq number-or-marker (pop numbers-or-markers))) - t)) - -(compat-defun < (number-or-marker &rest numbers-or-markers) - "Handle multiple arguments." - :prefix t - (catch 'fail - (while numbers-or-markers - (unless (< number-or-marker (car numbers-or-markers)) - (throw 'fail nil)) - (setq number-or-marker (pop numbers-or-markers))) - t)) - -(compat-defun > (number-or-marker &rest numbers-or-markers) - "Handle multiple arguments." - :prefix t - (catch 'fail - (while numbers-or-markers - (unless (> number-or-marker (car numbers-or-markers)) - (throw 'fail nil)) - (setq number-or-marker (pop numbers-or-markers))) - t)) - -(compat-defun <= (number-or-marker &rest numbers-or-markers) - "Handle multiple arguments." - :prefix t - (catch 'fail - (while numbers-or-markers - (unless (<= number-or-marker (car numbers-or-markers)) - (throw 'fail nil)) - (setq number-or-marker (pop numbers-or-markers))) - t)) - -(compat-defun >= (number-or-marker &rest numbers-or-markers) - "Handle multiple arguments." - :prefix t - (catch 'fail - (while numbers-or-markers - (unless (>= number-or-marker (pop numbers-or-markers)) - (throw 'fail nil))) - t)) - -(compat-defun bool-vector-exclusive-or (a b &optional c) - "Return A ^ B, bitwise exclusive or. -If optional third argument C is given, store result into C. -A, B, and C must be bool vectors of the same length. -Return the destination vector if it changed or nil otherwise." - (unless (bool-vector-p a) - (signal 'wrong-type-argument (list 'bool-vector-p a))) - (unless (bool-vector-p b) - (signal 'wrong-type-argument (list 'bool-vector-p b))) - (unless (or (null c) (bool-vector-p c)) - (signal 'wrong-type-argument (list 'bool-vector-p c))) - (when (/= (length a) (length b)) - (signal 'wrong-length-argument (list (length a) (length b)))) - (let ((dest (or c (make-bool-vector (length a) nil))) changed) - (when (/= (length a) (length dest)) - (signal 'wrong-length-argument (list (length a) (length dest)))) - (dotimes (i (length dest)) - (let ((val (not (eq (aref a i) (aref b i))))) - (unless (eq val (aref dest i)) - (setq changed t)) - (aset dest i val))) - (if c (and changed c) dest))) - -(compat-defun bool-vector-union (a b &optional c) - "Return A | B, bitwise or. -If optional third argument C is given, store result into C. -A, B, and C must be bool vectors of the same length. -Return the destination vector if it changed or nil otherwise." - (unless (bool-vector-p a) - (signal 'wrong-type-argument (list 'bool-vector-p a))) - (unless (bool-vector-p b) - (signal 'wrong-type-argument (list 'bool-vector-p b))) - (unless (or (null c) (bool-vector-p c)) - (signal 'wrong-type-argument (list 'bool-vector-p c))) - (when (/= (length a) (length b)) - (signal 'wrong-length-argument (list (length a) (length b)))) - (let ((dest (or c (make-bool-vector (length a) nil))) changed) - (when (/= (length a) (length dest)) - (signal 'wrong-length-argument (list (length a) (length dest)))) - (dotimes (i (length dest)) - (let ((val (or (aref a i) (aref b i)))) - (unless (eq val (aref dest i)) - (setq changed t)) - (aset dest i val))) - (if c (and changed c) dest))) - -(compat-defun bool-vector-intersection (a b &optional c) - "Return A & B, bitwise and. -If optional third argument C is given, store result into C. -A, B, and C must be bool vectors of the same length. -Return the destination vector if it changed or nil otherwise." - (unless (bool-vector-p a) - (signal 'wrong-type-argument (list 'bool-vector-p a))) - (unless (bool-vector-p b) - (signal 'wrong-type-argument (list 'bool-vector-p b))) - (unless (or (null c) (bool-vector-p c)) - (signal 'wrong-type-argument (list 'bool-vector-p c))) - (when (/= (length a) (length b)) - (signal 'wrong-length-argument (list (length a) (length b)))) - (let ((dest (or c (make-bool-vector (length a) nil))) changed) - (when (/= (length a) (length dest)) - (signal 'wrong-length-argument (list (length a) (length dest)))) - (dotimes (i (length dest)) - (let ((val (and (aref a i) (aref b i)))) - (unless (eq val (aref dest i)) - (setq changed t)) - (aset dest i val))) - (if c (and changed c) dest))) - -(compat-defun bool-vector-set-difference (a b &optional c) - "Return A &~ B, set difference. -If optional third argument C is given, store result into C. -A, B, and C must be bool vectors of the same length. -Return the destination vector if it changed or nil otherwise." - (unless (bool-vector-p a) - (signal 'wrong-type-argument (list 'bool-vector-p a))) - (unless (bool-vector-p b) - (signal 'wrong-type-argument (list 'bool-vector-p b))) - (unless (or (null c) (bool-vector-p c)) - (signal 'wrong-type-argument (list 'bool-vector-p c))) - (when (/= (length a) (length b)) - (signal 'wrong-length-argument (list (length a) (length b)))) - (let ((dest (or c (make-bool-vector (length a) nil))) changed) - (when (/= (length a) (length dest)) - (signal 'wrong-length-argument (list (length a) (length dest)))) - (dotimes (i (length dest)) - (let ((val (and (aref a i) (not (aref b i))))) - (unless (eq val (aref dest i)) - (setq changed t)) - (aset dest i val))) - (if c (and changed c) dest))) - -(compat-defun bool-vector-not (a &optional b) - "Compute ~A, set complement. -If optional second argument B is given, store result into B. -A and B must be bool vectors of the same length. -Return the destination vector." - (unless (bool-vector-p a) - (signal 'wrong-type-argument (list 'bool-vector-p a))) - (unless (or (null b) (bool-vector-p b)) - (signal 'wrong-type-argument (list 'bool-vector-p b))) - (let ((dest (or b (make-bool-vector (length a) nil)))) - (when (/= (length a) (length dest)) - (signal 'wrong-length-argument (list (length a) (length dest)))) - (dotimes (i (length dest)) - (aset dest i (not (aref a i)))) - dest)) - -(compat-defun bool-vector-subsetp (a b) - "Return t if every t value in A is also t in B, nil otherwise. -A and B must be bool vectors of the same length." - (unless (bool-vector-p a) - (signal 'wrong-type-argument (list 'bool-vector-p a))) - (unless (bool-vector-p b) - (signal 'wrong-type-argument (list 'bool-vector-p b))) - (when (/= (length a) (length b)) - (signal 'wrong-length-argument (list (length a) (length b)))) - (catch 'not-subset - (dotimes (i (length a)) - (when (if (aref a i) (not (aref b i)) nil) - (throw 'not-subset nil))) - t)) - -(compat-defun bool-vector-count-consecutive (a b i) - "Count how many consecutive elements in A equal B starting at I. -A is a bool vector, B is t or nil, and I is an index into A." - (unless (bool-vector-p a) - (signal 'wrong-type-argument (list 'bool-vector-p a))) - (setq b (and b t)) ;normalise to nil or t - (unless (< i (length a)) - (signal 'args-out-of-range (list a i))) - (let ((len (length a)) (n i)) - (while (and (< i len) (eq (aref a i) b)) - (setq i (1+ i))) - (- i n))) - -(compat-defun bool-vector-count-population (a) - "Count how many elements in A are t. -A is a bool vector. To count A's nil elements, subtract the -return value from A's length." - (unless (bool-vector-p a) - (signal 'wrong-type-argument (list 'bool-vector-p a))) - (let ((n 0)) - (dotimes (i (length a)) - (when (aref a i) - (setq n (1+ n)))) - n)) - -;;;; Defined in subr.el - -;;* UNTESTED -(compat-defmacro with-eval-after-load (file &rest body) - "Execute BODY after FILE is loaded. -FILE is normally a feature name, but it can also be a file name, -in case that file does not provide any feature. See `eval-after-load' -for more details about the different forms of FILE and their semantics." - (declare (indent 1) (debug (form def-body))) - ;; See https://nullprogram.com/blog/2018/02/22/ on how - ;; `eval-after-load' is used to preserve compatibility with 24.3. - `(eval-after-load ,file `(funcall ',,`(lambda () ,@body)))) - -(compat-defun special-form-p (object) - "Non-nil if and only if OBJECT is a special form." - (if (and (symbolp object) (fboundp object)) - (setq object (condition-case nil - (indirect-function object) - (void-function nil)))) - (and (subrp object) (eq (cdr (subr-arity object)) 'unevalled))) - -(compat-defun macrop (object) - "Non-nil if and only if OBJECT is a macro." - (let ((def (condition-case nil - (indirect-function object) - (void-function nil)))) - (when (consp def) - (or (eq 'macro (car def)) - (and (autoloadp def) (memq (nth 4 def) '(macro t))))))) - -(compat-defun string-suffix-p (suffix string &optional ignore-case) - "Return non-nil if SUFFIX is a suffix of STRING. -If IGNORE-CASE is non-nil, the comparison is done without paying -attention to case differences." - (let ((start-pos (- (length string) (length suffix)))) - (and (>= start-pos 0) - (eq t (compare-strings suffix nil nil - string start-pos nil ignore-case))))) - -(compat-defun split-string (string &optional separators omit-nulls trim) - "Extend `split-string' by a TRIM argument. -The remaining arguments STRING, SEPARATORS and OMIT-NULLS are -handled just as with `split-string'." - :prefix t - (let* ((token (split-string string separators omit-nulls)) - (trimmed (if trim - (mapcar - (lambda (token) - (when (string-match (concat "\\`" trim) token) - (setq token (substring token (match-end 0)))) - (when (string-match (concat trim "\\'") token) - (setq token (substring token 0 (match-beginning 0)))) - token) - token) - token))) - (if omit-nulls (delete "" trimmed) trimmed))) - -(compat-defun delete-consecutive-dups (list &optional circular) - "Destructively remove `equal' consecutive duplicates from LIST. -First and last elements are considered consecutive if CIRCULAR is -non-nil." - (let ((tail list) last) - (while (cdr tail) - (if (equal (car tail) (cadr tail)) - (setcdr tail (cddr tail)) - (setq last tail - tail (cdr tail)))) - (if (and circular - last - (equal (car tail) (car list))) - (setcdr last nil))) - list) - -;;* UNTESTED -(compat-defun define-error (name message &optional parent) - "Define NAME as a new error signal. -MESSAGE is a string that will be output to the echo area if such an error -is signaled without being caught by a `condition-case'. -PARENT is either a signal or a list of signals from which it inherits. -Defaults to `error'." - (unless parent (setq parent 'error)) - (let ((conditions - (if (consp parent) - (apply #'append - (mapcar (lambda (parent) - (cons parent - (or (get parent 'error-conditions) - (error "Unknown signal `%s'" parent)))) - parent)) - (cons parent (get parent 'error-conditions))))) - (put name 'error-conditions - (delete-dups (copy-sequence (cons name conditions)))) - (when message (put name 'error-message message)))) - -;;;; Defined in minibuffer.el - -;;* UNTESTED -(compat-defun completion-table-with-cache (fun &optional ignore-case) - "Create dynamic completion table from function FUN, with cache. -This is a wrapper for `completion-table-dynamic' that saves the last -argument-result pair from FUN, so that several lookups with the -same argument (or with an argument that starts with the first one) -only need to call FUN once. This can be useful when FUN performs a -relatively slow operation, such as calling an external process. - -When IGNORE-CASE is non-nil, FUN is expected to be case-insensitive." - (let* (last-arg last-result - (new-fun - (lambda (arg) - (if (and last-arg (string-prefix-p last-arg arg ignore-case)) - last-result - (prog1 - (setq last-result (funcall fun arg)) - (setq last-arg arg)))))) - (completion-table-dynamic new-fun))) - -;;* UNTESTED -(compat-defun completion-table-merge (&rest tables) - "Create a completion table that collects completions from all TABLES." - (lambda (string pred action) - (cond - ((null action) - (let ((retvals (mapcar (lambda (table) - (try-completion string table pred)) - tables))) - (if (member string retvals) - string - (try-completion string - (mapcar (lambda (value) - (if (eq value t) string value)) - (delq nil retvals)) - pred)))) - ((eq action t) - (apply #'append (mapcar (lambda (table) - (all-completions string table pred)) - tables))) - (t - (completion--some (lambda (table) - (complete-with-action action table string pred)) - tables))))) - -;;;; Defined in subr-x.el - -;;* UNTESTED -(compat-advise require (feature &rest args) - "Allow for Emacs 24.x to require the inexistent FEATURE subr-x." - ;; As the compatibility advise around `require` is more a hack than - ;; of of actual value, the highlighting is suppressed. - :no-highlight t - (if (eq feature 'subr-x) - (let ((entry (assq feature after-load-alist))) - (let ((load-file-name nil)) - (dolist (form (cdr entry)) - (funcall (eval form t))))) - (apply oldfun feature args))) - -(compat-defun hash-table-keys (hash-table) - "Return a list of keys in HASH-TABLE." - (let (values) - (maphash - (lambda (k _v) (push k values)) - hash-table) - values)) - -(compat-defun hash-table-values (hash-table) - "Return a list of values in HASH-TABLE." - (let (values) - (maphash - (lambda (_k v) (push v values)) - hash-table) - values)) - -(compat-defun string-empty-p (string) - "Check whether STRING is empty." - (string= string "")) - -(compat-defun string-join (strings &optional separator) - "Join all STRINGS using SEPARATOR. -Optional argument SEPARATOR must be a string, a vector, or a list of -characters; nil stands for the empty string." - (mapconcat #'identity strings separator)) - -(compat-defun string-blank-p (string) - "Check whether STRING is either empty or only whitespace. -The following characters count as whitespace here: space, tab, newline and -carriage return." - (string-match-p "\\`[ \t\n\r]*\\'" string)) - -(compat-defun string-remove-prefix (prefix string) - "Remove PREFIX from STRING if present." - (if (string-prefix-p prefix string) - (substring string (length prefix)) - string)) - -(compat-defun string-remove-suffix (suffix string) - "Remove SUFFIX from STRING if present." - (if (string-suffix-p suffix string) - (substring string 0 (- (length string) (length suffix))) - string)) - -;;;; Defined in faces.el - -;;* UNTESTED -(compat-defun face-spec-set (face spec &optional spec-type) - "Set the FACE's spec SPEC, define FACE, and recalculate its attributes. -See `defface' for the format of SPEC. - -The appearance of each face is controlled by its specs (set via -this function), and by the internal frame-specific face -attributes (set via `set-face-attribute'). - -This function also defines FACE as a valid face name if it is not -already one, and (re)calculates its attributes on existing -frames. - -The optional argument SPEC-TYPE determines which spec to set: - nil, omitted or `face-override-spec' means the override spec, - which overrides all the other types of spec mentioned below - (this is usually what you want if calling this function - outside of Custom code); - `customized-face' or `saved-face' means the customized spec or - the saved custom spec; - `face-defface-spec' means the default spec - (usually set only via `defface'); - `reset' means to ignore SPEC, but clear the `customized-face' - and `face-override-spec' specs; -Any other value means not to set any spec, but to run the -function for defining FACE and recalculating its attributes." - (if (get face 'face-alias) - (setq face (get face 'face-alias))) - ;; Save SPEC to the relevant symbol property. - (unless spec-type - (setq spec-type 'face-override-spec)) - (if (memq spec-type '(face-defface-spec face-override-spec - customized-face saved-face)) - (put face spec-type spec)) - (if (memq spec-type '(reset saved-face)) - (put face 'customized-face nil)) - ;; Setting the face spec via Custom empties out any override spec, - ;; similar to how setting a variable via Custom changes its values. - (if (memq spec-type '(customized-face saved-face reset)) - (put face 'face-override-spec nil)) - ;; If we reset the face based on its custom spec, it is unmodified - ;; as far as Custom is concerned. - (unless (eq face 'face-override-spec) - (put face 'face-modified nil)) - ;; Initialize the face if it does not exist, then recalculate. - (make-empty-face face) - (dolist (frame (frame-list)) - (face-spec-recalc face frame))) - -(compat--inhibit-prefixed (provide 'compat-24)) -;;; compat-24.el ends here diff --git a/elpa/compat-28.1.2.2/compat-25.el b/elpa/compat-28.1.2.2/compat-25.el deleted file mode 100644 index 471fbee8..00000000 --- a/elpa/compat-28.1.2.2/compat-25.el +++ /dev/null @@ -1,322 +0,0 @@ -;;; compat-25.el --- Compatibility Layer for Emacs 25.1 -*- lexical-binding: t; -*- - -;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. - -;; Author: Philip Kaludercic -;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht> -;; URL: https://git.sr.ht/~pkal/compat/ -;; Keywords: lisp - -;; 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 . - -;;; Commentary: - -;; Find here the functionality added in Emacs 25.1, needed by older -;; versions. -;; -;; Only load this library if you need to use one of the following -;; functions: -;; -;; - `compat-sort' - -;;; Code: - -(require 'compat-macs "compat-macs.el") - -(compat-declare-version "25.1") - -;;;; Defined in alloc.c - -(compat-defun bool-vector (&rest objects) - "Return a new bool-vector with specified arguments as elements. -Allows any number of arguments, including zero. -usage: (bool-vector &rest OBJECTS)" - (let ((vec (make-bool-vector (length objects) nil)) - (i 0)) - (while objects - (when (car objects) - (aset vec i t)) - (setq objects (cdr objects) - i (1+ i))) - vec)) - -;;;; Defined in fns.c - -(compat-defun sort (seq predicate) - "Extend `sort' to sort SEQ as a vector." - :prefix t - (cond - ((listp seq) - (sort seq predicate)) - ((vectorp seq) - (let ((cseq (sort (append seq nil) predicate))) - (dotimes (i (length cseq)) - (setf (aref seq i) (nth i cseq))) - (apply #'vector cseq))) - ((signal 'wrong-type-argument 'list-or-vector-p)))) - -;;;; Defined in editfns.c - -(compat-defun format-message (string &rest objects) - "Format a string out of a format-string and arguments. -The first argument is a format control string. -The other arguments are substituted into it to make the result, a string. - -This implementation is equivalent to `format'." - (apply #'format string objects)) - -;;;; Defined in minibuf.c - -;; TODO advise read-buffer to handle 4th argument - -;;;; Defined in fileio.c - -(compat-defun directory-name-p (name) - "Return non-nil if NAME ends with a directory separator character." - :realname compat--directory-name-p - (eq (eval-when-compile - (if (memq system-type '(cygwin windows-nt ms-dos)) - ?\\ ?/)) - (aref name (1- (length name))))) - -;;;; Defined in subr.el - -(compat-defun string-greaterp (string1 string2) - "Return non-nil if STRING1 is greater than STRING2 in lexicographic order. -Case is significant. -Symbols are also allowed; their print names are used instead." - (string-lessp string2 string1)) - -;;* UNTESTED -(compat-defmacro with-file-modes (modes &rest body) - "Execute BODY with default file permissions temporarily set to MODES. -MODES is as for `set-default-file-modes'." - (declare (indent 1) (debug t)) - (let ((umask (make-symbol "umask"))) - `(let ((,umask (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes ,modes) - ,@body) - (set-default-file-modes ,umask))))) - -(compat-defun alist-get (key alist &optional default remove testfn) - "Find the first element of ALIST whose `car' equals KEY and return its `cdr'. -If KEY is not found in ALIST, return DEFAULT. -Equality with KEY is tested by TESTFN, defaulting to `eq'." - :realname compat--alist-get-full-elisp - (ignore remove) - (let (entry) - (cond - ((or (null testfn) (eq testfn 'eq)) - (setq entry (assq key alist))) - ((eq testfn 'equal) - (setq entry (assoc key alist))) - ((catch 'found - (dolist (ent alist) - (when (and (consp ent) (funcall testfn (car ent) key)) - (throw 'found (setq entry ent)))) - default))) - (if entry (cdr entry) default))) - -;;;; Defined in subr-x.el - -(compat-defmacro if-let (spec then &rest else) - "Bind variables according to SPEC and evaluate THEN or ELSE. -Evaluate each binding in turn, as in `let*', stopping if a -binding value is nil. If all are non-nil return the value of -THEN, otherwise the last form in ELSE. - -Each element of SPEC is a list (SYMBOL VALUEFORM) that binds -SYMBOL to the value of VALUEFORM. An element can additionally be -of the form (VALUEFORM), which is evaluated and checked for nil; -i.e. SYMBOL can be omitted if only the test result is of -interest. It can also be of the form SYMBOL, then the binding of -SYMBOL is checked for nil. - -As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING) -like \((SYMBOL SOMETHING)). This exists for backward compatibility -with an old syntax that accepted only one binding." - :realname compat--if-let - :feature 'subr-x - (declare (indent 2) - (debug ([&or (symbolp form) - (&rest [&or symbolp (symbolp form) (form)])] - body))) - (when (and (<= (length spec) 2) - (not (listp (car spec)))) - ;; Adjust the single binding case - (setq spec (list spec))) - `(compat--if-let* ,spec ,then ,(macroexp-progn else))) - -(compat-defmacro when-let (spec &rest body) - "Bind variables according to SPEC and conditionally evaluate BODY. -Evaluate each binding in turn, stopping if a binding value is nil. -If all are non-nil, return the value of the last form in BODY. - -The variable list SPEC is the same as in `if-let'." - :feature 'subr-x - (declare (indent 1) (debug if-let)) - `(compat--if-let ,spec ,(macroexp-progn body))) - -(compat-defmacro thread-first (&rest forms) - "Thread FORMS elements as the first argument of their successor. -Example: - (thread-first - 5 - (+ 20) - (/ 25) - - - (+ 40)) -Is equivalent to: - (+ (- (/ (+ 5 20) 25)) 40) -Note how the single `-' got converted into a list before -threading." - :feature 'subr-x - (declare (indent 1) - (debug (form &rest [&or symbolp (sexp &rest form)]))) - (let ((body (car forms))) - (dolist (form (cdr forms)) - (when (symbolp form) - (setq form (list form))) - (setq body (append (list (car form)) - (list body) - (cdr form)))) - body)) - -(compat-defmacro thread-last (&rest forms) - "Thread FORMS elements as the last argument of their successor. -Example: - (thread-last - 5 - (+ 20) - (/ 25) - - - (+ 40)) -Is equivalent to: - (+ 40 (- (/ 25 (+ 20 5)))) -Note how the single `-' got converted into a list before -threading." - :feature 'subr-x - (declare (indent 1) (debug thread-first)) - (let ((body (car forms))) - (dolist (form (cdr forms)) - (when (symbolp form) - (setq form (list form))) - (setq body (append form (list body)))) - body)) - -;;;; Defined in macroexp.el - -(declare-function macrop nil (object)) -(compat-defun macroexpand-1 (form &optional environment) - "Perform (at most) one step of macro expansion." - :feature 'macroexp - (cond - ((consp form) - (let* ((head (car form)) - (env-expander (assq head environment))) - (if env-expander - (if (cdr env-expander) - (apply (cdr env-expander) (cdr form)) - form) - (if (not (and (symbolp head) (fboundp head))) - form - (let ((def (autoload-do-load (symbol-function head) head 'macro))) - (cond - ;; Follow alias, but only for macros, otherwise we may end up - ;; skipping an important compiler-macro (e.g. cl--block-wrapper). - ((and (symbolp def) (macrop def)) (cons def (cdr form))) - ((not (consp def)) form) - (t - (if (eq 'macro (car def)) - (apply (cdr def) (cdr form)) - form)))))))) - (t form))) - -;;;; Defined in byte-run.el - -;;* UNTESTED -(compat-defun function-put (func prop value) - "Set FUNCTION's property PROP to VALUE. -The namespace for PROP is shared with symbols. -So far, FUNCTION can only be a symbol, not a lambda expression." - :version "24.4" - (put func prop value)) - -;;;; Defined in files.el - -;;* UNTESTED -(compat-defun directory-files-recursively - (dir regexp &optional include-directories predicate follow-symlinks) - "Return list of all files under directory DIR whose names match REGEXP. -This function works recursively. Files are returned in \"depth -first\" order, and files from each directory are sorted in -alphabetical order. Each file name appears in the returned list -in its absolute form. - -By default, the returned list excludes directories, but if -optional argument INCLUDE-DIRECTORIES is non-nil, they are -included. - -PREDICATE can be either nil (which means that all subdirectories -of DIR are descended into), t (which means that subdirectories that -can't be read are ignored), or a function (which is called with -the name of each subdirectory, and should return non-nil if the -subdirectory is to be descended into). - -If FOLLOW-SYMLINKS is non-nil, symbolic links that point to -directories are followed. Note that this can lead to infinite -recursion." - :realname compat--directory-files-recursively - (let* ((result nil) - (files nil) - (dir (directory-file-name dir)) - ;; When DIR is "/", remote file names like "/method:" could - ;; also be offered. We shall suppress them. - (tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir))))) - (dolist (file (sort (file-name-all-completions "" dir) - 'string<)) - (unless (member file '("./" "../")) - (if (directory-name-p file) - (let* ((leaf (substring file 0 (1- (length file)))) - (full-file (concat dir "/" leaf))) - ;; Don't follow symlinks to other directories. - (when (and (or (not (file-symlink-p full-file)) - (and (file-symlink-p full-file) - follow-symlinks)) - ;; Allow filtering subdirectories. - (or (eq predicate nil) - (eq predicate t) - (funcall predicate full-file))) - (let ((sub-files - (if (eq predicate t) - (condition-case nil - (compat--directory-files-recursively - full-file regexp include-directories - predicate follow-symlinks) - (file-error nil)) - (compat--directory-files-recursively - full-file regexp include-directories - predicate follow-symlinks)))) - (setq result (nconc result sub-files)))) - (when (and include-directories - (string-match regexp leaf)) - (setq result (nconc result (list full-file))))) - (when (string-match regexp file) - (push (concat dir "/" file) files))))) - (nconc result (nreverse files)))) - -(compat--inhibit-prefixed (provide 'compat-25)) -;;; compat-25.el ends here diff --git a/elpa/compat-28.1.2.2/compat-26.el b/elpa/compat-28.1.2.2/compat-26.el deleted file mode 100644 index 98f7b2fb..00000000 --- a/elpa/compat-28.1.2.2/compat-26.el +++ /dev/null @@ -1,675 +0,0 @@ -;;; compat-26.el --- Compatibility Layer for Emacs 26.1 -*- lexical-binding: t; -*- - -;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. - -;; Author: Philip Kaludercic -;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht> -;; URL: https://git.sr.ht/~pkal/compat/ -;; Keywords: lisp - -;; 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 . - -;;; Commentary: - -;; Find here the functionality added in Emacs 26.1, needed by older -;; versions. -;; -;; Only load this library if you need to use one of the following -;; functions: -;; -;; - `compat-sort' -;; - `line-number-at-pos' -;; - `compat-alist-get' -;; - `string-trim-left' -;; - `string-trim-right' -;; - `string-trim' - -;;; Code: - -(require 'compat-macs "compat-macs.el") - -(compat-declare-version "26.1") - -;;;; Defined in eval.c - -(compat-defun func-arity (func) - "Return minimum and maximum number of args allowed for FUNC. -FUNC must be a function of some kind. -The returned value is a cons cell (MIN . MAX). MIN is the minimum number -of args. MAX is the maximum number, or the symbol `many', for a -function with `&rest' args, or `unevalled' for a special form." - :realname compat--func-arity - (cond - ((or (null func) (and (symbolp func) (not (fboundp func)))) - (signal 'void-function func)) - ((and (symbolp func) (not (null func))) - (compat--func-arity (symbol-function func))) - ((eq (car-safe func) 'macro) - (compat--func-arity (cdr func))) - ((subrp func) - (subr-arity func)) - ((memq (car-safe func) '(closure lambda)) - ;; See lambda_arity from eval.c - (when (eq (car func) 'closure) - (setq func (cdr func))) - (let ((syms-left (if (consp func) - (car func) - (signal 'invalid-function func))) - (min-args 0) (max-args 0) optional) - (catch 'many - (dolist (next syms-left) - (cond - ((not (symbolp next)) - (signal 'invalid-function func)) - ((eq next '&rest) - (throw 'many (cons min-args 'many))) - ((eq next '&optional) - (setq optional t)) - (t (unless optional - (setq min-args (1+ min-args))) - (setq max-args (1+ max-args))))) - (cons min-args max-args)))) - ((and (byte-code-function-p func) (numberp (aref func 0))) - ;; See get_byte_code_arity from bytecode.c - (let ((at (aref func 0))) - (cons (logand at 127) - (if (= (logand at 128) 0) - (ash at -8) - 'many)))) - ((and (byte-code-function-p func) (numberp (aref func 0))) - ;; See get_byte_code_arity from bytecode.c - (let ((at (aref func 0))) - (cons (logand at 127) - (if (= (logand at 128) 0) - (ash at -8) - 'many)))) - ((and (byte-code-function-p func) (listp (aref func 0))) - ;; Based on `byte-compile-make-args-desc', this is required for - ;; old versions of Emacs that don't use a integer for the argument - ;; list description, per e2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6. - (let ((arglist (aref func 0)) (mandatory 0) nonrest) - (while (and arglist (not (memq (car arglist) '(&optional &rest)))) - (setq mandatory (1+ mandatory)) - (setq arglist (cdr arglist))) - (setq nonrest mandatory) - (when (eq (car arglist) '&optional) - (setq arglist (cdr arglist)) - (while (and arglist (not (eq (car arglist) '&rest))) - (setq nonrest (1+ nonrest)) - (setq arglist (cdr arglist)))) - (cons mandatory (if arglist 'many nonrest)))) - ((autoloadp func) - (autoload-do-load func) - (compat--func-arity func)) - ((signal 'invalid-function func)))) - -;;;; Defined in fns.c - -(compat-defun assoc (key alist &optional testfn) - "Handle the optional argument TESTFN. -Equality is defined by the function TESTFN, defaulting to -`equal'. TESTFN is called with 2 arguments: a car of an alist -element and KEY. With no optional argument, the function behaves -just like `assoc'." - :prefix t - (if testfn - (catch 'found - (dolist (ent alist) - (when (funcall testfn (car ent) key) - (throw 'found ent)))) - (assoc key alist))) - -(compat-defun mapcan (func sequence) - "Apply FUNC to each element of SEQUENCE. -Concatenate the results by altering them (using `nconc'). -SEQUENCE may be a list, a vector, a boolean vector, or a string." - (apply #'nconc (mapcar func sequence))) - -;;* UNTESTED -(compat-defun line-number-at-pos (&optional position absolute) - "Handle optional argument ABSOLUTE: - -If the buffer is narrowed, the return value by default counts the lines -from the beginning of the accessible portion of the buffer. But if the -second optional argument ABSOLUTE is non-nil, the value counts the lines -from the absolute start of the buffer, disregarding the narrowing." - :prefix t - (if absolute - (save-restriction - (widen) - (line-number-at-pos position)) - (line-number-at-pos position))) - -;;;; Defined in subr.el - -(declare-function compat--alist-get-full-elisp "compat-25" - (key alist &optional default remove testfn)) -(compat-defun alist-get (key alist &optional default remove testfn) - "Handle TESTFN manually." - :realname compat--alist-get-handle-testfn - :prefix t - (if testfn - (compat--alist-get-full-elisp key alist default remove testfn) - (alist-get key alist default remove))) - -(gv-define-expander compat-alist-get - (lambda (do key alist &optional default remove testfn) - (macroexp-let2 macroexp-copyable-p k key - (gv-letplace (getter setter) alist - (macroexp-let2 nil p `(if (and ,testfn (not (eq ,testfn 'eq))) - (compat-assoc ,k ,getter ,testfn) - (assq ,k ,getter)) - (funcall do (if (null default) `(cdr ,p) - `(if ,p (cdr ,p) ,default)) - (lambda (v) - (macroexp-let2 nil v v - (let ((set-exp - `(if ,p (setcdr ,p ,v) - ,(funcall setter - `(cons (setq ,p (cons ,k ,v)) - ,getter))))) - `(progn - ,(cond - ((null remove) set-exp) - ((or (eql v default) - (and (eq (car-safe v) 'quote) - (eq (car-safe default) 'quote) - (eql (cadr v) (cadr default)))) - `(if ,p ,(funcall setter `(delq ,p ,getter)))) - (t - `(cond - ((not (eql ,default ,v)) ,set-exp) - (,p ,(funcall setter - `(delq ,p ,getter)))))) - ,v)))))))))) - -(compat-defun string-trim-left (string &optional regexp) - "Trim STRING of leading string matching REGEXP. - -REGEXP defaults to \"[ \\t\\n\\r]+\"." - :realname compat--string-trim-left - :prefix t - (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string) - (substring string (match-end 0)) - string)) - -(compat-defun string-trim-right (string &optional regexp) - "Trim STRING of trailing string matching REGEXP. - -REGEXP defaults to \"[ \\t\\n\\r]+\"." - :realname compat--string-trim-right - :prefix t - (let ((i (string-match-p - (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'") - string))) - (if i (substring string 0 i) string))) - -(compat-defun string-trim (string &optional trim-left trim-right) - "Trim STRING of leading with and trailing matching TRIM-LEFT and TRIM-RIGHT. - -TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"." - :prefix t - ;; `string-trim-left' and `string-trim-right' were moved from subr-x - ;; to subr in Emacs 27, so to avoid loading subr-x we use the - ;; compatibility function here: - (compat--string-trim-left - (compat--string-trim-right - string - trim-right) - trim-left)) - -(compat-defun caaar (x) - "Return the `car' of the `car' of the `car' of X." - (declare (pure t)) - (car (car (car x)))) - -(compat-defun caadr (x) - "Return the `car' of the `car' of the `cdr' of X." - (declare (pure t)) - (car (car (cdr x)))) - -(compat-defun cadar (x) - "Return the `car' of the `cdr' of the `car' of X." - (declare (pure t)) - (car (cdr (car x)))) - -(compat-defun caddr (x) - "Return the `car' of the `cdr' of the `cdr' of X." - (declare (pure t)) - (car (cdr (cdr x)))) - -(compat-defun cdaar (x) - "Return the `cdr' of the `car' of the `car' of X." - (declare (pure t)) - (cdr (car (car x)))) - -(compat-defun cdadr (x) - "Return the `cdr' of the `car' of the `cdr' of X." - (declare (pure t)) - (cdr (car (cdr x)))) - -(compat-defun cddar (x) - "Return the `cdr' of the `cdr' of the `car' of X." - (declare (pure t)) - (cdr (cdr (car x)))) - -(compat-defun cdddr (x) - "Return the `cdr' of the `cdr' of the `cdr' of X." - (declare (pure t)) - (cdr (cdr (cdr x)))) - -(compat-defun caaaar (x) - "Return the `car' of the `car' of the `car' of the `car' of X." - (declare (pure t)) - (car (car (car (car x))))) - -(compat-defun caaadr (x) - "Return the `car' of the `car' of the `car' of the `cdr' of X." - (declare (pure t)) - (car (car (car (cdr x))))) - -(compat-defun caadar (x) - "Return the `car' of the `car' of the `cdr' of the `car' of X." - (declare (pure t)) - (car (car (cdr (car x))))) - -(compat-defun caaddr (x) - "Return the `car' of the `car' of the `cdr' of the `cdr' of X." - (declare (pure t)) - (car (car (cdr (cdr x))))) - -(compat-defun cadaar (x) - "Return the `car' of the `cdr' of the `car' of the `car' of X." - (declare (pure t)) - (car (cdr (car (car x))))) - -(compat-defun cadadr (x) - "Return the `car' of the `cdr' of the `car' of the `cdr' of X." - (declare (pure t)) - (car (cdr (car (cdr x))))) - -(compat-defun caddar (x) - "Return the `car' of the `cdr' of the `cdr' of the `car' of X." - (declare (pure t)) - (car (cdr (cdr (car x))))) - -(compat-defun cadddr (x) - "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X." - (declare (pure t)) - (car (cdr (cdr (cdr x))))) - -(compat-defun cdaaar (x) - "Return the `cdr' of the `car' of the `car' of the `car' of X." - (declare (pure t)) - (cdr (car (car (car x))))) - -(compat-defun cdaadr (x) - "Return the `cdr' of the `car' of the `car' of the `cdr' of X." - (declare (pure t)) - (cdr (car (car (cdr x))))) - -(compat-defun cdadar (x) - "Return the `cdr' of the `car' of the `cdr' of the `car' of X." - (declare (pure t)) - (cdr (car (cdr (car x))))) - -(compat-defun cdaddr (x) - "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X." - (declare (pure t)) - (cdr (car (cdr (cdr x))))) - -(compat-defun cddaar (x) - "Return the `cdr' of the `cdr' of the `car' of the `car' of X." - (declare (pure t)) - (cdr (cdr (car (car x))))) - -(compat-defun cddadr (x) - "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X." - (declare (pure t)) - (cdr (cdr (car (cdr x))))) - -(compat-defun cdddar (x) - "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X." - (declare (pure t)) - (cdr (cdr (cdr (car x))))) - -(compat-defun cddddr (x) - "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X." - (declare (pure t)) - (cdr (cdr (cdr (cdr x))))) - -(compat-defvar gensym-counter 0 - "Number used to construct the name of the next symbol created by `gensym'.") - -(compat-defun gensym (&optional prefix) - "Return a new uninterned symbol. -The name is made by appending `gensym-counter' to PREFIX. -PREFIX is a string, and defaults to \"g\"." - (let ((num (prog1 gensym-counter - (setq gensym-counter - (1+ gensym-counter))))) - (make-symbol (format "%s%d" (or prefix "g") num)))) - -;;;; Defined in files.el - -(declare-function temporary-file-directory nil) - -;;* UNTESTED -(compat-defun make-nearby-temp-file (prefix &optional dir-flag suffix) - "Create a temporary file as close as possible to `default-directory'. -If PREFIX is a relative file name, and `default-directory' is a -remote file name or located on a mounted file systems, the -temporary file is created in the directory returned by the -function `temporary-file-directory'. Otherwise, the function -`make-temp-file' is used. PREFIX, DIR-FLAG and SUFFIX have the -same meaning as in `make-temp-file'." - (let ((handler (find-file-name-handler - default-directory 'make-nearby-temp-file))) - (if (and handler (not (file-name-absolute-p default-directory))) - (funcall handler 'make-nearby-temp-file prefix dir-flag suffix) - (let ((temporary-file-directory (temporary-file-directory))) - (make-temp-file prefix dir-flag suffix))))) - -(compat-defvar mounted-file-systems - (eval-when-compile - (if (memq system-type '(windows-nt cygwin)) - "^//[^/]+/" - (concat - "^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/"))))) - "File systems that ought to be mounted.") - -(compat-defun file-local-name (file) - "Return the local name component of FILE. -This function removes from FILE the specification of the remote host -and the method of accessing the host, leaving only the part that -identifies FILE locally on the remote system. -The returned file name can be used directly as argument of -`process-file', `start-file-process', or `shell-command'." - :realname compat--file-local-name - (or (file-remote-p file 'localname) file)) - -(compat-defun file-name-quoted-p (name &optional top) - "Whether NAME is quoted with prefix \"/:\". -If NAME is a remote file name and TOP is nil, check the local part of NAME." - :realname compat--file-name-quoted-p - (let ((file-name-handler-alist (unless top file-name-handler-alist))) - (string-prefix-p "/:" (compat--file-local-name name)))) - -(compat-defun file-name-quote (name &optional top) - "Add the quotation prefix \"/:\" to file NAME. -If NAME is a remote file name and TOP is nil, the local part of -NAME is quoted. If NAME is already a quoted file name, NAME is -returned unchanged." - (let ((file-name-handler-alist (unless top file-name-handler-alist))) - (if (compat--file-name-quoted-p name top) - name - (concat (file-remote-p name) "/:" (compat--file-local-name name))))) - -;;* UNTESTED -(compat-defun temporary-file-directory () - "The directory for writing temporary files. -In case of a remote `default-directory', this is a directory for -temporary files on that remote host. If such a directory does -not exist, or `default-directory' ought to be located on a -mounted file system (see `mounted-file-systems'), the function -returns `default-directory'. -For a non-remote and non-mounted `default-directory', the value of -the variable `temporary-file-directory' is returned." - (let ((handler (find-file-name-handler - default-directory 'temporary-file-directory))) - (if handler - (funcall handler 'temporary-file-directory) - (if (string-match mounted-file-systems default-directory) - default-directory - temporary-file-directory)))) - -;;* UNTESTED -(compat-defun file-attribute-type (attributes) - "The type field in ATTRIBUTES returned by `file-attributes'. -The value is either t for directory, string (name linked to) for -symbolic link, or nil." - (nth 0 attributes)) - -;;* UNTESTED -(compat-defun file-attribute-link-number (attributes) - "Return the number of links in ATTRIBUTES returned by `file-attributes'." - (nth 1 attributes)) - -;;* UNTESTED -(compat-defun file-attribute-user-id (attributes) - "The UID field in ATTRIBUTES returned by `file-attributes'. -This is either a string or a number. If a string value cannot be -looked up, a numeric value, either an integer or a float, is -returned." - (nth 2 attributes)) - -;;* UNTESTED -(compat-defun file-attribute-group-id (attributes) - "The GID field in ATTRIBUTES returned by `file-attributes'. -This is either a string or a number. If a string value cannot be -looked up, a numeric value, either an integer or a float, is -returned." - (nth 3 attributes)) - -;;* UNTESTED -(compat-defun file-attribute-access-time (attributes) - "The last access time in ATTRIBUTES returned by `file-attributes'. -This a Lisp timestamp in the style of `current-time'." - (nth 4 attributes)) - -;;* UNTESTED -(compat-defun file-attribute-modification-time (attributes) - "The modification time in ATTRIBUTES returned by `file-attributes'. -This is the time of the last change to the file's contents, and -is a Lisp timestamp in the style of `current-time'." - (nth 5 attributes)) - -;;* UNTESTED -(compat-defun file-attribute-status-change-time (attributes) - "The status modification time in ATTRIBUTES returned by `file-attributes'. -This is the time of last change to the file's attributes: owner -and group, access mode bits, etc., and is a Lisp timestamp in the -style of `current-time'." - (nth 6 attributes)) - -;;* UNTESTED -(compat-defun file-attribute-size (attributes) - "The integer size (in bytes) in ATTRIBUTES returned by `file-attributes'." - (nth 7 attributes)) - -;;* UNTESTED -(compat-defun file-attribute-modes (attributes) - "The file modes in ATTRIBUTES returned by `file-attributes'. -This is a string of ten letters or dashes as in ls -l." - (nth 8 attributes)) - -;;* UNTESTED -(compat-defun file-attribute-inode-number (attributes) - "The inode number in ATTRIBUTES returned by `file-attributes'. -It is a nonnegative integer." - (nth 10 attributes)) - -;;* UNTESTED -(compat-defun file-attribute-device-number (attributes) - "The file system device number in ATTRIBUTES returned by `file-attributes'. -It is an integer." - (nth 11 attributes)) - -(compat-defun file-attribute-collect (attributes &rest attr-names) - "Return a sublist of ATTRIBUTES returned by `file-attributes'. -ATTR-NAMES are symbols with the selected attribute names. - -Valid attribute names are: type, link-number, user-id, group-id, -access-time, modification-time, status-change-time, size, modes, -inode-number and device-number." - (let ((idx '((type . 0) - (link-number . 1) - (user-id . 2) - (group-id . 3) - (access-time . 4) - (modification-time . 5) - (status-change-time . 6) - (size . 7) - (modes . 8) - (inode-number . 10) - (device-number . 11))) - result) - (while attr-names - (let ((attr (pop attr-names))) - (if (assq attr idx) - (push (nth (cdr (assq attr idx)) - attributes) - result) - (error "Wrong attribute name '%S'" attr)))) - (nreverse result))) - -;;;; Defined in subr-x.el - -(compat-defmacro if-let* (varlist then &rest else) - "Bind variables according to VARLIST and evaluate THEN or ELSE. -This is like `if-let' but doesn't handle a VARLIST of the form -\(SYMBOL SOMETHING) specially." - :realname compat--if-let* - :feature 'subr-x - (declare (indent 2) - (debug ((&rest [&or symbolp (symbolp form) (form)]) - body))) - (let ((empty (make-symbol "s")) - (last t) list) - (dolist (var varlist) - (push `(,(if (cdr var) (car var) empty) - (and ,last ,(or (cadr var) (car var)))) - list) - (when (or (cdr var) (consp (car var))) - (setq last (caar list)))) - `(let* ,(nreverse list) - (if ,(caar list) ,then ,@else)))) - -(compat-defmacro when-let* (varlist &rest body) - "Bind variables according to VARLIST and conditionally evaluate BODY. -This is like `when-let' but doesn't handle a VARLIST of the form -\(SYMBOL SOMETHING) specially." - ;; :feature 'subr-x - (declare (indent 1) (debug if-let*)) - (let ((empty (make-symbol "s")) - (last t) list) - (dolist (var varlist) - (push `(,(if (cdr var) (car var) empty) - (and ,last ,(or (cadr var) (car var)))) - list) - (when (or (cdr var) (consp (car var))) - (setq last (caar list)))) - `(let* ,(nreverse list) - (when ,(caar list) ,@body)))) - -(compat-defmacro and-let* (varlist &rest body) - "Bind variables according to VARLIST and conditionally evaluate BODY. -Like `when-let*', except if BODY is empty and all the bindings -are non-nil, then the result is non-nil." - :feature 'subr-x - (declare (indent 1) (debug if-let*)) - (let ((empty (make-symbol "s")) - (last t) list) - (dolist (var varlist) - (push `(,(if (cdr var) (car var) empty) - (and ,last ,(or (cadr var) (car var)))) - list) - (when (or (cdr var) (consp (car var))) - (setq last (caar list)))) - `(let* ,(nreverse list) - (if ,(caar list) ,(macroexp-progn (or body '(t))))))) - -;;;; Defined in image.el - -;;* UNTESTED -(compat-defun image-property (image property) - "Return the value of PROPERTY in IMAGE. -Properties can be set with - - (setf (image-property IMAGE PROPERTY) VALUE) - -If VALUE is nil, PROPERTY is removed from IMAGE." - (plist-get (cdr image) property)) - -;;* UNTESTED -(unless (get 'image-property 'gv-expander) - (gv-define-setter image-property (image property value) - (let ((image* (make-symbol "image")) - (property* (make-symbol "property")) - (value* (make-symbol "value"))) - `(let ((,image* ,image) - (,property* ,property) - (,value* ,value)) - (if - (null ,value*) - (while - (cdr ,image*) - (if - (eq - (cadr ,image*) - ,property*) - (setcdr ,image* - (cdddr ,image*)) - (setq ,image* - (cddr ,image*)))) - (setcdr ,image* - (plist-put - (cdr ,image*) - ,property* ,value*))))))) - -;;;; Defined in rmc.el - -;;*UNTESTED -(compat-defun read-multiple-choice - (prompt choices &optional _help-string _show-help long-form) - "Ask user to select an entry from CHOICES, promting with PROMPT. -This function allows to ask the user a multiple-choice question. - -CHOICES should be a list of the form (KEY NAME [DESCRIPTION]). -KEY is a character the user should type to select the entry. -NAME is a short name for the entry to be displayed while prompting -\(if there's no room, it might be shortened). - -If LONG-FORM, do a `completing-read' over the NAME elements in -CHOICES instead." - :note "This is a partial implementation of `read-multiple-choice', that -among other things doesn't offer any help and ignores the -optional DESCRIPTION field." - (if long-form - (let ((options (mapconcat #'cadr choices "/")) - choice) - (setq prompt (concat prompt " (" options "): ")) - (setq choice (completing-read prompt (mapcar #'cadr choices) nil t)) - (catch 'found - (dolist (option choices) - (when (string= choice (cadr option)) - (throw 'found option))) - (error "Invalid choice"))) - (let ((options - (mapconcat - (lambda (opt) - (format - "[%s] %s" - (key-description (string (car opt))) - (cadr opt))) - choices " ")) - choice) - (setq prompt (concat prompt " (" options "): ")) - (while (not (setq choice (assq (read-char prompt) choices))) - (message "Invalid choice") - (sit-for 1)) - choice))) - -(compat--inhibit-prefixed (provide 'compat-26)) -;;; compat-26.el ends here diff --git a/elpa/compat-28.1.2.2/compat-27.el b/elpa/compat-28.1.2.2/compat-27.el deleted file mode 100644 index a96b1e96..00000000 --- a/elpa/compat-28.1.2.2/compat-27.el +++ /dev/null @@ -1,764 +0,0 @@ -;;; compat-27.el --- Compatibility Layer for Emacs 27.1 -*- lexical-binding: t; -*- - -;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. - -;; Author: Philip Kaludercic -;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht> -;; URL: https://git.sr.ht/~pkal/compat/ -;; Keywords: lisp - -;; 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 . - -;;; Commentary: - -;; Find here the functionality added in Emacs 27.1, needed by older -;; versions. -;; -;; Only load this library if you need to use one of the following -;; functions or macros: -;; -;; - `compat-recenter' -;; - `compat-lookup-key' -;; - `compat-setq-local' -;; - `compat-assoc-delete-all' -;; - `compat-file-size-human-readable' -;; - `compat-executable-find' -;; - `compat-regexp-opt' -;; - `compat-dired-get-marked-files' - -;;; Code: - -(require 'compat-macs "compat-macs.el") - -(compat-declare-version "27.1") - -;;;; Defined in fns.c - -(compat-defun proper-list-p (object) - "Return OBJECT's length if it is a proper list, nil otherwise. -A proper list is neither circular nor dotted (i.e., its last cdr -is nil)." - :min-version "26.1" - :max-version "26.3" - :realname compat--proper-list-p-length-signal - (condition-case nil - (and (listp object) (length object)) - (wrong-type-argument nil) - (circular-list nil))) - -(compat-defun proper-list-p (object) - "Return OBJECT's length if it is a proper list, nil otherwise. -A proper list is neither circular nor dotted (i.e., its last cdr -is nil)." - :max-version "25.3" - :realname compat--proper-list-p-tortoise-hare - (when (listp object) - (catch 'cycle - (let ((hare object) (tortoise object) - (max 2) (q 2)) - (while (consp hare) - (setq hare (cdr hare)) - (when (and (or (/= 0 (setq q (1- q))) - (ignore - (setq max (ash max 1) - q max - tortoise hare))) - (eq hare tortoise)) - (throw 'cycle nil))) - (and (null hare) (length object)))))) - -(compat-defun string-distance (string1 string2 &optional bytecompare) - "Return Levenshtein distance between STRING1 and STRING2. -The distance is the number of deletions, insertions, and substitutions -required to transform STRING1 into STRING2. -If BYTECOMPARE is nil or omitted, compute distance in terms of characters. -If BYTECOMPARE is non-nil, compute distance in terms of bytes. -Letter-case is significant, but text properties are ignored." - ;; https://en.wikipedia.org/wiki/Levenshtein_distance - (let ((s1 (if bytecompare - (encode-coding-string string1 'raw-text) - (concat string1 ""))) - (s2 (if bytecompare - (encode-coding-string string2 'raw-text) - string2))) - (let* ((len1 (length s1)) - (len2 (length s2)) - (column (make-vector (1+ len1) 0))) - (dotimes (y len1) - (setf (aref column (1+ y)) y)) - (dotimes (x len2) - (setf (aref column 0) (1+ x)) - (let ((lastdiag x) olddiag) - (dotimes (y len1) - (setf olddiag (aref column (1+ y)) - (aref column (1+ y)) - (min (+ (if (= (aref s1 y) (aref s2 x)) 0 1) - lastdiag) - (1+ (aref column (1+ y))) - (1+ (aref column y))) - lastdiag olddiag)))) - (aref column len1)))) - -;;;; Defined in window.c - -(compat-defun recenter (&optional arg redisplay) - "Handle optional argument REDISPLAY." - :prefix t - (recenter arg) - (when (and redisplay recenter-redisplay) - (redisplay))) - -;;;; Defined in keymap.c - -(compat-defun lookup-key (keymap key &optional accept-default) - "Allow for KEYMAP to be a list of keymaps." - :prefix t - (cond - ((keymapp keymap) - (lookup-key keymap key accept-default)) - ((listp keymap) - (catch 'found - (dolist (map keymap) - (let ((fn (lookup-key map key accept-default))) - (when fn (throw 'found fn)))))) - ((signal 'wrong-type-argument (list 'keymapp keymap))))) - -;;;; Defined in json.c - -(declare-function json-parse-string nil (string &rest args)) -(declare-function json-encode "json" (object)) -(declare-function json-read-from-string "json" (string)) -(declare-function json-read "json" ()) -(defvar json-encoding-pretty-print) -(defvar json-object-type) -(defvar json-array-type) -(defvar json-false) -(defvar json-null) - -;; The function is declared to satisfy the byte compiler while testing -;; if native JSON parsing is available.; -(declare-function json-serialize nil (object &rest args)) -(compat-defun json-serialize (object &rest args) - "Return the JSON representation of OBJECT as a string. - -OBJECT must be t, a number, string, vector, hashtable, alist, plist, -or the Lisp equivalents to the JSON null and false values, and its -elements must recursively consist of the same kinds of values. t will -be converted to the JSON true value. Vectors will be converted to -JSON arrays, whereas hashtables, alists and plists are converted to -JSON objects. Hashtable keys must be strings without embedded null -characters and must be unique within each object. Alist and plist -keys must be symbols; if a key is duplicate, the first instance is -used. - -The Lisp equivalents to the JSON null and false values are -configurable in the arguments ARGS, a list of keyword/argument pairs: - -The keyword argument `:null-object' specifies which object to use -to represent a JSON null value. It defaults to `:null'. - -The keyword argument `:false-object' specifies which object to use to -represent a JSON false value. It defaults to `:false'. - -In you specify the same value for `:null-object' and `:false-object', -a potentially ambiguous situation, the JSON output will not contain -any JSON false values." - :cond (not (condition-case nil - (equal (json-serialize '()) "{}") - (:success t) - (void-function nil) - (json-unavailable nil))) - :realname compat--json-serialize - (require 'json) - (letrec ((fix (lambda (obj) - (cond - ((hash-table-p obj) - (let ((ht (copy-hash-table obj))) - (maphash - (lambda (key val) - (unless (stringp key) - (signal - 'wrong-type-argument - (list 'stringp key))) - (puthash key (funcall fix val) ht)) - obj) - ht)) - ((and (listp obj) (consp (car obj))) ;alist - (mapcar - (lambda (ent) - (cons (symbol-name (car ent)) - (funcall fix (cdr ent)))) - obj)) - ((listp obj) ;plist - (let (alist) - (while obj - (push (cons (cond - ((keywordp (car obj)) - (substring - (symbol-name (car obj)) - 1)) - ((symbolp (car obj)) - (symbol-name (car obj))) - ((signal - 'wrong-type-argument - (list 'symbolp (car obj))))) - (funcall fix (cadr obj))) - alist) - (unless (consp (cdr obj)) - (signal 'wrong-type-argument '(consp nil))) - (setq obj (cddr obj))) - (nreverse alist))) - ((vectorp obj) - (let ((vec (make-vector (length obj) nil))) - (dotimes (i (length obj)) - (aset vec i (funcall fix (aref obj i)))) - vec)) - (obj)))) - (json-encoding-pretty-print nil) - (json-false (or (plist-get args :false-object) :false)) - (json-null (or (plist-get args :null-object) :null))) - (json-encode (funcall fix object)))) - -(compat-defun json-insert (object &rest args) - "Insert the JSON representation of OBJECT before point. -This is the same as (insert (json-serialize OBJECT)), but potentially -faster. See the function `json-serialize' for allowed values of -OBJECT." - :cond (not (condition-case nil - (equal (json-serialize '()) "{}") - (:success t) - (void-function nil) - (json-unavailable nil))) - (insert (apply #'compat--json-serialize object args))) - -(compat-defun json-parse-string (string &rest args) - "Parse the JSON STRING into a Lisp object. -This is essentially the reverse operation of `json-serialize', which -see. The returned object will be the JSON null value, the JSON false -value, t, a number, a string, a vector, a list, a hashtable, an alist, -or a plist. Its elements will be further objects of these types. If -there are duplicate keys in an object, all but the last one are -ignored. If STRING doesn't contain a valid JSON object, this function -signals an error of type `json-parse-error'. - -The arguments ARGS are a list of keyword/argument pairs: - -The keyword argument `:object-type' specifies which Lisp type is used -to represent objects; it can be `hash-table', `alist' or `plist'. It -defaults to `hash-table'. - -The keyword argument `:array-type' specifies which Lisp type is used -to represent arrays; it can be `array' (the default) or `list'. - -The keyword argument `:null-object' specifies which object to use -to represent a JSON null value. It defaults to `:null'. - -The keyword argument `:false-object' specifies which object to use to -represent a JSON false value. It defaults to `:false'." - :cond (not (condition-case nil - (equal (json-serialize '()) "{}") - (:success t) - (void-function nil) - (json-unavailable nil))) - (require 'json) - (condition-case err - (let ((json-object-type (or (plist-get args :object-type) 'hash-table)) - (json-array-type (or (plist-get args :array-type) 'vector)) - (json-false (or (plist-get args :false-object) :false)) - (json-null (or (plist-get args :null-object) :null))) - (when (eq json-array-type 'array) - (setq json-array-type 'vector)) - (json-read-from-string string)) - (json-error (signal 'json-parse-error err)))) - -(compat-defun json-parse-buffer (&rest args) - "Read JSON object from current buffer starting at point. -Move point after the end of the object if parsing was successful. -On error, don't move point. - -The returned object will be a vector, list, hashtable, alist, or -plist. Its elements will be the JSON null value, the JSON false -value, t, numbers, strings, or further vectors, lists, hashtables, -alists, or plists. If there are duplicate keys in an object, all -but the last one are ignored. - -If the current buffer doesn't contain a valid JSON object, the -function signals an error of type `json-parse-error'. - -The arguments ARGS are a list of keyword/argument pairs: - -The keyword argument `:object-type' specifies which Lisp type is used -to represent objects; it can be `hash-table', `alist' or `plist'. It -defaults to `hash-table'. - -The keyword argument `:array-type' specifies which Lisp type is used -to represent arrays; it can be `array' (the default) or `list'. - -The keyword argument `:null-object' specifies which object to use -to represent a JSON null value. It defaults to `:null'. - -The keyword argument `:false-object' specifies which object to use to -represent a JSON false value. It defaults to `:false'." - :cond (not (condition-case nil - (equal (json-serialize '()) "{}") - (:success t) - (void-function nil) - (json-unavailable nil))) - (require 'json) - (condition-case err - (let ((json-object-type (or (plist-get args :object-type) 'hash-table)) - (json-array-type (or (plist-get args :array-type) 'vector)) - (json-false (or (plist-get args :false-object) :false)) - (json-null (or (plist-get args :null-object) :null))) - (when (eq json-array-type 'array) - (setq json-array-type 'vector)) - (json-read)) - (json-error (signal 'json-parse-buffer err)))) - -;;;; Defined in timefns.c - -(compat-defun time-equal-p (t1 t2) - "Return non-nil if time value T1 is equal to time value T2. -A nil value for either argument stands for the current time." - :note "This function is not as accurate as the actual `time-equal-p'." - (cond - ((eq t1 t2)) - ((and (consp t1) (consp t2)) - (equal t1 t2)) - ((let ((now (current-time))) - ;; Due to inaccuracies and the relatively slow evaluating of - ;; Emacs Lisp compared to C, we allow for slight inaccuracies - ;; (less than a millisecond) when comparing time values. - (< (abs (- (float-time (or t1 now)) - (float-time (or t2 now)))) - 1e-5))))) - -;;;; Defined in fileio.c - -(compat-defun file-name-absolute-p (filename) - "Return t if FILENAME is an absolute file name. -On Unix, absolute file names start with `/'. In Emacs, an absolute -file name can also start with an initial `~' or `~USER' component, -where USER is a valid login name." - ;; See definitions in filename.h - (let ((seperator - (eval-when-compile - (if (memq system-type '(cygwin windows-nt ms-dos)) - "[\\/]" "/"))) - (drive - (eval-when-compile - (cond - ((memq system-type '(windows-nt ms-dos)) - "\\`[A-Za-z]:[\\/]") - ((eq system-type 'cygwin) - "\\`\\([\\/]\\|[A-Za-z]:\\)") - ("\\`/")))) - (home - (eval-when-compile - (if (memq system-type '(cygwin windows-nt ms-dos)) - "\\`~[\\/]" "\\`~/"))) - (user-home - (eval-when-compile - (format "\\`\\(~.*?\\)\\(%s.*\\)?$" - (if (memq system-type '(cygwin windows-nt ms-dos)) - "[\\/]" "/"))))) - (or (and (string-match-p drive filename) t) - (and (string-match-p home filename) t) - (save-excursion - (when (string-match user-home filename) - (let ((init (match-string 1 filename))) - (not (string= - (file-name-base (expand-file-name init)) - init)))))))) - -;;;; Defined in subr.el - -(compat-defmacro setq-local (&rest pairs) - "Handle multiple assignments." - :prefix t - (unless (zerop (mod (length pairs) 2)) - (error "PAIRS must have an even number of variable/value members")) - (let (body) - (while pairs - (let* ((sym (pop pairs)) - (val (pop pairs))) - (unless (symbolp sym) - (error "Attempting to set a non-symbol: %s" (car pairs))) - (push `(set (make-local-variable ,sym) ,val) - body))) - (cons 'progn (nreverse body)))) - -(compat-defun provided-mode-derived-p (mode &rest modes) - "Non-nil if MODE is derived from one of MODES. -Uses the `derived-mode-parent' property of the symbol to trace backwards. -If you just want to check `major-mode', use `derived-mode-p'." - :realname compat--provided-mode-derived-p - ;; If MODE is an alias, then look up the real mode function first. - (let ((alias (symbol-function mode))) - (when (and alias (symbolp alias)) - (setq mode alias))) - (while - (and - (not (memq mode modes)) - (let* ((parent (get mode 'derived-mode-parent)) - (parentfn (symbol-function parent))) - (setq mode (if (and parentfn (symbolp parentfn)) parentfn parent))))) - mode) - -;;* UNTESTED -(defun derived-mode-p (&rest modes) - "Non-nil if the current major mode is derived from one of MODES. -Uses the `derived-mode-parent' property of the symbol to trace backwards." - (apply #'compat--provided-mode-derived-p major-mode modes)) - -;;* UNTESTED -(compat-defmacro ignore-error (condition &rest body) - "Execute BODY; if the error CONDITION occurs, return nil. -Otherwise, return result of last form in BODY. - -CONDITION can also be a list of error conditions." - (declare (debug t) (indent 1)) - `(condition-case nil (progn ,@body) (,condition nil))) - -;;* UNTESTED -(compat-defmacro dolist-with-progress-reporter (spec reporter-or-message &rest body) - "Loop over a list and report progress in the echo area. -Evaluate BODY with VAR bound to each car from LIST, in turn. -Then evaluate RESULT to get return value, default nil. - -REPORTER-OR-MESSAGE is a progress reporter object or a string. In the latter -case, use this string to create a progress reporter. - -At each iteration, print the reporter message followed by progress -percentage in the echo area. After the loop is finished, -print the reporter message followed by the word \"done\". - -\(fn (VAR LIST [RESULT]) REPORTER-OR-MESSAGE BODY...)" - (declare (indent 2) (debug ((symbolp form &optional form) form body))) - (let ((prep (make-symbol "--dolist-progress-reporter--")) - (count (make-symbol "--dolist-count--")) - (list (make-symbol "--dolist-list--"))) - `(let ((,prep ,reporter-or-message) - (,count 0) - (,list ,(cadr spec))) - (when (stringp ,prep) - (setq ,prep (make-progress-reporter ,prep 0 (1- (length ,list))))) - (dolist (,(car spec) ,list) - ,@body - (progress-reporter-update ,prep (setq ,count (1+ ,count)))) - (progress-reporter-done ,prep) - (or ,@(cdr (cdr spec)) nil)))) - -(compat-defun flatten-tree (tree) - "Return a \"flattened\" copy of TREE. -In other words, return a list of the non-nil terminal nodes, or -leaves, of the tree of cons cells rooted at TREE. Leaves in the -returned list are in the same order as in TREE. - -\(flatten-tree \\='(1 (2 . 3) nil (4 5 (6)) 7)) -=> (1 2 3 4 5 6 7)" - (let (elems) - (while (consp tree) - (let ((elem (pop tree))) - (while (consp elem) - (push (cdr elem) tree) - (setq elem (car elem))) - (if elem (push elem elems)))) - (if tree (push tree elems)) - (nreverse elems))) - -(compat-defun xor (cond1 cond2) - "Return the boolean exclusive-or of COND1 and COND2. -If only one of the arguments is non-nil, return it; otherwise -return nil." - (declare (pure t) (side-effect-free error-free)) - (cond ((not cond1) cond2) - ((not cond2) cond1))) - -(compat-defvar regexp-unmatchable "\\`a\\`" - "Standard regexp guaranteed not to match any string at all." - :constant t) - -(compat-defun assoc-delete-all (key alist &optional test) - "Delete from ALIST all elements whose car is KEY. -Compare keys with TEST. Defaults to `equal'. -Return the modified alist. -Elements of ALIST that are not conses are ignored." - :prefix t - (unless test (setq test #'equal)) - (while (and (consp (car alist)) - (funcall test (caar alist) key)) - (setq alist (cdr alist))) - (let ((tail alist) tail-cdr) - (while (setq tail-cdr (cdr tail)) - (if (and (consp (car tail-cdr)) - (funcall test (caar tail-cdr) key)) - (setcdr tail (cdr tail-cdr)) - (setq tail tail-cdr)))) - alist) - -;;;; Defined in simple.el - -;;* UNTESTED -(compat-defun decoded-time-second (time) - "The seconds in TIME, which is a value returned by `decode-time'. -This is an integer between 0 and 60 (inclusive). (60 is a leap -second, which only some operating systems support.)" - (nth 0 time)) - -;;* UNTESTED -(compat-defun decoded-time-minute (time) - "The minutes in TIME, which is a value returned by `decode-time'. -This is an integer between 0 and 59 (inclusive)." - (nth 1 time)) - -;;* UNTESTED -(compat-defun decoded-time-hour (time) - "The hours in TIME, which is a value returned by `decode-time'. -This is an integer between 0 and 23 (inclusive)." - (nth 2 time)) - -;;* UNTESTED -(compat-defun decoded-time-day (time) - "The day-of-the-month in TIME, which is a value returned by `decode-time'. -This is an integer between 1 and 31 (inclusive)." - (nth 3 time)) - -;;* UNTESTED -(compat-defun decoded-time-month (time) - "The month in TIME, which is a value returned by `decode-time'. -This is an integer between 1 and 12 (inclusive). January is 1." - (nth 4 time)) - -;;* UNTESTED -(compat-defun decoded-time-year (time) - "The year in TIME, which is a value returned by `decode-time'. -This is a four digit integer." - (nth 5 time)) - -;;* UNTESTED -(compat-defun decoded-time-weekday (time) - "The day-of-the-week in TIME, which is a value returned by `decode-time'. -This is a number between 0 and 6, and 0 is Sunday." - (nth 6 time)) - -;;* UNTESTED -(compat-defun decoded-time-dst (time) - "The daylight saving time in TIME, which is a value returned by `decode-time'. -This is t if daylight saving time is in effect, and nil if not." - (nth 7 time)) - -;;* UNTESTED -(compat-defun decoded-time-zone (time) - "The time zone in TIME, which is a value returned by `decode-time'. -This is an integer indicating the UTC offset in seconds, i.e., -the number of seconds east of Greenwich." - (nth 8 time)) - -;; TODO define gv-setters - -;;;; Defined in files.el - -(compat-defun file-size-human-readable (file-size &optional flavor space unit) - "Handle the optional third and forth argument: - -Optional third argument SPACE is a string put between the number and unit. -It defaults to the empty string. We recommend a single space or -non-breaking space, unless other constraints prohibit a space in that -position. - -Optional fourth argument UNIT is the unit to use. It defaults to \"B\" -when FLAVOR is `iec' and the empty string otherwise. We recommend \"B\" -in all cases, since that is the standard symbol for byte." - :prefix t - (let ((power (if (or (null flavor) (eq flavor 'iec)) - 1024.0 - 1000.0)) - (prefixes '("" "k" "M" "G" "T" "P" "E" "Z" "Y"))) - (while (and (>= file-size power) (cdr prefixes)) - (setq file-size (/ file-size power) - prefixes (cdr prefixes))) - (let* ((prefix (car prefixes)) - (prefixed-unit (if (eq flavor 'iec) - (concat - (if (string= prefix "k") "K" prefix) - (if (string= prefix "") "" "i") - (or unit "B")) - (concat prefix unit)))) - (format (if (and (>= (mod file-size 1.0) 0.05) - (< (mod file-size 1.0) 0.95)) - "%.1f%s%s" - "%.0f%s%s") - file-size - (if (string= prefixed-unit "") "" (or space "")) - prefixed-unit)))) - -(declare-function compat--file-name-quote "compat-26" - (name &optional top)) - -;;*UNTESTED -(compat-defun exec-path () - "Return list of directories to search programs to run in remote subprocesses. -The remote host is identified by `default-directory'. For remote -hosts that do not support subprocesses, this returns nil. -If `default-directory' is a local directory, this function returns -the value of the variable `exec-path'." - :realname compat--exec-path - (cond - ((let ((handler (find-file-name-handler default-directory 'exec-path))) - ;; FIXME: The handler was added in 27.1, and this compatibility - ;; function only applies to versions of Emacs before that. - (when handler - (condition-case nil - (funcall handler 'exec-path) - (error nil))))) - ((file-remote-p default-directory) - ;; TODO: This is not completely portable, even if "sh" and - ;; "getconf" should be provided on every POSIX system, the chance - ;; of this not working are greater than zero. - ;; - ;; FIXME: This invokes a shell process every time exec-path is - ;; called. It should instead be cached on a host-local basis. - (with-temp-buffer - (if (condition-case nil - (zerop (process-file "sh" nil t nil "-c" "getconf PATH")) - (file-missing t)) - (list "/bin" "/usr/bin") - (let (path) - (while (re-search-forward "\\([^:]+?\\)[\n:]" nil t) - (push (match-string 1) path)) - (nreverse path))))) - (exec-path))) - -(declare-function compat--file-local-name "compat-26" - (file)) - -;;*UNTESTED -(compat-defun executable-find (command &optional remote) - "Search for COMMAND in `exec-path' and return the absolute file name. -Return nil if COMMAND is not found anywhere in `exec-path'. If -REMOTE is non-nil, search on the remote host indicated by -`default-directory' instead." - :prefix t - (if (and remote (file-remote-p default-directory)) - (let ((res (locate-file - command - (mapcar - (apply-partially - #'concat (file-remote-p default-directory)) - (compat--exec-path)) - exec-suffixes 'file-executable-p))) - (when (stringp res) (compat--file-local-name res))) - (executable-find command))) - -;; TODO provide advice for directory-files-recursively - -;;;; Defined in format-spec.el - -;; TODO provide advice for format-spec - -;;;; Defined in regexp-opt.el - -(compat-defun regexp-opt (strings &optional paren) - "Handle an empty list of strings." - :prefix t - (if (null strings) - (let ((re "\\`a\\`")) - (cond ((null paren) - (concat "\\(?:" re "\\)")) - ((stringp paren) - (concat paren re "\\)")) - ((eq paren 'words) - (concat "\\<\\(" re "\\)\\>")) - ((eq paren 'symbols) - (concat "\\_\\(<" re "\\)\\_>")) - ((concat "\\(" re "\\)")))) - (regexp-opt strings paren))) - -;;;; Defined in package.el - -(declare-function lm-header "lisp-mnt") - -;;* UNTESTED -(compat-defun package-get-version () - "Return the version number of the package in which this is used. -Assumes it is used from an Elisp file placed inside the top-level directory -of an installed ELPA package. -The return value is a string (or nil in case we can’t find it)." - ;; In a sense, this is a lie, but it does just what we want: precompute - ;; the version at compile time and hardcodes it into the .elc file! - (declare (pure t)) - ;; Hack alert! - (let ((file - (or (and (boundp 'byte-compile-current-file) byte-compile-current-file) - load-file-name - buffer-file-name))) - (cond - ((null file) nil) - ;; Packages are normally installed into directories named "-", - ;; so get the version number from there. - ((string-match - "/[^/]+-\\([0-9]\\(?:[0-9.]\\|pre\\|beta\\|alpha\\|snapshot\\)+\\)/[^/]+\\'" - file) - (match-string 1 file)) - ;; For packages run straight from the an elpa.git clone, there's no - ;; "-" in the directory name, so we have to fetch the version - ;; the hard way. - ((let* ((pkgdir (file-name-directory file)) - (pkgname (file-name-nondirectory (directory-file-name pkgdir))) - (mainfile (expand-file-name (concat pkgname ".el") pkgdir))) - (when (file-readable-p mainfile) - (require 'lisp-mnt) - (with-temp-buffer - (insert-file-contents mainfile) - (or (lm-header "package-version") - (lm-header "version"))))))))) - - -;;;; Defined in dired.el - -(declare-function - dired-get-marked-files "dired.el" - (&optional localp arg filter distinguish-one-marked error)) - -;;* UNTESTED -(compat-defun dired-get-marked-files - (&optional localp arg filter distinguish-one-marked error) - "Return the marked files’ names as list of strings." - :feature 'dired - :prefix t - (let ((result (dired-get-marked-files localp arg filter distinguish-one-marked))) - (if (and (null result) error) - (user-error (if (stringp error) error "No files specified")) - result))) - -;;;; Defined in time-date.el - -(compat-defun date-days-in-month (year month) - "The number of days in MONTH in YEAR." - :feature 'time-date - (unless (and (numberp month) - (<= 1 month) - (<= month 12)) - (error "Month %s is invalid" month)) - (if (= month 2) - (if (date-leap-year-p year) - 29 - 28) - (if (memq month '(1 3 5 7 8 10 12)) - 31 - 30))) - -(compat--inhibit-prefixed (provide 'compat-27)) -;;; compat-27.el ends here diff --git a/elpa/compat-28.1.2.2/compat-font-lock.el b/elpa/compat-28.1.2.2/compat-font-lock.el deleted file mode 100644 index 66a62e55..00000000 --- a/elpa/compat-28.1.2.2/compat-font-lock.el +++ /dev/null @@ -1,48 +0,0 @@ -;;; compat-font-lock.el --- -*- lexical-binding: t; -*- - -;; Copyright (C) 2022 Free Software Foundation, Inc. - -;; Author: Philip Kaludercic -;; 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 . - -;;; Commentary: - -;; Optional font-locking for `compat' definitions. Every symbol with -;; an active compatibility definition will be highlighted. -;; -;; Load this file to enable the functionality. - -;;; Code: - -(eval-and-compile - (require 'cl-lib) - (require 'compat-macs)) - -(defvar compat-generate-common-fn) -(let ((compat-generate-common-fn - (lambda (name _def-fn _install-fn check-fn attr _type) - (unless (and (plist-get attr :no-highlight) - (funcall check-fn)) - `(font-lock-add-keywords - 'emacs-lisp-mode - ',`((,(concat "\\_<\\(" - (regexp-quote (symbol-name name)) - "\\)\\_>") - 1 font-lock-preprocessor-face prepend))))))) - (load "compat")) - -(provide 'compat-font-lock) -;;; compat-font-lock.el ends here diff --git a/elpa/compat-28.1.2.2/compat-help.el b/elpa/compat-28.1.2.2/compat-help.el deleted file mode 100644 index 440e35f2..00000000 --- a/elpa/compat-28.1.2.2/compat-help.el +++ /dev/null @@ -1,57 +0,0 @@ -;;; compat-help.el --- Documentation for compat functions -*- lexical-binding: t; -*- - -;; Copyright (C) 2022 Free Software Foundation, Inc. - -;; Author: Philip Kaludercic - -;; 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 . - -;;; Commentary: - -;; Load this file to insert `compat'-relevant documentation next to -;; the regular documentation of a symbol. - -;;; Code: - -(defun compat---describe (symbol) - "Insert documentation for SYMBOL if it has compatibility code." - (let ((compat (get symbol 'compat-def))) - (when compat - (let ((doc (get compat 'compat-doc)) - (start (point))) - (when doc - (insert "There is a ") - (insert-button - "compatibility notice" - 'action (let ((type (get compat 'compat-type))) - (cond - ((memq type '(func macro advice)) - #'find-function) - ((memq type '(variable)) - #'find-variable) - ((error "Unknown type")))) - 'button-data compat) - (insert (format " for %s (for versions of Emacs before %s):" - (symbol-name symbol) - (get compat 'compat-version))) - (add-text-properties start (point) '(face bold)) - (newline 2) - (insert (substitute-command-keys doc)) - (fill-region start (point)) - (newline 2)))))) - -(add-hook 'help-fns-describe-function-functions #'compat---describe) - -(provide 'compat-help) -;;; compat-help.el ends here diff --git a/elpa/compat-28.1.2.2/compat-macs.el b/elpa/compat-28.1.2.2/compat-macs.el deleted file mode 100644 index c6417c83..00000000 --- a/elpa/compat-28.1.2.2/compat-macs.el +++ /dev/null @@ -1,316 +0,0 @@ -;;; compat-macs.el --- Compatibility Macros -*- lexical-binding: t; no-byte-compile: t; -*- - -;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. - -;; Author: Philip Kaludercic -;; Keywords: lisp - -;; 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 . - -;;; Commentary: - -;; These macros are used to define compatibility functions, macros and -;; advice. - -;;; Code: - -(defmacro compat--ignore (&rest _) - "Ignore all arguments." - nil) - -(defvar compat--inhibit-prefixed nil - "Non-nil means that prefixed definitions are not loaded. -A prefixed function is something like `compat-assoc', that is -only made visible when the respective compatibility version file -is loaded (in this case `compat-26').") - -(defmacro compat--inhibit-prefixed (&rest body) - "Ignore BODY unless `compat--inhibit-prefixed' is true." - `(unless (bound-and-true-p compat--inhibit-prefixed) - ,@body)) - -(defvar compat-current-version nil - "Default version to use when no explicit version was given.") - -(defmacro compat-declare-version (version) - "Set the Emacs version that is currently being handled to VERSION." - ;; FIXME: Avoid setting the version for any definition that might - ;; follow, but try to restrict it to the current file/buffer. - (setq compat-current-version version) - nil) - -(defvar compat--generate-function #'compat--generate-default - "Function used to generate compatibility code. -The function must take six arguments: NAME, DEF-FN, INSTALL-FN, -CHECK-FN, ATTR and TYPE. The resulting body is constructed by -invoking the functions DEF-FN (passed the \"realname\" and the -version number, returning the compatibility definition), the -INSTALL-FN (passed the \"realname\" and returning the -installation code), CHECK-FN (passed the \"realname\" and -returning a check to see if the compatibility definition should -be installed). ATTR is a plist used to modify the generated -code. The following attributes are handled, all others are -ignored: - -- :min-version :: Prevent the compatibility definition from begin - installed in versions older than indicated (string). - -- :max-version :: Prevent the compatibility definition from begin - installed in versions newer than indicated (string). - -- :feature :: The library the code is supposed to be loaded - with (via `eval-after-load'). - -- :cond :: Only install the compatibility code, iff the value - evaluates to non-nil. - - For prefixed functions, this can be interpreted as a test to - `defalias' an existing definition or not. - -- :no-highlight :: Do not highlight this definition as - compatibility function. - -- :version :: Manual specification of the version the compatee - code was defined in (string). - -- :realname :: Manual specification of a \"realname\" to use for - the compatibility definition (symbol). - -- :notes :: Additional notes that a developer using this - compatibility function should keep in mind. - -- :prefix :: Add a `compat-' prefix to the name, and define the - compatibility code unconditionally. - -TYPE is used to set the symbol property `compat-type' for NAME.") - -(defun compat--generate-default (name def-fn install-fn check-fn attr type) - "Generate a leaner compatibility definition. -See `compat-generate-function' for details on the arguments NAME, -DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE." - (let* ((min-version (plist-get attr :min-version)) - (max-version (plist-get attr :max-version)) - (feature (plist-get attr :feature)) - (cond (plist-get attr :cond)) - (version (or (plist-get attr :version) - compat-current-version)) - (realname (or (plist-get attr :realname) - (intern (format "compat--%S" name)))) - (check (cond - ((or (and min-version - (version< emacs-version min-version)) - (and max-version - (version< max-version emacs-version))) - '(compat--ignore)) - ((plist-get attr :prefix) - '(compat--inhibit-prefixed)) - ((and version (version<= version emacs-version) (not cond)) - '(compat--ignore)) - (`(when (and ,(if cond cond t) - ,(funcall check-fn))))))) - (cond - ((and (plist-get attr :prefix) (memq type '(func macro)) - (string-match "\\`compat-\\(.+\\)\\'" (symbol-name name)) - (let* ((actual-name (intern (match-string 1 (symbol-name name)))) - (body (funcall install-fn actual-name version))) - (when (and (version<= version emacs-version) - (fboundp actual-name)) - `(,@check - ,(if feature - ;; See https://nullprogram.com/blog/2018/02/22/: - `(eval-after-load ,feature `(funcall ',(lambda () ,body))) - body)))))) - ((plist-get attr :realname) - `(progn - ,(funcall def-fn realname version) - (,@check - ,(let ((body (funcall install-fn realname version))) - (if feature - ;; See https://nullprogram.com/blog/2018/02/22/: - `(eval-after-load ,feature `(funcall ',(lambda () ,body))) - body))))) - ((let* ((body (if (eq type 'advice) - `(,@check - ,(funcall def-fn realname version) - ,(funcall install-fn realname version)) - `(,@check ,(funcall def-fn name version))))) - (if feature - ;; See https://nullprogram.com/blog/2018/02/22/: - `(eval-after-load ,feature `(funcall ',(lambda () ,body))) - body)))))) - -(defun compat-generate-common (name def-fn install-fn check-fn attr type) - "Common code for generating compatibility definitions. -See `compat-generate-function' for details on the arguments NAME, -DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE." - (when (and (plist-get attr :cond) (plist-get attr :prefix)) - (error "A prefixed function %s cannot have a condition" name)) - (funcall compat--generate-function - name def-fn install-fn check-fn attr type)) - -(defun compat-common-fdefine (type name arglist docstring rest) - "Generate compatibility code for a function NAME. -TYPE is one of `func', for functions and `macro' for macros, and -`advice' ARGLIST is passed on directly to the definition, and -DOCSTRING is prepended with a compatibility note. REST contains -the remaining definition, that may begin with a property list of -attributes (see `compat-generate-common')." - (let ((oldname name) (body rest)) - (while (keywordp (car body)) - (setq body (cddr body))) - ;; It might be possible to set these properties otherwise. That - ;; should be looked into and implemented if it is the case. - (when (and (listp (car-safe body)) (eq (caar body) 'declare)) - (when (version<= emacs-version "25") - (delq (assq 'side-effect-free (car body)) (car body)) - (delq (assq 'pure (car body)) (car body)))) - ;; Check if we want an explicitly prefixed function - (when (plist-get rest :prefix) - (setq name (intern (format "compat-%s" name)))) - (compat-generate-common - name - (lambda (realname version) - `(,(cond - ((memq type '(func advice)) 'defun) - ((eq type 'macro) 'defmacro) - ((error "Unknown type"))) - ,realname ,arglist - ;; Prepend compatibility notice to the actual - ;; documentation string. - ,(let ((type (cond - ((eq type 'func) "function") - ((eq type 'macro) "macro") - ((eq type 'advice) "advice") - ((error "Unknown type"))))) - (if version - (format - "[Compatibility %s for `%S', defined in Emacs %s]\n\n%s" - type oldname version docstring) - (format - "[Compatibility %s for `%S']\n\n%s" - type oldname docstring))) - ;; Advice may use the implicit variable `oldfun', but - ;; to avoid triggering the byte compiler, we make - ;; sure the argument is used at least once. - ,@(if (eq type 'advice) - (cons '(ignore oldfun) body) - body))) - (lambda (realname _version) - (cond - ((memq type '(func macro)) - ;; Functions and macros are installed by - ;; aliasing the name of the compatible - ;; function to the name of the compatibility - ;; function. - `(defalias ',name #',realname)) - ((eq type 'advice) - `(advice-add ',name :around #',realname)))) - (lambda () - (cond - ((memq type '(func macro)) - `(not (fboundp ',name))) - ((eq type 'advice) t))) - rest type))) - -(defmacro compat-defun (name arglist docstring &rest rest) - "Define NAME with arguments ARGLIST as a compatibility function. -The function must be documented in DOCSTRING. REST may begin -with a plist, that is interpreted by the macro but not passed on -to the actual function. See `compat-generate-common' for a -listing of attributes. - -The definition will only be installed, if the version this -function was defined in, as indicated by the `:version' -attribute, is greater than the current Emacs version." - (declare (debug (&define name (&rest symbolp) - stringp - [&rest keywordp sexp] - def-body)) - (doc-string 3) (indent 2)) - (compat-common-fdefine 'func name arglist docstring rest)) - -(defmacro compat-defmacro (name arglist docstring &rest rest) - "Define NAME with arguments ARGLIST as a compatibility macro. -The macro must be documented in DOCSTRING. REST may begin -with a plist, that is interpreted by this macro but not passed on -to the actual macro. See `compat-generate-common' for a -listing of attributes. - -The definition will only be installed, if the version this -function was defined in, as indicated by the `:version' -attribute, is greater than the current Emacs version." - (declare (debug compat-defun) (doc-string 3) (indent 2)) - (compat-common-fdefine 'macro name arglist docstring rest)) - -(defmacro compat-advise (name arglist docstring &rest rest) - "Define NAME with arguments ARGLIST as a compatibility advice. -The advice function must be documented in DOCSTRING. REST may -begin with a plist, that is interpreted by this macro but not -passed on to the actual advice function. See -`compat-generate-common' for a listing of attributes. The advice -wraps the old definition, that is accessible via using the symbol -`oldfun'. - -The advice will only be installed, if the version this function -was defined in, as indicated by the `:version' attribute, is -greater than the current Emacs version." - (declare (debug compat-defun) (doc-string 3) (indent 2)) - (compat-common-fdefine 'advice name (cons 'oldfun arglist) docstring rest)) - -(defmacro compat-defvar (name initval docstring &rest attr) - "Declare compatibility variable NAME with initial value INITVAL. -The obligatory documentation string DOCSTRING must be given. - -The remaining arguments ATTR form a plist, modifying the -behaviour of this macro. See `compat-generate-common' for a -listing of attributes. Furthermore, `compat-defvar' also handles -the attribute `:local' that either makes the variable permanent -local with a value of `permanent' or just buffer local with any -non-nil value." - (declare (debug (name form stringp [&rest keywordp sexp])) - (doc-string 3) (indent 2)) - ;; Check if we want an explicitly prefixed function - (let ((oldname name)) - (when (plist-get attr :prefix) - (setq name (intern (format "compat-%s" name)))) - (compat-generate-common - name - (lambda (realname version) - (let ((localp (plist-get attr :local))) - `(progn - (,(if (plist-get attr :constant) 'defconst 'defvar) - ,realname ,initval - ;; Prepend compatibility notice to the actual - ;; documentation string. - ,(if version - (format - "[Compatibility variable for `%S', defined in Emacs %s]\n\n%s" - oldname version docstring) - (format - "[Compatibility variable for `%S']\n\n%s" - oldname docstring))) - ;; Make variable as local if necessary - ,(cond - ((eq localp 'permanent) - `(put ',realname 'permanent-local t)) - (localp - `(make-variable-buffer-local ',realname)))))) - (lambda (realname _version) - `(defvaralias ',name ',realname)) - (lambda () - `(not (boundp ',name))) - attr 'variable))) - -(provide 'compat-macs) -;;; compat-macs.el ends here diff --git a/elpa/compat-28.1.2.2/compat-pkg.el b/elpa/compat-28.1.2.2/compat-pkg.el deleted file mode 100644 index c3a4bf48..00000000 --- a/elpa/compat-28.1.2.2/compat-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;; Generated package description from compat.el -*- no-byte-compile: t -*- -(define-package "compat" "28.1.2.2" "Emacs Lisp Compatibility Library" '((emacs "24.3") (nadvice "0.3")) :commit "d533692182c084bad623977b69f9dc298255eaab" :authors '(("Philip Kaludercic" . "philipk@posteo.net")) :maintainer '("Compat Development" . "~pkal/compat-devel@lists.sr.ht") :keywords '("lisp") :url "https://sr.ht/~pkal/compat") diff --git a/elpa/compat-28.1.2.2/compat.el b/elpa/compat-28.1.2.2/compat.el deleted file mode 100644 index 921f4f8b..00000000 --- a/elpa/compat-28.1.2.2/compat.el +++ /dev/null @@ -1,58 +0,0 @@ -;;; compat.el --- Emacs Lisp Compatibility Library -*- lexical-binding: t; -*- - -;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. - -;; Author: Philip Kaludercic -;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht> -;; Version: 28.1.2.2 -;; URL: https://sr.ht/~pkal/compat -;; Package-Requires: ((emacs "24.3") (nadvice "0.3")) -;; Keywords: lisp - -;; 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 . - -;;; Commentary: - -;; To allow for the usage of Emacs functions and macros that are -;; defined in newer versions of Emacs, compat.el provides definitions -;; that are installed ONLY if necessary. These reimplementations of -;; functions and macros are at least subsets of the actual -;; implementations. Be sure to read the documentation string to make -;; sure. -;; -;; Not every function provided in newer versions of Emacs is provided -;; here. Some depend on new features from the core, others cannot be -;; implemented to a meaningful degree. Please consult the Compat -;; manual for details. The main audience for this library are not -;; regular users, but package maintainers. Therefore commands and -;; user options are usually not implemented here. - -;;; Code: - -(defvar compat--inhibit-prefixed) -(let ((compat--inhibit-prefixed (not (bound-and-true-p compat-testing)))) - ;; Instead of using `require', we manually check `features' and call - ;; `load' to avoid the issue of not using `provide' at the end of - ;; the file (which is disabled by `compat--inhibit-prefixed', so - ;; that the file can be loaded again at some later point when the - ;; prefixed definitions are needed). - (dolist (vers '(24 25 26 27 28)) - (unless (memq (intern (format "compat-%d" vers)) features) - (load (format "compat-%d%s" vers - (if (bound-and-true-p compat-testing) - ".el" "")) - nil t)))) - -(provide 'compat) -;;; compat.el ends here diff --git a/elpa/compat-28.1.2.2/compat.info b/elpa/compat-28.1.2.2/compat.info deleted file mode 100644 index de212352..00000000 --- a/elpa/compat-28.1.2.2/compat.info +++ /dev/null @@ -1,2070 +0,0 @@ -This is compat.info, produced by makeinfo version 6.7 from compat.texi. - -Copyright © 2022 Free Software Foundation, Inc. - - Permission is granted to copy, distribute and/or modify this - document under the terms of the GNU Free Documentation License, - Version 1.3 or any later version published by the Free Software - Foundation; with no Invariant Sections, with the Front-Cover Texts - being “A GNU Manual,” and with the Back-Cover Texts as in (a) - below. A copy of the license is included in the section entitled - “GNU Free Documentation License.” - - (a) The FSF’s Back-Cover Text is: “You have the freedom to copy and - modify this GNU manual.” - -INFO-DIR-SECTION Emacs -START-INFO-DIR-ENTRY -* Compat: (compat). Compatibility Library for Emacs Lisp. -END-INFO-DIR-ENTRY - - -File: compat.info, Node: Top, Next: Introduction, Up: (dir) - -"Compat" Manual -*************** - -This manual documents the usage of the "Compat" Emacs lisp library, the -forward-compatibility library for Emacs Lisp, corresponding to version -28.1.2.2. - - Copyright © 2022 Free Software Foundation, Inc. - - Permission is granted to copy, distribute and/or modify this - document under the terms of the GNU Free Documentation License, - Version 1.3 or any later version published by the Free Software - Foundation; with no Invariant Sections, with the Front-Cover Texts - being “A GNU Manual,” and with the Back-Cover Texts as in (a) - below. A copy of the license is included in the section entitled - “GNU Free Documentation License.” - - (a) The FSF’s Back-Cover Text is: “You have the freedom to copy and - modify this GNU manual.” - -* Menu: - -* Introduction:: -* Support:: -* Development:: -* Function Index:: -* Variable Index:: - -— The Detailed Node Listing — - -Introduction - -* Overview:: -* Usage:: -* Intentions:: - -Usage - -* Additional libraries:: - -Support - -* Emacs 24.4:: Compatibility support for Emacs 24.4 -* Emacs 25.1:: Compatibility support for Emacs 25.1 -* Emacs 26.1:: Compatibility support for Emacs 26.1 -* Emacs 27.1:: Compatibility support for Emacs 27.1 -* Emacs 28.1:: Compatibility support for Emacs 28.1 - - - -File: compat.info, Node: Introduction, Next: Support, Prev: Top, Up: Top - -1 Introduction -************** - -* Menu: - -* Overview:: -* Usage:: -* Intentions:: - - -File: compat.info, Node: Overview, Next: Usage, Up: Introduction - -1.1 Overview -============ - -The objective of Compat is to provide "forwards compatibility" library -for Emacs Lisp. That is to say by using Compat, an Elisp package does -not have to make the decision to either use new and useful functionality -or support old versions of Emacs. - - Version 24.3 is chosen as the oldest version, because this is the -newest version on CentOS 7. It is intended to preserve compatibility -for at least as the Centos 7 reaches EOL -(https://wiki.centos.org/About/Product), 2024. - - If you are developing a package with Compat in mind, consider loading -‘compat-help‘ (on your system, not in a package) to get relevant notes -inserted into the help buffers of functions that are implemented or -advised in Compat. - - Note that Compat provides a few prefixed function, ie. functions -with a ‘compat-’ prefix. These are used to provide extended -functionality for commands that are already defined (‘sort’, ‘assoc’, -‘seq’, ...). It might be possible to transform these into advised -functions later on, so that the modified functionality is accessible -without a prefix. Feedback on this point is appreciated. - - -File: compat.info, Node: Usage, Next: Intentions, Prev: Overview, Up: Introduction - -1.2 Usage -========= - -The intended use-case for this library is for package developers to add -as a dependency in the header: - - ;; Package-Requires: ((emacs "24.3") (compat "28.1.2.2")) - - There is no need to depend on ‘emacs’ 24.3 specifically. One can -choose to any newer version, if features not provided by Compat -necessitate it. - - In any file where compatibility forms are used, a - - (require 'compat) - - should be added early on. - - This will load all non-prefixed definitions (functions and macros -with a leading ‘compat-‘). To load these, an additional - - (require 'compat-XY) ; e.g. 26 - - will be necessary, to load compatibility code for Emacs version XY. - - It is recommended to subscribe to the compat-announce -(https://lists.sr.ht/~pkal/compat-announce) mailing list to be notified -when new versions are released or relevant changes are made. - -* Menu: - -* Additional libraries:: - - -File: compat.info, Node: Additional libraries, Up: Usage - -1.2.1 Additional libraries --------------------------- - -These libraries are packages with Compat, but are disabled by default. -To use them you can use ‘M-x load-library’: - -compat-help - Add notes to ‘*Help*’ buffer, if a compatibility definition has - something to warn you about. -compat-font-lock - Highlight functions that are implemented as compatibility - definitions. - - -File: compat.info, Node: Intentions, Prev: Usage, Up: Introduction - -1.3 Intentions -============== - -The library intends to provide support back until Emacs 24.3. The -intended audience are package developers that are interested in using -newer developments, without having to break compatibility. - - Sadly, total backwards compatibility cannot be provided for technical -reasons. These might include: - - • An existing function or macro was extended by some new - functionality. To support these cases, the function or macro would - have to be advised. As this is usually regarded as invasive and is - shown to be a significant overhead, even when the new feature is - not used, this approach is not used. - - As a compromise, prefixed functions and macros (starting with a - ‘compat-’ prefix) can be provided. - - • New functionality was implemented in the core, and depends on - external libraries that cannot be reasonably duplicated in the - scope of a compatibility library. - - • New functionality depends on an entire new, non-trivial library. - Sometimes these are provided via ELPA (xref, project, ...), but - other times it would be infeasible to duplicate an entire library - within Compat while also providing the necessary backwards - compatibility. - - • It just wasn’t added, and there is no good reason (though good - excuses might exist). If you happen to find such a function, *note - reporting: Development. it would be much appreciated. - - Always begin by assuming that this might be the case, unless proven - otherwise. - - -File: compat.info, Node: Support, Next: Development, Prev: Introduction, Up: Top - -2 Support -********* - -This section goes into the features that Compat manages and doesn’t -manage to provide for each Emacs version. - -* Menu: - -* Emacs 24.4:: Compatibility support for Emacs 24.4 -* Emacs 25.1:: Compatibility support for Emacs 25.1 -* Emacs 26.1:: Compatibility support for Emacs 26.1 -* Emacs 27.1:: Compatibility support for Emacs 27.1 -* Emacs 28.1:: Compatibility support for Emacs 28.1 - - -File: compat.info, Node: Emacs 24.4, Next: Emacs 25.1, Up: Support - -2.1 Emacs 24.4 -============== - -2.1.1 Unprefixed Definitions ----------------------------- - -The following functions and macros implemented in 24.4, and are provided -by Compat by default: - - -- Macro: with-eval-after-load library body... - This macro arranges to evaluate BODY at the end of loading the file - LIBRARY, each time LIBRARY is loaded. If LIBRARY is already - loaded, it evaluates BODY right away. - - You don’t need to give a directory or extension in the file name - LIBRARY. Normally, you just give a bare file name, like this: - - (with-eval-after-load "js" (keymap-set js-mode-map "C-c C-c" 'js-eval)) - - To restrict which files can trigger the evaluation, include a - directory or an extension or both in LIBRARY. Only a file whose - absolute true name (i.e., the name with all symbolic links chased - out) matches all the given name components will match. In the - following example, ‘my_inst.elc’ or ‘my_inst.elc.gz’ in some - directory ‘..../foo/bar’ will trigger the evaluation, but not - ‘my_inst.el’: - - (with-eval-after-load "foo/bar/my_inst.elc" ...) - - LIBRARY can also be a feature (i.e., a symbol), in which case BODY - is evaluated at the end of any file where ‘(provide LIBRARY)’ is - called. - - An error in BODY does not undo the load, but does prevent execution - of the rest of BODY. - - *Note (elisp)Hooks for Loading::. - - -- Function: special-form-p object - This predicate tests whether its argument is a special form, and - returns ‘t’ if so, ‘nil’ otherwise. - - *Note (elisp)Special Forms::. - - -- Function: macrop object - This predicate tests whether its argument is a macro, and returns - ‘t’ if so, ‘nil’ otherwise. - - *Note (elisp)Simple Macro::. - - -- Function: string-suffix-p suffix string &optional ignore-case - This function returns non-‘nil’ if SUFFIX is a suffix of STRING; - i.e., if STRING ends with SUFFIX. If the optional argument - IGNORE-CASE is non-‘nil’, the comparison ignores case differences. - - *Note (elisp)Text Comparison::. - - -- Function: delete-consecutive-dups list &optional circular - Destructively remove ‘equal’ consecutive duplicates from LIST. - First and last elements are considered consecutive if CIRCULAR is - non-nil. - - -- Function: define-error name message &optional parent - In order for a symbol to be an error symbol, it must be defined - with ‘define-error’ which takes a parent condition (defaults to - ‘error’). This parent defines the conditions that this kind of - error belongs to. The transitive set of parents always includes - the error symbol itself, and the symbol ‘error’. Because quitting - is not considered an error, the set of parents of ‘quit’ is just - ‘(quit)’. - - *Note (elisp)Error Symbols::. - - -- Function: bool-vector-exclusive-or a b &optional c - Return “bitwise exclusive or” of bool vectors A and B. If optional - argument C is given, the result of this operation is stored into C. - All arguments should be bool vectors of the same length. - - *Note (elisp)Bool-Vectors::. - - -- Function: bool-vector-union a b &optional c - Return “bitwise or” of bool vectors A and B. If optional argument - C is given, the result of this operation is stored into C. All - arguments should be bool vectors of the same length. - - *Note (elisp)Bool-Vectors::. - - -- Function: bool-vector-intersection a b &optional c - Return “bitwise and” of bool vectors A and B. If optional argument - C is given, the result of this operation is stored into C. All - arguments should be bool vectors of the same length. - - *Note (elisp)Bool-Vectors::. - - -- Function: bool-vector-set-difference a b &optional c - Return “set difference” of bool vectors A and B. If optional - argument C is given, the result of this operation is stored into C. - All arguments should be bool vectors of the same length. - - *Note (elisp)Bool-Vectors::. - - -- Function: bool-vector-not a &optional b - Return “set complement” of bool vector A. If optional argument B - is given, the result of this operation is stored into B. All - arguments should be bool vectors of the same length. - - *Note (elisp)Bool-Vectors::. - - -- Function: bool-vector-subsetp a b - Return ‘t’ if every ‘t’ value in A is also ‘t’ in B, ‘nil’ - otherwise. All arguments should be bool vectors of the same - length. - - *Note (elisp)Bool-Vectors::. - - -- Function: bool-vector-count-consecutive a b i - Return the number of consecutive elements in A equal B starting at - I. ‘a’ is a bool vector, B is ‘t’ or ‘nil’, and I is an index into - ‘a’. - - *Note (elisp)Bool-Vectors::. - - -- Function: bool-vector-count-population a - Return the number of elements that are ‘t’ in bool vector A. - - *Note (elisp)Bool-Vectors::. - - -- Function: completion-table-with-cache function &optional ignore-case - This is a wrapper for ‘completion-table-dynamic’ that saves the - last argument-result pair. This means that multiple lookups with - the same argument only need to call FUNCTION once. This can be - useful when a slow operation is involved, such as calling an - external process. - - *Note (elisp)Programmed Completion::. - - -- Function: face-spec-set face spec &optional spec-type - This function applies SPEC as a face spec for ‘face’. SPEC should - be a face spec, as described in the above documentation for - ‘defface’. - - This function also defines FACE as a valid face name if it is not - already one, and (re)calculates its attributes on existing frames. - - The optional argument SPEC-TYPE determines which spec to set. If - it is omitted or ‘nil’ or ‘face-override-spec’, this function sets - the “override spec”, which overrides face specs on FACE of all the - other types mentioned below. This is useful when calling this - function outside of Custom code. If SPEC-TYPE is ‘customized-face’ - or ‘saved-face’, this function sets the customized spec or the - saved custom spec, respectively. If it is ‘face-defface-spec’, - this function sets the default face spec (the same one set by - ‘defface’). If it is ‘reset’, this function clears out all - customization specs and override specs from FACE (in this case, the - value of SPEC is ignored). The effect of any other value of - SPEC-TYPE on the face specs is reserved for internal use, but the - function will still define FACE itself and recalculate its - attributes, as described above. - - *Note (elisp)Defining Faces::. - -2.1.2 Prefixed Definitions --------------------------- - -These functions are prefixed with ‘compat’ prefix, and are only loaded -when ‘compat-24’ is required: - - -- Function: compat-= number-or-marker &rest number-or-markers - This function tests whether all its arguments are numerically - equal, and returns ‘t’ if so, ‘nil’ otherwise. - - *Note (elisp)Comparison of Numbers::. - -- Function: compat-< number-or-marker &rest number-or-markers - This function tests whether each argument is strictly less than the - following argument. It returns ‘t’ if so, ‘nil’ otherwise. - - *Note (elisp)Comparison of Numbers::. - -- Function: compat-> number-or-marker &rest number-or-markers - This function tests whether each argument is strictly greater than - the following argument. It returns ‘t’ if so, ‘nil’ otherwise. - - *Note (elisp)Comparison of Numbers::. - -- Function: compat-<= number-or-marker &rest number-or-markers - This function tests whether each argument is less than or equal to - the following argument. It returns ‘t’ if so, ‘nil’ otherwise. - - *Note (elisp)Comparison of Numbers::. - -- Function: compat->= number-or-marker &rest number-or-markers - This function tests whether each argument is greater than or equal - to the following argument. It returns ‘t’ if so, ‘nil’ otherwise. - - *Note (elisp)Comparison of Numbers::. - - These functions differ from the previous implementation in that they -allow for more than two argument to be compared. - - -- Function: compat-split-string string &optional separators omit-nulls - trim - This function splits STRING into substrings based on the regular - expression SEPARATORS (*note (elisp)Regular Expressions::). Each - match for SEPARATORS defines a splitting point; the substrings - between splitting points are made into a list, which is returned. - - *note (elisp)Creating Strings:: for more details. - - This version handles the optional argument TRIM. If it is - non-‘nil’, it should be a regular expression to match text to trim - from the beginning and end of each substring. If trimming makes - the substring empty, it is treated as null. - -2.1.3 Missing Definitions -------------------------- - -Compat does not provide support for the following Lisp features -implemented in 24.4: - - • Allowing the second optional argument to ‘eval’ to specify a - lexical environment. - • The ‘define-alternatives’ macro. - • Support for the ‘defalias-fset-function’ symbol property. - • The ‘group-gid’ and ‘groupd-read-gid’ functions. - • The ‘pre-redisplay-function’ hook. - • Allowing for ‘with-demoted-errors’ to take a additional argument - ‘format’. - • The ‘add-face-text-property’ function. - • No ‘tty-setup-hook’ hook. - • The ‘get-pos-property’ function. - • The ‘define-advice’ macro. - • Support for generators. - • The ‘string-trim’, ‘string-trim-left’ and ‘string-trim-right’ - functions. These are instead provided as prefixed function as part - of *note Emacs 26.1:: support. - - -File: compat.info, Node: Emacs 25.1, Next: Emacs 26.1, Prev: Emacs 24.4, Up: Support - -2.2 Emacs 25.1 -============== - -2.2.1 Unprefixed Definitions ----------------------------- - -The following functions and macros implemented in 25.1, and are provided -by Compat by default: - - -- Function: format-message string &rest objects - This function acts like ‘format’, except it also converts any grave - accents (`) and apostrophes (') in STRING as per the value of - ‘text-quoting-style’. - - Typically grave accent and apostrophe in the format translate to - matching curved quotes, e.g., "Missing `%s'" might result in - "Missing ‘foo’". *Note (elisp)Text Quoting Style::, for how to - influence or inhibit this translation. - - *note (elisp)Formatting Strings::. - - -- Function: directory-name-p filename - This function returns non-‘nil’ if FILENAME ends with a directory - separator character. This is the forward slash ‘/’ on GNU and - other POSIX-like systems; MS-Windows and MS-DOS recognize both the - forward slash and the backslash ‘\’ as directory separators. - - *Note (elisp)Directory Names::. - - -- Function: string-greaterp string1 string2 - This function returns the result of comparing STRING1 and STRING2 - in the opposite order, i.e., it is equivalent to calling - ‘(string-lessp STRING2 STRING1)’. - - *Note (elisp)Text Comparison::. - - -- Macro: with-file-modes mode body... - This macro evaluates the BODY forms with the default permissions - for new files temporarily set to MODES (whose value is as for - ‘set-file-modes’ above). When finished, it restores the original - default file permissions, and returns the value of the last form in - BODY. - - This is useful for creating private files, for example. - - *Note (elisp)Changing Files::. - - -- Function: alist-get key alist &optional default remove testfn - This function is similar to ‘assq’. It finds the first association - ‘(KEY . VALUE)’ by comparing KEY with ALIST elements, and, if - found, returns the VALUE of that association. If no association is - found, the function returns DEFAULT. Comparison of KEY against - ALIST elements uses the function specified by TESTFN, defaulting to - ‘eq’. - - This is a generalized variable (*note (elisp)Generalized - Variables::) that can be used to change a value with ‘setf’. When - using it to set a value, optional argument REMOVE non-‘nil’ means - to remove KEY’s association from ALIST if the new value is ‘eql’ to - DEFAULT. - - *note (elisp)Association Lists::. - - -- Macro: if-let (bindings...) then &rest else... - As with ‘let*’, BINDINGS will consist of ‘(SYMBOL VALUE-FORM)’ - entries that are evaluated and bound sequentially. If all - VALUE-FORM evaluate to non-‘nil’ values, then THEN is evaluated as - were the case with a regular ‘let*’ expression, with all the - variables bound. If any VALUE-FORM evaluates to ‘nil’, ELSE is - evaluated, without any bound variables. - - A binding may also optionally drop the SYMBOL, and simplify to - ‘(VALUE-FORM)’ if only the test is of interest. - - For the sake of backwards compatibility, it is possible to write a - single binding without a binding list: - - (if-let* (SYMBOL (test)) foo bar) - ≡ - (if-let* ((SYMBOL (test))) foo bar) - - -- Macro: when-let (bindings...) &rest body - As with ‘when’, if one is only interested in the case where all - BINDINGS are non-nil. Otherwise BINDINGS are interpreted just as - they are by ‘if-let*’. - - -- Macro: thread-first &rest forms - Combine FORMS into a single expression by “threading” each element - as the _first_ argument of their successor. Elements of FORMS can - either be an list of an atom. - - For example, consider the threading expression and it’s equivalent - macro expansion: - - (thread-first - 5 - (+ 20) - (/ 25) - - - (+ 40)) - ≡ - (+ (- (/ (+ 5 20) 25)) 40) - - Note how the single ‘-’ got converted into a list before threading. - This example uses arithmetic functions, but ‘thread-first’ is not - restricted to arithmetic or side-effect free code. - - -- Macro: thread-last &rest forms - Combine FORMS into a single expression by “threading” each element - as the _last_ argument of their successor. Elements of FORMS can - either be an list of an atom. - - For example, consider the threading expression and it’s equivalent - macro expansion: - - (thread-first - 5 - (+ 20) - (/ 25) - - - (+ 40)) - ≡ - (+ 40 (- (/ 25 (+ 20 5)))) - - Note how the single ‘-’ got converted into a list before threading. - This example uses arithmetic functions, but ‘thread-last’ is not - restricted to arithmetic or side-effect free code. - - -- Function: macroexpand-1 form &optional environment - This function expands macros like ‘macroexpand’, but it only - performs one step of the expansion: if the result is another macro - call, ‘macroexpand-1’ will not expand it. - - *Note Expansion: (elisp)Expansion. - - -- Function: directory-files-recursively directory regexp &optional - include-directories predicate follow-symlinks - Return all files under DIRECTORY whose names match REGEXP. This - function searches the specified DIRECTORY and its sub-directories, - recursively, for files whose basenames (i.e., without the leading - directories) match the specified REGEXP, and returns a list of the - absolute file names of the matching files (*note absolute file - names: (elisp)Relative File Names.). The file names are returned - in depth-first order, meaning that files in some sub-directory are - returned before the files in its parent directory. In addition, - matching files found in each subdirectory are sorted alphabetically - by their basenames. By default, directories whose names match - REGEXP are omitted from the list, but if the optional argument - INCLUDE-DIRECTORIES is non-‘nil’, they are included. - - By default, all subdirectories are descended into. If PREDICATE is - ‘t’, errors when trying to descend into a subdirectory (for - instance, if it’s not readable by this user) are ignored. If it’s - neither ‘nil’ nor ‘t’, it should be a function that takes one - parameter (the subdirectory name) and should return non-‘nil’ if - the directory is to be descended into. - - Symbolic links to subdirectories are not followed by default, but - if FOLLOW-SYMLINKS is non-‘nil’, they are followed. - - *Note (elisp)Contents of Directories::. - - -- Function: bool-vector &rest objects - This function creates and returns a bool-vector whose elements are - the arguments, OBJECTS. - - *Note (elisp)Bool-Vectors::. - -2.2.2 Prefixed Definitions --------------------------- - -These functions are prefixed with ‘compat’ prefix, and are only loaded -when ‘compat-25’ is required: - - -- Function: compat-sort sequence predicate - This function sorts SEQUENCE stably. Note that this function - doesn’t work for all sequences; it may be used only for lists and - vectors. If SEQUENCE is a list, it is modified destructively. - This functions returns the sorted SEQUENCE and compares elements - using PREDICATE. A stable sort is one in which elements with equal - sort keys maintain their relative order before and after the sort. - Stability is important when successive sorts are used to order - elements according to different criteria. - - *Note (elisp)Sequence Functions::. - - The compatibility version adds support for vectors to be sorted, - not just lists. - -2.2.3 Missing Definitions -------------------------- - -Compat does not provide support for the following Lisp features -implemented in 25.1: - - • New ‘pcase’ patterns. - • The hook ‘prefix-command-echo-keystrokes-functions’ and - ‘prefix-command-preserve-state-hook’. - • The hook ‘pre-redisplay-functions’. - • The function ‘make-process’. - • Support for the variable ‘inhibit-message’. - • The ‘define-inline’ functionality. - • The functions ‘string-collate-lessp’ and ‘string-collate-equalp’. - • The function ‘funcall-interactivly’. - • The function ‘buffer-substring-with-bidi-context’. - • The function ‘font-info’. - • The function ‘default-font-width’. - • The function ‘window-font-height’ and ‘window-font-width’. - • The function ‘window-max-chars-per-line’. - • The function ‘set-binary-mode’. - • The functions ‘bufferpos-to-filepos’ and ‘filepos-to-bufferpos’. - - -File: compat.info, Node: Emacs 26.1, Next: Emacs 27.1, Prev: Emacs 25.1, Up: Support - -2.3 Emacs 26.1 -============== - -2.3.1 Unprefixed Definitions ----------------------------- - -The following functions and macros implemented in 26.1, and are provided -by Compat by default: - - -- Function: func-arity function - This function provides information about the argument list of the - specified FUNCTION. The returned value is a cons cell of the form - ‘(MIN . MAX)’, where MIN is the minimum number of arguments, and - MAX is either the maximum number of arguments, or the symbol ‘many’ - for functions with ‘&rest’ arguments, or the symbol ‘unevalled’ if - FUNCTION is a special form. - - Note that this function might return inaccurate results in some - situations, such as the following: - - − Functions defined using ‘apply-partially’ (*note - apply-partially: (elisp)Calling Functions.). - - − Functions that are advised using ‘advice-add’ (*note - (elisp)Advising Named Functions::). - - − Functions that determine the argument list dynamically, as - part of their code. - - *Note (elisp)What Is a Function::. - - -- Function: mapcan function sequence - This function applies FUNCTION to each element of SEQUENCE, like - ‘mapcar’, but instead of collecting the results into a list, it - returns a single list with all the elements of the results (which - must be lists), by altering the results (using ‘nconc’; *note - (elisp)Rearrangement::). Like with ‘mapcar’, SEQUENCE can be of - any type except a char-table. - - ;; Contrast this: (mapcar #'list '(a b c d)) ⇒ ((a) (b) (c) - (d)) ;; with this: (mapcan #'list '(a b c d)) ⇒ (a b c d) - - *Note (elisp)Mapping Functions::. - - -- Function: cXXXr - -- Function: cXXXXr - *Note (elisp)List Elements::. - - -- Function: gensym &optional prefix - This function returns a symbol using ‘make-symbol’, whose name is - made by appending ‘gensym-counter’ to PREFIX and incrementing that - counter, guaranteeing that no two calls to this function will - generate a symbol with the same name. The prefix defaults to - ‘"g"’. - - -- Variable: gensym-counter - See ‘gensym’. - - -- Function: make-nearby-temp-file prefix &optional dir-flag suffix - This function is similar to ‘make-temp-file’, but it creates a - temporary file as close as possible to ‘default-directory’. If - PREFIX is a relative file name, and ‘default-directory’ is a remote - file name or located on a mounted file systems, the temporary file - is created in the directory returned by the function - ‘temporary-file-directory’. Otherwise, the function - ‘make-temp-file’ is used. PREFIX, DIR-FLAG and SUFFIX have the - same meaning as in ‘make-temp-file’. - - (let ((default-directory "/ssh:remotehost:")) (make-nearby-temp-file - "foo")) ⇒ "/ssh:remotehost:/tmp/foo232J6v" - - -- Variable: mounted-file-systems - A regular expression matching files names that are probably on a - mounted file system. - - -- Function: temporary-file-directory - The directory for writing temporary files via - ‘make-nearby-temp-file’. In case of a remote ‘default-directory’, - this is a directory for temporary files on that remote host. If - such a directory does not exist, or ‘default-directory’ ought to be - located on a mounted file system (see ‘mounted-file-systems’), the - function returns ‘default-directory’. For a non-remote and - non-mounted ‘default-directory’, the value of the variable - ‘temporary-file-directory’ is returned. - - *Note (elisp)Unique File Names::. - - -- Macro: if-let* (bindings...) then &rest else - ‘if-let*’ is mostly equivalent to ‘if-let’, with the exception that - the legacy ‘(if (VAR (test)) foo bar)’ syntax is not permitted. - - -- Macro: when-let* (bindings...) then &rest else - ‘when-let*’ is mostly equivalent to ‘when-let’, with the exception - that the legacy ‘(when-let (VAR (test)) foo bar)’ syntax is not - permitted. - - -- Macro: and-let* (bindings...) &rest body - A combination of LET* and AND, analogous to ‘when-let*’. If all - BINDINGS are non-‘nil’ and BODY is ‘nil’, then the result of the - ‘and-let*’ form will be the last value bound in BINDINGS. - - **Please Note:** The implementation provided by Compat does not - include a bug that was observed with Emacs 26 (see - ). - - -- Function: file-local-name filename - This function returns the _local part_ of FILENAME. This is the - part of the file’s name that identifies it on the remote host, and - is typically obtained by removing from the remote file name the - parts that specify the remote host and the method of accessing it. - For example: - - (file-local-name "/ssh:USER@HOST:/foo/bar") ⇒ - "/foo/bar" - - For a remote FILENAME, this function returns a file name which - could be used directly as an argument of a remote process (*note - (elisp)Asynchronous Processes::, and *note (elisp)Synchronous - Processes::), and as the program to run on the remote host. If - FILENAME is local, this function returns it unchanged. - - *Note (elisp)Magic File Names::. - - -- Macro: file-name-quoted-p name - This macro returns non-‘nil’, when NAME is quoted with the prefix - ‘/:’. If NAME is a remote file name, the local part of NAME is - checked. - - *Note (elisp)File Name Expansion::. - - -- Macro: file-name-quote name - This macro adds the quotation prefix ‘/:’ to the file NAME. For a - local file NAME, it prefixes NAME with ‘/:’. If NAME is a remote - file name, the local part of NAME (*note (elisp)Magic File Names::) - is quoted. If NAME is already a quoted file name, NAME is returned - unchanged. - - (substitute-in-file-name (file-name-quote "bar/~/foo")) ⇒ - "/:bar/~/foo" - - (substitute-in-file-name (file-name-quote "/ssh:host:bar/~/foo")) - ⇒ "/ssh:host:/:bar/~/foo" - - The macro cannot be used to suppress file name handlers from magic - file names (*note (elisp)Magic File Names::). - - *Note (elisp)File Name Expansion::. - - -- Function: read-multiple-choice prompt choices &optional help-string - show-help long-form - Ask user a multiple choice question. PROMPT should be a string - that will be displayed as the prompt. - - CHOICES is an alist where the first element in each entry is a - character to be entered, the second element is a short name for the - entry to be displayed while prompting (if there’s room, it might be - shortened), and the third, optional entry is a longer explanation - that will be displayed in a help buffer if the user requests more - help. - - If optional argument LONG-FORM is non-‘nil’, the user will have to - type in long-form answers (using ‘completing-read’) instead of - hitting a single key. The answers must be among the second - elements of the values in the CHOICES list. - - Note: The Compat implementation of this function ignores the - optional arguments HELP-STRING and SHOW-HELP. Therefore the - optional third element in each CHOICES entry will also be - disregarded. - - See *note Reading One Event: (elisp)Reading One Event. - - -- Function: image-property - Defined in ‘image.el’. - - This function can also be used as a generalised variable. To use - this you need to explicitly require ‘compat-26’. - - -- Function: file-attribute-type - Return the field _type_ as generated by ‘file-attributes’. - - *Note (elisp)File Attributes::. - - -- Function: file-attribute-link-number - Return the field _link-number_ as generated by ‘file-attributes’. - - *Note (elisp)File Attributes::. - - -- Function: file-attribute-user-id - Return the field _user-id_ as generated by ‘file-attributes’. - - *Note (elisp)File Attributes::. - - -- Function: file-attribute-group-id - Return the field _group-id_ as generated by ‘file-attributes’. - - *Note (elisp)File Attributes::. - - -- Function: file-attribute-access-time - Return the field _access-time_ as generated by ‘file-attributes’. - - *Note (elisp)File Attributes::. - - -- Function: file-attribute-modification-time - Return the field _modification-time_ as generated by - ‘file-attributes’. - - *Note (elisp)File Attributes::. - - -- Function: file-attribute-status-change-time - Return the field _modification-time_ as generated by - ‘file-attributes’. - - *Note (elisp)File Attributes::. - - -- Function: file-attribute-size - Return the field _size_ as generated by ‘file-attributes’. - - *Note (elisp)File Attributes::. - - -- Function: file-attribute-modes - Return the field _modes_ as generated by ‘file-attributes’. - - *Note (elisp)File Attributes::. - - -- Function: file-attribute-inode-number - Return the field _inode-number_ as generated by ‘file-attributes’. - - *Note (elisp)File Attributes::. - - -- Function: file-attribute-device-number - Return the field _device-number_ as generated by ‘file-attributes’. - - *Note (elisp)File Attributes::. - - -- Function: file-attribute-collect attributes &rest attr-names - Filter the file attributes ATTRIBUTES, as generated by - ‘file-attributes’, according to ATTR-NAMES. - - Valid attribute names for ATTR-NAMES are: type, link-number, - user-id, group-id, access-time, modification-time, - status-change-time, size, modes, inode-number and device-number. - - (file-attributes ".") ⇒ (t 1 1000 1000 (25329 18215 325481 96000) (25325 15364 530263 840000) (25325 15364 530263 840000) 788 "drwxr-xr-x" t 137819 40) - (file-attribute-collect (file-attributes ".") 'type 'modes - 'inode-number) ⇒ (t "drwxr-xr-x" 137819) - -2.3.2 Prefixed Definitions --------------------------- - -These functions are prefixed with ‘compat’ prefix, and are only loaded -when ‘compat-26’ is required: - - -- Function: compat-assoc key alist &optional testfn - This function returns the first association for KEY in ALIST, - comparing KEY against the alist elements using TESTFN if it is a - function, and ‘equal’ otherwise (*note (elisp)Equality - Predicates::). If TESTFN is a function, it is called with two - arguments: the CAR of an element from ALIST and KEY. The function - returns ‘nil’ if no association in ALIST has a CAR equal to KEY, as - tested by TESTFN. - - *Note (elisp)Association Lists::. - - The compatibility version adds support for handling the optional - argument TESTFN. - - -- Function: compat-line-number-at-pos &optional pos absolute - This function returns the line number in the current buffer - corresponding to the buffer position POS. If POS is ‘nil’ or - omitted, the current buffer position is used. If ABSOLUTE is - ‘nil’, the default, counting starts at ‘(point-min)’, so the value - refers to the contents of the accessible portion of the - (potentially narrowed) buffer. If ABSOLUTE is non-‘nil’, ignore - any narrowing and return - - *Note (elisp)Text Lines::. - - The compatibility version adds support for handling the optional - argument ABSOLUTE. - - -- Function: compat-alist-get key alist &optional default remove testfn - *Note (elisp)Association Lists::. This function is similar to - ‘assq’. It finds the first association ‘(KEY . VALUE)’ by - comparing KEY with ALIST elements, and, if found, returns the VALUE - of that association. If no association is found, the function - returns DEFAULT. Comparison of KEY against ALIST elements uses the - function specified by TESTFN, defaulting to ‘eq’. - - *Note (elisp)Association Lists::. - - The compatibility version handles the optional argument TESTFN. It - can also be used as a *note Generalized Variables: - (elisp)generalised variable. - - -- Function: compat-string-trim-left string &optional regexp - Remove the leading text that matches REGEXP from STRING. REGEXP - defaults to ‘[ \t\n\r]+’. - - *Note (elisp)Creating Strings::. - - The compatibility version handles the optional argument REGEXP. - - -- Function: compat-string-trim-right string &optional regexp - Remove the trailing text that matches REGEXP from STRING. REGEXP - defaults to ‘[ \t\n\r]+’. - - *Note (elisp)Creating Strings::. - - The compatibility version handles the optional argument REGEXP. - - -- Function: compat-string-trim string &optional trim-left trim-right - Remove the leading text that matches TRIM-LEFT and trailing text - that matches TRIM-RIGHT from STRING. Both regexps default to ‘[ - \t\n\r]+’. - - *Note (elisp)Creating Strings::. - - The compatibility version handles the optional arguments TRIM-LEFT - and TRIM-RIGHT. - -2.3.3 Missing Definitions -------------------------- - -Compat does not provide support for the following Lisp features -implemented in 26.1: - - • The function ‘secure-hash-algorithms’. - • The function ‘gnutls-avalaible-p’. - • Support for records and record functions. - • The function ‘mapbacktrace’. - • The function ‘file-name-case-insensitive-p’. - • The file-attributes constructors. - • The additional elements of ‘parse-partial-sexp’. - • The function ‘add-variable-watcher’. - • The function ‘undo-amalgamate-change-group’. - • The function ‘char-from-name’ - • Signalling errors when ‘length’ or ‘member’ deal with list cycles. - • The function ‘frame-list-z-order’. - • The function ‘frame-restack’. - • Support for side windows and atomic windows. - • All changes related to ‘display-buffer’. - • The function ‘window-swap-states’. - - -File: compat.info, Node: Emacs 27.1, Next: Emacs 28.1, Prev: Emacs 26.1, Up: Support - -2.4 Emacs 27.1 -============== - -2.4.1 Unprefixed Definitions ----------------------------- - -The following functions and macros implemented in 27.1, and are provided -by Compat by default: - - -- Function: proper-list-p object - This function returns the length of OBJECT if it is a proper list, - ‘nil’ otherwise (*note (elisp)Cons Cells::). In addition to - satisfying ‘listp’, a proper list is neither circular nor dotted. - - (proper-list-p '(a b c)) ⇒ 3 - (proper-list-p '(a b . c)) ⇒ nil - - *Note (elisp)List-related Predicates::. - - -- Function: string-distance string1 string2 &optional bytecompare - This function returns the _Levenshtein distance_ between the source - string STRING1 and the target string STRING2. The Levenshtein - distance is the number of single-character changes—deletions, - insertions, or replacements—required to transform the source string - into the target string; it is one possible definition of the _edit - distance_ between strings. - - Letter-case of the strings is significant for the computed - distance, but their text properties are ignored. If the optional - argument BYTECOMPARE is non-‘nil’, the function calculates the - distance in terms of bytes instead of characters. The byte-wise - comparison uses the internal Emacs representation of characters, so - it will produce inaccurate results for multibyte strings that - include raw bytes (*note (elisp)Text Representations::); make the - strings unibyte by encoding them (*note (elisp)Explicit Encoding::) - if you need accurate results with raw bytes. - - *Note (elisp)Text Comparison::. - - -- Function: json-serialize object &rest args - This function returns a new Lisp string which contains the JSON - representation of OBJECT. The argument ARGS is a list of - keyword/argument pairs. The following keywords are accepted: - - ‘:null-object’ - The value decides which Lisp object to use to represent the - JSON keyword ‘null’. It defaults to the symbol ‘:null’. - - ‘:false-object’ - The value decides which Lisp object to use to represent the - JSON keyword ‘false’. It defaults to the symbol ‘:false’. - - *Note (elisp)Parsing JSON::. - - -- Function: json-insert object &rest args - This function inserts the JSON representation of OBJECT into the - current buffer before point. The argument ARGS are interpreted as - in ‘json-parse-string’. - - *Note (elisp)Parsing JSON::. - - -- Function: json-parse-string string &rest args - This function parses the JSON value in STRING, which must be a Lisp - string. If STRING doesn’t contain a valid JSON object, this - function signals the ‘json-parse-error’ error. - - The argument ARGS is a list of keyword/argument pairs. The - following keywords are accepted: - - ‘:object-type’ - The value decides which Lisp object to use for representing - the key-value mappings of a JSON object. It can be either - ‘hash-table’, the default, to make hashtables with strings as - keys; ‘alist’ to use alists with symbols as keys; or ‘plist’ - to use plists with keyword symbols as keys. - - ‘:array-type’ - The value decides which Lisp object to use for representing a - JSON array. It can be either ‘array’, the default, to use - Lisp arrays; or ‘list’ to use lists. - - ‘:null-object’ - The value decides which Lisp object to use to represent the - JSON keyword ‘null’. It defaults to the symbol ‘:null’. - - ‘:false-object’ - The value decides which Lisp object to use to represent the - JSON keyword ‘false’. It defaults to the symbol ‘:false’. - - *Note (elisp)Parsing JSON::. - - -- Function: json-parse-buffer &rest args - This function reads the next JSON value from the current buffer, - starting at point. It moves point to the position immediately - after the value if contains a valid JSON object; otherwise it - signals the ‘json-parse-error’ error and doesn’t move point. The - arguments ARGS are interpreted as in ‘json-parse-string’. - - *Note (elisp)Parsing JSON::. - - -- Macro: ignore-errors body... - This construct executes BODY, ignoring any errors that occur during - its execution. If the execution is without error, ‘ignore-errors’ - returns the value of the last form in BODY; otherwise, it returns - ‘nil’. - - Here’s the example at the beginning of this subsection rewritten - using ‘ignore-errors’: - - (ignore-errors (delete-file filename)) - - *Note (elisp)Handling Errors::. - - -- Macro: dolist-with-progress-reporter (var count [result]) - reporter-or-message body... - This is another convenience macro that works the same way as - ‘dolist’ does, but also reports loop progress using the functions - described above. As in ‘dotimes-with-progress-reporter’, - ‘reporter-or-message’ can be a progress reporter or a string. You - can rewrite the previous example with this macro as follows: - - (dolist-with-progress-reporter (k (number-sequence 0 500)) "Collecting - some mana for Emacs..." (sit-for 0.01)) - - *Note (elisp)Progress::. - - -- Function: flatten-tree tree - This function returns a “flattened” copy of TREE, that is, a list - containing all the non-‘nil’ terminal nodes, or leaves, of the tree - of cons cells rooted at TREE. Leaves in the returned list are in - the same order as in TREE. - - (flatten-tree '(1 (2 . 3) nil (4 5 (6)) 7)) ⇒(1 2 3 4 5 6 7) - - *Note (elisp)Building Lists::. - - -- Function: xor condition1 condition2 - This function returns the boolean exclusive-or of CONDITION1 and - CONDITION2. That is, ‘xor’ returns ‘nil’ if either both arguments - are ‘nil’, or both are non-‘nil’. Otherwise, it returns the value - of that argument which is non-‘nil’. - - Note that in contrast to ‘or’, both arguments are always evaluated. - - *Note (elisp)Combining Conditions::. - - -- Variable: regexp-unmatchable - This variable contains a regexp that is guaranteed not to match any - string at all. It is particularly useful as default value for - variables that may be set to a pattern that actually matches - something. - - *Note (elisp)Regexp Functions:: - - -- Function: decoded-time-second time - Return the SECONDS field of a ‘decoded-time’ record TIME. - - -- Function: decoded-time-minute time - Return the MINUTE field of a ‘decoded-time’ record TIME. - - -- Function: decoded-time-hour time - Return the HOUR field of a ‘decoded-time’ record TIME. - - -- Function: decoded-time-day time - Return the DAY field of a ‘decoded-time’ record TIME. - - -- Function: decoded-time-month time - Return the MONTH field of a ‘decoded-time’ record TIME. - - -- Function: decoded-time-year time - Return the YEAR field of a ‘decoded-time’ record TIME. - - -- Function: decoded-time-weekday time - Return the WEEKDAY field of a ‘decoded-time’ record TIME. - - -- Function: decoded-time-dst time - Return the DST (daylight saving time indicator) field of a - ‘decoded-time’ record TIME. - - -- Function: decoded-time-zone time - Return the ZONE field of a ‘decoded-time’ record TIME. - - -- Function: package-get-version - Return the version number of the package in which this is used. - - -- Function: time-equal-p t1 t2 - This returns ‘t’ if the two time values T1 and T2 are equal. - - *Note (elisp)Time Calculations::. - - -- Function: date-days-in-month year month - Return the number of days in MONTH in YEAR. For instance, February - 2020 has 29 days. - - *Note (elisp)Time Calculations::. This function requires the - ‘time-date’ feature to be loaded. - - -- User Option: exec-path - The value of this variable is a list of directories to search for - programs to run in subprocesses. Each element is either the name - of a directory (i.e., a string), or ‘nil’, which stands for the - default directory (which is the value of ‘default-directory’). - *Note executable-find: (elisp)Locating Files, for the details of - this search. - - The value of ‘exec-path’ is used by ‘call-process’ and - ‘start-process’ when the PROGRAM argument is not an absolute file - name. - - Generally, you should not modify ‘exec-path’ directly. Instead, - ensure that your ‘PATH’ environment variable is set appropriately - before starting Emacs. Trying to modify ‘exec-path’ independently - of ‘PATH’ can lead to confusing results. - - *Note (elisp)Subprocess Creation::. - - -- Function: provided-mode-derived-p mode &rest modes - This function returns non-‘nil’ if MODE is derived from any of the - major modes given by the symbols MODES. - - -- Function: derived-mode-p &rest modes - This function returns non-‘nil’ if the current major mode is - derived from any of the major modes given by the symbols MODES. - - *Note (elisp)Derived Modes::. - -2.4.2 Prefixed Definitions --------------------------- - -These functions are prefixed with ‘compat’ prefix, and are only loaded -when ‘compat-27’ is required: - - -- Function: compat-recenter &optional count redisplay - This function scrolls the text in the selected window so that point - is displayed at a specified vertical position within the window. - It does not move point with respect to the text. - - *Note (elisp)Textual Scrolling::. - - This compatibility version adds support for the optional argument - REDISPLAY. - - -- Function: compat-lookup-key keymap key &optional accept-defaults - This function returns the definition of KEY in KEYMAP. If the - string or vector KEY is not a valid key sequence according to the - prefix keys specified in KEYMAP, it must be too long and have extra - events at the end that do not fit into a single key sequence. Then - the value is a number, the number of events at the front of KEY - that compose a complete key. - - *Note (elisp)Low-Level Key Binding::. - - This compatibility version allows for KEYMAP to be a list of - keymaps, instead of just a singular keymap. - - -- Macro: setq-local &rest pairs - PAIRS is a list of variable and value pairs. This macro creates a - buffer-local binding in the current buffer for each of the - variables, and gives them a buffer-local value. It is equivalent - to calling ‘make-local-variable’ followed by ‘setq’ for each of the - variables. The variables should be unquoted symbols. - - (setq-local var1 "value1" - var2 "value2") - - *Note (elisp)Creating Buffer-Local::. - - This compatibility version allows for more than one variable to be - set at once, as can be done with ‘setq’. - - -- Function: compat-regexp-opt strings &optional paren - This function returns an efficient regular expression that will - match any of the strings in the list STRINGS. This is useful when - you need to make matching or searching as fast as possible—for - example, for Font Lock mode. - - *Note (elisp)Regexp Functions::. - - The compatibility version of this functions handles the case where - STRINGS in an empty list. In that case, a regular expression is - generated that never matches anything (see ‘regexp-unmatchable’). - - -- Function: compat-file-size-human-readable file-size &optional flavor - space unit - Return a string with a human readable representation of FILE-SIZE. - - The optional second argument FLAVOR controls the units and the - display format. If FLAVOR is... - - • ‘si’, each kilobyte is 1000 bytes and the produced suffixes - are ‘k’, ‘M’, ‘G’, ‘T’, etc. - • ‘iec’, each kilobyte is 1024 bytes and the produced suffixes - are ‘KiB’, ‘MiB’, ‘GiB’, ‘TiB’, etc. - • ‘nil’ or omitted, each kilobyte is 1024 bytes and the produced - suffixes are ‘k’, ‘M’, ‘G’, ‘T’, etc. - - The compatibility version handles the optional third (SPACE) and - forth (UNIT) arguments. The argument SPACE can be a string that is - placed between the number and the unit. The argument UNIT - determines the unit to use. By default it will be an empty string, - unless FLAVOR is ‘iec’, in which case it will be ‘B’. - - -- Function: compat-assoc-delete-all - This function is like ‘assq-delete-all’ except that it accepts an - optional argument TEST, a predicate function to compare the keys in - ALIST. If omitted or ‘nil’, TEST defaults to ‘equal’. As - ‘assq-delete-all’, this function often modifies the original list - structure of ALIST. - - *Note (elisp)Association Lists::. - - This compatibility version handles the optional third (TESTFN) - argument. - - -- Function: compat-executable-find program &optional remote - This function searches for the executable file of the named PROGRAM - and returns the absolute file name of the executable, including its - file-name extensions, if any. It returns ‘nil’ if the file is not - found. The function searches in all the directories in - ‘exec-path’, and tries all the file-name extensions in - ‘exec-suffixes’ (*note (elisp)Subprocess Creation::). - - If REMOTE is non-‘nil’, and ‘default-directory’ is a remote - directory, PROGRAM is searched on the respective remote host. - - *Note (elisp)Locating Files::. - - This compatibility version adds support to handle the optional - second (REMOTE) argument. - - -- Function: compat-dired-get-marked-files &optional localp arg filter - distinguish-one-marked error - Return a list of file names that are _marked_ in a Dired buffer. - - This compatibility version handles the optional fifth (ERROR) - argument, which signals an error if the list of found files is - empty. ‘error’ can be a string with the error message. - -2.4.3 Missing Definitions -------------------------- - -Compat does not provide support for the following Lisp features -implemented in 27.1: - - • Bigint support. - • The function ‘time-convert’. - • All ‘iso8601-*’ functions. - • The macro ‘benchmark-progn’. - • The function ‘read-char-from-minibuffer’. - • The minor mode ‘reveal-mode’. - • The macro ‘with-suppressed-warnings’. - • Support for ‘condition-case’ to handle t. - • The functions ‘major-mode-suspend’ and ‘major-mode-restore’. - • The function ‘provided-mode-derived-p’. - • The function ‘file-system-info’. - • The more consistent treatment of NaN values. - • The function ‘ring-resize’. - • The function ‘group-name’. - • Additional ‘format-spec’ modifiers. - • Support for additional body forms for - ‘define-globalized-minor-mode’. - • The macro ‘with-connection-local-variables’ and related - functionality. - - -File: compat.info, Node: Emacs 28.1, Prev: Emacs 27.1, Up: Support - -2.5 Emacs 28.1 -============== - -2.5.1 Unprefixed Definitions ----------------------------- - -The following functions and macros implemented in 28.1, and are provided -by Compat by default: - - -- Function: string-search needle haystack &optional start-pos - Return the position of the first instance of NEEDLE in HAYSTACK, - both of which are strings. If START-POS is non-‘nil’, start - searching from that position in NEEDLE. Return ‘nil’ if no match - was found. This function only considers the characters in the - strings when doing the comparison; text properties are ignored. - Matching is always case-sensitive. - - -- Function: length= sequence length - Return non-‘nil’ if the length of SEQUENCE is equal to LENGTH. - - -- Function: length< sequence length - Return non-‘nil’ if SEQUENCE is shorter than LENGTH. This may be - more efficient than computing the length of SEQUENCE if SEQUENCE is - a long list. - - -- Function: length> sequence length - Return non-‘nil’ if SEQUENCE is longer than LENGTH. - - -- Function: file-name-concat directory &rest components - Concatenate COMPONENTS to DIRECTORY, inserting a slash before the - components if DIRECTORY or the preceding component didn’t end with - a slash. - - (file-name-concat "/tmp" "foo") ⇒ "/tmp/foo" - - A DIRECTORY or components that are ‘nil’ or the empty string are - ignored—they are filtered out first and do not affect the results - in any way. - - This is almost the same as using ‘concat’, but DIRNAME (and the - non-final components) may or may not end with slash characters, and - this function will not double those characters. - - -- Function: garbage-collect-maybe factor - Suggest to run garbage collection, if _enough_ data has been - allocated. This is determined by the positive numerical argument - FACTOR, that would proportionally increase the likelihood of - garbage collection taking place. - - This compatibility function does nothing and ignores any - suggestion. - - -- Function: string-replace from-string to-string in-string - This function replaces all occurrences of FROM-STRING with - TO-STRING in IN-STRING and returns the result. It may return one - of its arguments unchanged, a constant string or a new string. - Case is significant, and text properties are ignored. - - -- Function: always &rest arguments - This function ignores any ARGUMENTS and returns ‘t’. - - *Note (elisp)Calling Functions::. - - -- Function: insert-into-buffer to-buffer &optional start end - This is like ‘insert-buffer-substring’, but works in the opposite - direction: The text is copied from the current buffer into - TO-BUFFER. The block of text is copied to the current point in - TO-BUFFER, and point (in that buffer) is advanced to after the end - of the copied text. Is ‘start’/‘end’ is ‘nil’, the entire text in - the current buffer is copied over. - - *Note (elisp)Insertion::. - - -- Function: replace-string-in-region regexp replacement &optional - start end - This function replaces all the occurrences of REGEXP with - REPLACEMENT in the region of buffer text between START and END; - START defaults to position of point, and END defaults to the last - accessible position of the buffer. The search for REGEXP is - case-sensitive, and REPLACEMENT is inserted without changing its - letter-case. The REPLACEMENT string can use the same special - elements starting with ‘\’ as ‘replace-match’ does. The function - returns the number of replaced occurrences, or ‘nil’ if REGEXP is - not found. The function preserves the position of point. - - (replace-regexp-in-region "foo[ \t]+bar" "foobar") - *Note (elisp)Search and Replace::. - - -- Function: replace-regexp-in-string string replacement &optional - start end - This function works similarly to ‘replace-regexp-in-region’, but - searches for, and replaces, literal STRINGs instead of regular - expressions. - - *Note (elisp)Search and Replace::. - - -- Function: buffer-local-boundp variable buffer - This returns non-‘nil’ if there’s either a buffer-local binding of - VARIABLE (a symbol) in buffer BUFFER, or VARIABLE has a global - binding. - - *Note (elisp)Creating Buffer-Local::. - - -- Macro: with-existing-directory body... - This macro ensures that ‘default-directory’ is bound to an existing - directory before executing BODY. If ‘default-directory’ already - exists, that’s preferred, and otherwise some other directory is - used. This macro can be useful, for instance, when calling an - external command that requires that it’s running in a directory - that exists. The chosen directory is not guaranteed to be - writable. - - *Note (elisp)Testing Accessibility::. - - -- Macro: dlet (bindings...) forms... - This special form is like ‘let’, but it binds all variables - dynamically. This is rarely useful—you usually want to bind normal - variables lexically, and special variables (i.e., variables that - are defined with ‘defvar’) dynamically, and this is what ‘let’ - does. - - ‘dlet’ can be useful when interfacing with old code that assumes - that certain variables are dynamically bound (*note (elisp)Dynamic - Binding::), but it’s impractical to ‘defvar’ these variables. - ‘dlet’ will temporarily make the bound variables special, execute - the forms, and then make the variables non-special again. - - *Note (elisp)Local Variables::. - - -- Function: ensure-list object - This function returns OBJECT as a list. If OBJECT is already a - list, the function returns it; otherwise, the function returns a - one-element list containing OBJECT. - - This is usually useful if you have a variable that may or may not - be a list, and you can then say, for instance: - - (dolist (elem (ensure-list foo)) - (princ elem)) - - *Note (elisp)Building Lists::. - - -- Function: string-clean-whitespace string - Clean up the whitespace in STRING by collapsing stretches of - whitespace to a single space character, as well as removing all - whitespace from the start and the end of STRING. - - *Note (elisp)Creating Strings::. - - -- Function: string-fill string length - Attempt to Word-wrap STRING so that no lines are longer than - LENGTH. Filling is done on whitespace boundaries only. If there - are individual words that are longer than LENGTH, these will not be - shortened. - - *Note (elisp)Creating Strings::. - - -- Function: string-lines string &optional omit-nulls keep-newlines - Split STRING into a list of strings on newline boundaries. If the - optional argument OMIT-NULLS is non-‘nil’, remove empty lines from - the results. If the optional argument KEEP-NEWLINES is non-‘nil’, - don’t remove the trailing newlines from the result strings. - - *Note (elisp)Creating Strings::. - - -- Function: string-pad string length &optional padding start - Pad STRING to be of the given LENGTH using PADDING as the padding - character. PADDING defaults to the space character. If STRING is - longer than LENGTH, no padding is done. If START is ‘nil’ or - omitted, the padding is appended to the characters of STRING, and - if it’s non-‘nil’, the padding is prepended to STRING’s characters. - - *Note (elisp)Creating Strings::. - - -- Function: string-chop-newline string - Remove the final newline, if any, from STRING. - - *Note (elisp)Creating Strings::. - - -- Macro: named-let name bindings &rest body - This special form is a looping construct inspired from the Scheme - language. It is similar to ‘let’: It binds the variables in - BINDINGS, and then evaluates BODY. However, ‘named-let’ also binds - NAME to a local function whose formal arguments are the variables - in BINDINGS and whose body is BODY. This allows BODY to call - itself recursively by calling NAME, where the arguments passed to - NAME are used as the new values of the bound variables in the - recursive invocation. - - Recursive calls to NAME that occur in _tail positions_ in BODY are - guaranteed to be optimized as _tail calls_, which means that they - will not consume any additional stack space no matter how deeply - the recursion runs. Such recursive calls will effectively jump to - the top of the loop with new values for the variables. - - *Note (elisp)Local Variables::. - - -- Function: file-name-with-extension filename extension - This function returns FILENAME with its extension set to EXTENSION. - A single leading dot in the EXTENSION will be stripped if there is - one. For example: - - (file-name-with-extension "file" "el") - ⇒ "file.el" - (file-name-with-extension "file" ".el") - ⇒ "file.el" - (file-name-with-extension "file.c" "el") - ⇒ "file.el" - - Note that this function will error if FILENAME or EXTENSION are - empty, or if the FILENAME is shaped like a directory (i.e., if - ‘directory-name-p’ returns non-‘nil’). - - *Note File Name Components: (elisp)File Name Components. - - -- Function: directory-empty-p directory - This utility function returns ‘t’ if given DIRECTORY is an - accessible directory and it does not contain any files, i.e., is an - empty directory. It will ignore ‘.’ and ‘..’ on systems that - return them as files in a directory. - - Symbolic links to directories count as directories. See - FILE-SYMLINK-P to distinguish symlinks. - - *Note (elisp)Contents of Directories::. - - -- Function: format-prompt prompt default &rest format-args - Format PROMPT with default value DEFAULT according to the - ‘minibuffer-default-prompt-format’ variable. - - ‘minibuffer-default-prompt-format’ is a format string (defaulting - to ‘" (default %s)"’ that says how the “default” bit in prompts - like ‘"Local filename (default somefile): "’ are to be formatted. - - To allow the users to customize how this is displayed, code that - prompts the user for a value (and has a default) should look - something along the lines of this code snippet: - - (read-file-name - (format-prompt "Local filename" file) - nil file) - - If FORMAT-ARGS is ‘nil’, PROMPT is used as a literal string. If - FORMAT-ARGS is non-‘nil’, PROMPT is used as a format control - string, and PROMPT and FORMAT-ARGS are passed to ‘format’ (*note - (elisp)Formatting Strings::). - - ‘minibuffer-default-prompt-format’ can be ‘""’, in which case no - default values are displayed. - - If DEFAULT is ‘nil’, there is no default value, and therefore no - “default value” string is included in the result value. If DEFAULT - is a non-‘nil’ list, the first element of the list is used in the - prompt. - - *Note (elisp)Text from Minibuffer::. - - -- Function: thing-at-mouse event thing &optional no-properties - Mouse-EVENT equivalent of ‘thing-at-point’. THING can be ‘symbol’, - ‘list’, ‘sexp’, ‘filename’, ‘url’, ... among other things. - - When NO-PROPERTIES has a non-‘nil’ value, any text properties that - might have been present in the buffer are stripped away. - - -- Function: macroexp-file-name - Return the name of the file in which the code is currently being - evaluated, or ‘nil’ if it cannot be determined. - - -- Macro: with-environment-variables variables body... - This macro sets the environment variables according to VARIABLES - temporarily when executing BODY. The previous values are restored - when the form finishes. The argument VARIABLES should be a list of - pairs of strings of the form ‘(VAR VALUE)’, where VAR is the name - of the environment variable and VALUE is that variable’s value. - - (with-environment-variables (("LANG" "C") - ("LANGUAGE" "en_US:en")) - (call-process "ls" nil t)) - - *Note System Environment: (elisp)System Environment. - - -- Function: button-buttonize string callback &optional data help-echo - Return a button with STRING as its label. When interacted on, the - one-argument function in CALLBACK is called and DATA (or ‘nil’ is - not present) will be passed as the argument. - - If non-‘nil’, the argument HELP-ECHO will be used to set the - ‘help-echo’ text property. - - -- Function: make-directory-autoloads dir output-file - Parse and search the directory DIR for autoload definitions, and - write the processed results to the file OUTPUT-FILE. - - -- Function: color-values-from-color-spec spec - Convert the textual color specification SPEC to a color triple - ‘(RED GREEN blue)’. Each of RED, GREEN and ‘blue’ is a integer - value between 0 and 65535. - - The specification SPEC can be one of the following - • ‘#RGB’, where R, G and B are hex numbers of equal length, 1-4 - digits each. - • ‘rgb:R/G/B’, where R, G, and B are hex numbers, 1-4 digits - each. - • ‘rgbi:R/G/B’, where R, G and B are floating-point numbers in - [0,1]. - - -- Function: file-modes-number-to-symbolic modes - This function converts a numeric file mode specification in MODES - into the equivalent symbolic form. - - *Note Changing Files: (elisp)Changing Files. - - -- Function: file-backup-file-names filename - This function returns a list of all the backup file names for - FILENAME, or ‘nil’ if there are none. The files are sorted by - modification time, descending, so that the most recent files are - first. - - *Note (elisp)Backup Names::. - - -- Function: make-lock-file-name filename - Return a string containing a lock file name for FILENAME, obeying - ‘lock-file-name-transforms’. - - -- Function: null-device - Return the path to the null device (usually something like - ‘/dev/null’) on the current system. - - -- Function: decoded-time-period time - Interpret TIME as a period and return its length in seconds. For - computational purposes, years are 365 days long and months are 30 - days long. - - -- Function: subr-primitive-p object - Return ‘t’ if OBJECT is a primitive, built-in function. On systems - with native compilation ‘subrp’ does not distinguish between - built-in functions and functions that have been compiled. If - native compilation is not avaliable, this function behaves - identically to ‘subrp’. - - -- Function: file-name-absolute-p filename - This function returns ‘t’ if file FILENAME is an absolute file - name, ‘nil’ otherwise. A file name is considered to be absolute if - its first component is ‘~’, or is ‘~USER’ where USER is a valid - login name. In the following examples, assume that there is a user - named ‘rms’ but no user named ‘nosuchuser’. - - (file-name-absolute-p "~rms/foo") - ⇒ t - (file-name-absolute-p "~nosuchuser/foo") - ⇒ nil - (file-name-absolute-p "rms/foo") - ⇒ nil - (file-name-absolute-p "/user/rms/foo") - ⇒ t - - *Note (elisp)Absolute and Relative File Names::. - -2.5.2 Prefixed Definitions --------------------------- - -These functions are prefixed with ‘compat’ prefix, and are only loaded -when ‘compat-28’ is required: - - -- Function: compat-unlock-buffer - This function unlocks the file being visited in the current buffer, - if the buffer is modified. If the buffer is not modified, then the - file should not be locked, so this function does nothing. It also - does nothing if the current buffer is not visiting a file, or is - not locked. This function handles file system errors by calling - ‘display-warning’ and otherwise ignores the error. - - *Note (elisp)File Locks::. - - This compatibility versions catches the ‘file-error’ condition, - issuing a warning instead of propagating on the error. - - -- Function: compat-string-width string &optional from to - This function returns the width in columns of the string STRING, if - it were displayed in the current buffer and the selected window. - Optional arguments FROM and TO specify the substring of STRING to - consider, and are interpreted as in ‘substring’ (*note - (elisp)Creating Strings::). - - The return value is an approximation: it only considers the values - returned by ‘char-width’ for the constituent characters, always - takes a tab character as taking ‘tab-width’ columns, ignores - display properties and fonts, etc. - - *Note (elisp)Size of Displayed Text::. - - This compatibility version handles the optional arguments FROM and - TO. - - -- Function: compat-json-serialize - *Note Emacs 27.1::. - - This compatibility version handles primitive, top-level JSON values - (numbers, strings, booleans). - - -- Function: compat-json-insert - *Note Emacs 27.1::. - - This compatibility version handles primitive, top-level JSON values - (numbers, strings, booleans). - - -- Function: compat-json-parse-string - *Note Emacs 27.1::. - - This compatibility version handles primitive, top-level JSON values - (numbers, strings, booleans). - - -- Function: compat-json-parse-buffer - *Note Emacs 27.1::. - - This compatibility version handles primitive, top-level JSON values - (numbers, strings, booleans). - - -- Function: compat-count-windows - Return the number of live windows on the selected frame. - - The optional argument MINIBUF specifies whether the minibuffer - window is included in the count. - - If ALL-FRAMES is non-‘nil’, count the windows in all frames instead - just the selected frame. - - This compatibility version handles the optional argument - ALL-FRAMES. - -2.5.3 Missing Definitions -------------------------- - -Compat does not provide support for the following Lisp features -implemented in 28.1: - - • Support for ‘interactive’ or ‘declare’ to list applicable modes. - • Support for ‘:interactive’ argument to ‘define-minor-mode’ and - ‘define-derived-mode’. - • Support for ‘:predicate’ argument to - ‘define-globalized-minor-mode’. - • "Success handler" for ‘condition-case’. - • The function ‘benchmark-call’. - • Support for the ‘natnum’ defcustom type. - • The function ‘macroexp-compiling-p’. - • The function ‘macroexp-warn-and-return’. - • Additional Edebug keywords. - • Shorthand support. - • The function ‘custom-add-choice’. - • The function ‘decoded-time-period’. - • The function ‘dom-print’. - • The function ‘dom-remove-attribute’. - • The function ‘dns-query-asynchronous’. - • The function ‘get-locale-names’. - • The function ‘json-avaliable-p’. - • The function ‘mail-header-parse-addresses-lax’. - • The function ‘mail-header-parse-address-lax’. - • The function ‘make-separator-line’. - • The function ‘num-processors’. - • The function ‘object-intervals’. - • The function ‘process-lines-ignore-status’. - • The function ‘require-theme’. - • The function ‘syntax-class-to-char’. - • The function ‘path-separator’. - - -File: compat.info, Node: Development, Next: Function Index, Prev: Support, Up: Top - -3 Development -************* - -Compat is developed on SourceHut (https://sr.ht/~pkal/compat). A -restricted GitHub mirror (https://github.com/phikal/compat.el) is also -maintained. - - Patches and comments can be sent to the development mailing list -(https://lists.sr.ht/~pkal/compat-devel) (~pkal/compat-devel@lists.sr.ht -<~pkal/compat-devel@lists.sr.ht>). Bug reports are best sent to the -issue tracker (https://todo.sr.ht/~pkal/compat) (~pkal/compat@todo.sr.ht -<~pkal/compat@todo.sr.ht>). The GitHub mirror can also be used to -submit patches. These may include issues in the compatibility code, -missing definitions or performance issues. - - Please note that as a GNU ELPA package, Compat requires contributors -to have signed the FSF copyright assignment -(https://www.gnu.org/software/emacs/manual/html_node/emacs/Copyright-Assignment.html), -before any non-trivial contribution (roughly 15 lines of code) can be -applied. - - -File: compat.info, Node: Function Index, Next: Variable Index, Prev: Development, Up: Top - -Appendix A Function Index -************************* - -[index] -* Menu: - -* alist-get: Emacs 25.1. (line 50) -* always: Emacs 28.1. (line 61) -* and-let*: Emacs 26.1. (line 99) -* bool-vector: Emacs 25.1. (line 166) -* bool-vector-count-consecutive: Emacs 24.4. (line 118) -* bool-vector-count-population: Emacs 24.4. (line 125) -* bool-vector-exclusive-or: Emacs 24.4. (line 76) -* bool-vector-intersection: Emacs 24.4. (line 90) -* bool-vector-not: Emacs 24.4. (line 104) -* bool-vector-set-difference: Emacs 24.4. (line 97) -* bool-vector-subsetp: Emacs 24.4. (line 111) -* bool-vector-union: Emacs 24.4. (line 83) -* buffer-local-boundp: Emacs 28.1. (line 99) -* button-buttonize: Emacs 28.1. (line 285) -* color-values-from-color-spec: Emacs 28.1. (line 297) -* compat-<: Emacs 24.4. (line 175) -* compat-<=: Emacs 24.4. (line 185) -* compat-=: Emacs 24.4. (line 170) -* compat->: Emacs 24.4. (line 180) -* compat->=: Emacs 24.4. (line 190) -* compat-alist-get: Emacs 26.1. (line 284) -* compat-assoc: Emacs 26.1. (line 256) -* compat-assoc-delete-all: Emacs 27.1. (line 305) -* compat-count-windows: Emacs 28.1. (line 422) -* compat-dired-get-marked-files: Emacs 27.1. (line 333) -* compat-executable-find: Emacs 27.1. (line 317) -* compat-file-size-human-readable: Emacs 27.1. (line 285) -* compat-json-insert: Emacs 28.1. (line 404) -* compat-json-parse-buffer: Emacs 28.1. (line 416) -* compat-json-parse-string: Emacs 28.1. (line 410) -* compat-json-serialize: Emacs 28.1. (line 398) -* compat-line-number-at-pos: Emacs 26.1. (line 270) -* compat-lookup-key: Emacs 27.1. (line 245) -* compat-recenter: Emacs 27.1. (line 235) -* compat-regexp-opt: Emacs 27.1. (line 273) -* compat-sort: Emacs 25.1. (line 178) -* compat-split-string: Emacs 24.4. (line 199) -* compat-string-trim: Emacs 26.1. (line 314) -* compat-string-trim-left: Emacs 26.1. (line 298) -* compat-string-trim-right: Emacs 26.1. (line 306) -* compat-string-width: Emacs 28.1. (line 381) -* compat-unlock-buffer: Emacs 28.1. (line 368) -* completion-table-with-cache: Emacs 24.4. (line 130) -* cXXXr: Emacs 26.1. (line 47) -* cXXXXr: Emacs 26.1. (line 48) -* date-days-in-month: Emacs 27.1. (line 193) -* decoded-time-day: Emacs 27.1. (line 166) -* decoded-time-dst: Emacs 27.1. (line 178) -* decoded-time-hour: Emacs 27.1. (line 163) -* decoded-time-minute: Emacs 27.1. (line 160) -* decoded-time-month: Emacs 27.1. (line 169) -* decoded-time-period: Emacs 28.1. (line 332) -* decoded-time-second: Emacs 27.1. (line 157) -* decoded-time-weekday: Emacs 27.1. (line 175) -* decoded-time-year: Emacs 27.1. (line 172) -* decoded-time-zone: Emacs 27.1. (line 182) -* define-error: Emacs 24.4. (line 65) -* delete-consecutive-dups: Emacs 24.4. (line 60) -* derived-mode-p: Emacs 27.1. (line 223) -* directory-empty-p: Emacs 28.1. (line 218) -* directory-files-recursively: Emacs 25.1. (line 139) -* directory-name-p: Emacs 25.1. (line 24) -* dlet: Emacs 28.1. (line 117) -* dolist-with-progress-reporter: Emacs 27.1. (line 116) -* ensure-list: Emacs 28.1. (line 132) -* face-spec-set: Emacs 24.4. (line 139) -* file-attribute-access-time: Emacs 26.1. (line 201) -* file-attribute-collect: Emacs 26.1. (line 238) -* file-attribute-device-number: Emacs 26.1. (line 233) -* file-attribute-group-id: Emacs 26.1. (line 196) -* file-attribute-inode-number: Emacs 26.1. (line 228) -* file-attribute-link-number: Emacs 26.1. (line 186) -* file-attribute-modes: Emacs 26.1. (line 223) -* file-attribute-modification-time: Emacs 26.1. (line 206) -* file-attribute-size: Emacs 26.1. (line 218) -* file-attribute-status-change-time: Emacs 26.1. (line 212) -* file-attribute-type: Emacs 26.1. (line 181) -* file-attribute-user-id: Emacs 26.1. (line 191) -* file-backup-file-names: Emacs 28.1. (line 316) -* file-local-name: Emacs 26.1. (line 108) -* file-modes-number-to-symbolic: Emacs 28.1. (line 310) -* file-name-absolute-p: Emacs 28.1. (line 344) -* file-name-concat: Emacs 28.1. (line 31) -* file-name-quote: Emacs 26.1. (line 133) -* file-name-quoted-p: Emacs 26.1. (line 126) -* file-name-with-extension: Emacs 28.1. (line 200) -* flatten-tree: Emacs 27.1. (line 129) -* format-message: Emacs 25.1. (line 12) -* format-prompt: Emacs 28.1. (line 229) -* func-arity: Emacs 26.1. (line 12) -* garbage-collect-maybe: Emacs 28.1. (line 46) -* gensym: Emacs 26.1. (line 51) -* if-let: Emacs 25.1. (line 67) -* if-let*: Emacs 26.1. (line 90) -* ignore-errors: Emacs 27.1. (line 103) -* image-property: Emacs 26.1. (line 175) -* insert-into-buffer: Emacs 28.1. (line 66) -* json-insert: Emacs 27.1. (line 57) -* json-parse-buffer: Emacs 27.1. (line 94) -* json-parse-string: Emacs 27.1. (line 64) -* json-serialize: Emacs 27.1. (line 42) -* length<: Emacs 28.1. (line 23) -* length=: Emacs 28.1. (line 20) -* length>: Emacs 28.1. (line 28) -* macroexp-file-name: Emacs 28.1. (line 267) -* macroexpand-1: Emacs 25.1. (line 132) -* macrop: Emacs 24.4. (line 47) -* make-directory-autoloads: Emacs 28.1. (line 293) -* make-lock-file-name: Emacs 28.1. (line 324) -* make-nearby-temp-file: Emacs 26.1. (line 61) -* mapcan: Emacs 26.1. (line 34) -* named-let: Emacs 28.1. (line 182) -* null-device: Emacs 28.1. (line 328) -* package-get-version: Emacs 27.1. (line 185) -* proper-list-p: Emacs 27.1. (line 12) -* provided-mode-derived-p: Emacs 27.1. (line 219) -* read-multiple-choice: Emacs 26.1. (line 151) -* replace-regexp-in-string: Emacs 28.1. (line 91) -* replace-string-in-region: Emacs 28.1. (line 76) -* setq-local: Emacs 27.1. (line 258) -* special-form-p: Emacs 24.4. (line 41) -* string-chop-newline: Emacs 28.1. (line 177) -* string-clean-whitespace: Emacs 28.1. (line 145) -* string-distance: Emacs 27.1. (line 22) -* string-fill: Emacs 28.1. (line 152) -* string-greaterp: Emacs 25.1. (line 32) -* string-lines: Emacs 28.1. (line 160) -* string-pad: Emacs 28.1. (line 168) -* string-replace: Emacs 28.1. (line 55) -* string-search: Emacs 28.1. (line 12) -* string-suffix-p: Emacs 24.4. (line 53) -* subr-primitive-p: Emacs 28.1. (line 337) -* temporary-file-directory: Emacs 26.1. (line 78) -* thing-at-mouse: Emacs 28.1. (line 260) -* thread-first: Emacs 25.1. (line 90) -* thread-last: Emacs 25.1. (line 111) -* time-equal-p: Emacs 27.1. (line 188) -* when-let: Emacs 25.1. (line 85) -* when-let*: Emacs 26.1. (line 94) -* with-environment-variables: Emacs 28.1. (line 271) -* with-eval-after-load: Emacs 24.4. (line 12) -* with-existing-directory: Emacs 28.1. (line 106) -* with-file-modes: Emacs 25.1. (line 39) -* xor: Emacs 27.1. (line 139) - - -File: compat.info, Node: Variable Index, Prev: Function Index, Up: Top - -Appendix B Variable Index -************************* - -[index] -* Menu: - -* exec-path: Emacs 27.1. (line 200) -* gensym-counter: Emacs 26.1. (line 58) -* mounted-file-systems: Emacs 26.1. (line 74) -* regexp-unmatchable: Emacs 27.1. (line 149) - - - -Tag Table: -Node: Top821 -Node: Introduction2274 -Node: Overview2433 -Node: Usage3656 -Node: Additional libraries4663 -Node: Intentions5118 -Node: Support6728 -Node: Emacs 24.47310 -Node: Emacs 25.117364 -Node: Emacs 26.126321 -Node: Emacs 27.140419 -Node: Emacs 28.155775 -Node: Development75469 -Node: Function Index76484 -Node: Variable Index87168 - -End Tag Table - - -Local Variables: -coding: utf-8 -End: diff --git a/elpa/compat-29.1.3.4.signed b/elpa/compat-29.1.3.4.signed new file mode 100644 index 00000000..6475f6a4 --- /dev/null +++ b/elpa/compat-29.1.3.4.signed @@ -0,0 +1 @@ +Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) (trust undefined) created at 2023-02-11T23:05:03+0100 using RSA \ No newline at end of file diff --git a/elpa/compat-29.1.3.4/NEWS.org b/elpa/compat-29.1.3.4/NEWS.org new file mode 100644 index 00000000..0a54477a --- /dev/null +++ b/elpa/compat-29.1.3.4/NEWS.org @@ -0,0 +1,268 @@ +#+title: compat.el - Changelog + +* Release of "Compat" Version 29.1.3.4 + +- Ensure that ~seq~ is required properly both at compile time and runtime, such + that compilation of downstream packages works even if Compat itself is not + compiled. Magit uses a complex continuous integration system, where Magit is + compiled and tested, while the Compat dependency is not compiled. +- compat-28: Add ~process-lines-handling-status~ and ~process-lines-ignore-status~. + +(Release <2023-02-11 Sat>) + +* Release of "Compat" Version 29.1.3.3 + +- compat-27: Add ~with-suppressed-warnings~. +- compat-29: Add ~cl-with-gensyms~ and ~cl-once-only~. +- compat-29: Load ~seq~, which is preloaded on Emacs 29. + +(Release <2023-02-08 Wed>) + +* Release of "Compat" Version 29.1.3.2 + +- compat-26: Add ~make-temp-file~ with optional argument TEXT. +- compat-27: Mark ~compat-call dired-get-marked-files~ as obsolete. See the + section limitations in the Compat manual. +- compat-29: Add ~funcall-with-delayed-message~ and ~with-delayed-message~. +- compat-29: Add ~ert-with-temp-file~ and ~ert-with-temp-directory~. +- compat-29: Add ~set-transient-map~ with optional arguments MESSAGE and TIMEOUT. + +(Release <2023-02-01 Wed>) + +* Release of "Compat" Version 29.1.3.1 + +- Fix regression, which prevented loading Compat in interpreted mode. We ensure + that Compat works interpreted and byte compiled by running the entire test + suite twice in the CI. +- compat-27: Add ~file-name-unquote~. +- compat-28: Add ~mark-thing-at-mouse~. +- compat-29: Replace ~string-lines~ with version from Emacs 29, support optional + KEEP-NEWLINES argument. + +(Release <2023-01-25 Wed>) + +* Release of "Compat" Version 29.1.3.0 + +- compat-25: Add ~hash-table-empty-p~. +- compat-25: Add ~macroexp-parse-body~ and ~macroexp-quote~. +- compat-25: Add ~region-noncontiguous-p~. +- compat-25: Add ~save-mark-and-excursion~. +- compat-26: Add ~read-answer~. +- compat-26: Add ~region-bounds~. +- compat-27: Add ~date-ordinal-to-time~. +- compat-27: Add ~file-size-human-readable-iec~. +- compat-27: Add ~major-mode-suspend~ and ~major-mode-restore~. +- compat-27: Add ~make-decoded-time~. +- compat-27: Add ~minibuffer-history-value~. +- compat-27: Add ~read-char-from-minibuffer~. +- compat-27: Add ~ring-resize~. +- compat-28: Add ~color-dark-p~. +- compat-28: Add ~directory-files-and-attributes~ with COUNT argument. +- compat-28: Add ~text-quoting-style~. +- compat-28: Add ~with-window-non-dedicated~. +- compat-29: Add ~buffer-local-set-state~ and ~buffer-local-restore-state~. +- compat-29: Add ~compiled-function-p~. +- compat-29: Add ~count-sentences~. +- compat-29: Add ~delete-line~. +- compat-29: Add ~get-scratch-buffer-create~. +- compat-29: Add ~list-of-strings-p~. +- compat-29: Add ~plist-get~ generalized variable. +- compat-29: Add ~plistp~. +- compat-29: Add ~read-multiple-choice~ with LONG-FORM argument. +- compat-29: Add ~readablep~. +- compat-29: Add ~substitute-quotes~. +- compat-29: Add ~use-region-beginning~, ~use-region-end~ and ~use-region-noncontiguous-p~. +- compat-29: Add ~with-narrowing~. + +(Release <2023-01-22 Sun>) + +* Release of "Compat" Version 29.1.2.0 + +- All compatibility functions are covered by tests! +- Add links from compatibility definitions to tests. +- BREAKING: Drop JSON parsing support (libjansson API, unused downstream). +- BREAKING: Drop ~null-device~ (unused downstream). +- BREAKING: Drop ~unlock-buffer~ (unused downstream). +- compat-26: Add ~buffer-hash~. +- compat-27: Add ~fixnump~ and ~bignump~. +- compat-27: Add ~with-minibuffer-selected-window~. +- compat-27: Add generalized variables for ~decoded-time-*~. +- compat-28: Add ~macroexp-warn-and-return~. +- compat-28: Add ~subr-native-elisp-p~. +- compat-28: Add ~bounds-of-thing-at-mouse~. +- compat-29: Add ~with-buffer-unmodified-if-unchanged~. +- compat-29: Fix and test ~define-key~ with REMOVE argument. + +(Release <2023-01-16 Mon>) + +* Release of "Compat" Version 29.1.1.1 + +- Add tests, 167 out of 203 definitions tested (82%). +- compat-25: Improve algorithmic complexity of ~sort~. +- compat-28: Add ~make-separator-line~. +- compat-29: Minor fixes to ~keymap-*~ functions. +- compat-29: Add ~with-memoization~. +- compat-29: Add ~buttonize~ and ~buttonize-region~. + +(Release <2023-01-14 Sat>) + +* Release of "Compat" Version 29.1.1.0 + +- The macros in ~compat-macs.el~ have been rewritten and simplified. The + refactoring allows to further refine the criteria under which compatibility + aliases, functions, macros and variables are installed. +- Remove deprecated, prefixed compatibility functions. +- Remove deprecated features ~compat-help~, ~compat-font-lock~ and ~compat-24~. +- Compat uses runtime checks (~boundp~, ~fboundp~) to ensure that existing + definitions are never overridden, when Compat is loaded on a newer Emacs than + it was compiled on. +- Compat compiles without byte compilation warnings on all supported Emacs + versions. Warnings are treated as errors in the test suite. +- Compat takes great care to remove unneeded definitions at compile time. On + recent Emacs 29 the byte compiled files are empty and not loaded, such that + Compat does not any cost to the Emacs process. +- compat-26: Fix and test ~image-property~ setter. +- compat-26: Fix and test ~read-multiple-choice~. +- compat-28: Fix and test ~with-existing-directory~. +- compat-28: Drop obsolete function ~make-directory-autoloads~. +- compat-29: Drop broken functions ~string-pixel-width~ and + ~buffer-text-pixel-size~. These functions had poor performance which lead to a + downstream issue in the doom-modeline package. If a more efficient solution is + possible, the function will be added back. +- compat-29: Drop broken function ~string-limit~. +- compat-29: Drop broken macro ~with-buffer-unmodified-if-unchanged~, which relied + on ~buffer-hash~ which does not exist on all supported Emacs versions. +- compat-29: Add ~pos-bol~ and ~pos-eol~. + +(Release <2023-01-07 Sat>) + +* Release of "Compat" Version 29.1.0.1 + +- Add multiple new tests for existing APIs. +- Fix bugs in compatibility functions: ~setq-local~, ~proper-list-p, prop-match-p~, + ~file-name-concat~, ~replace-regexp-in-region~, ~replace-string-in-region~. +- Add new Emacs 29 APIs. Some of them are still untested and may change. If you + intend to use an Emacs 29 API please be careful and if possible contribute + test cases. All untested functions are marked in the Compat code. Over time + tests for all functions will be added gradually. +- Add the macros ~compat-call~ and ~compat-function~ to call compatibility + functions. Since Compat avoids overwriting already existing functions, we must + define separate compatibility function definitions for functions which changed + their calling convention or behavior. These compatibility definitions can be + looked up using ~compat-function~ and called with ~compat-call~. For example ~assoc~ + can be called with a ~TESTFN~ since Emacs 26. In Emacs 25 and older the calling + convention was ~(assoc KEY ALIST)~. In order to use the new calling convention + you can use ~(compat-call assoc KEY ALIST TESTFN)~. +- Deprecate all ~compat-*~ prefixed functions. Instead use the aforementioned + ~compat-call~ or ~compat-function~ macros. +- Deprecate ~compat-help.el~ and ~compat-font-lock.el.~ +- Development moved to GitHub. +- BREAKING: Drop broken function ~func-arity~. Using ~func-arity~ is generally + discouraged and the function is hard to implement properly due to all the + various function types. There it is unlikely that the function will get + reintroduced in Compat. +- BREAKING: Drop broken function ~directory-files-recursively~. In case you need + this function, a patch including tests is welcome. +- BREAKING: Drop support for Emacs 24.3. Emacs 24.4 is required now. In case you + still need Emacs 24.3 support, you can rely on Compat 28.1.2.2. + +(Release <2023-01-05 Thu>) + +* Release of "Compat" Version 28.1.2.2 + +This is a minor release that hopes to address [[compat:7]]. + +(Release <2022-08-25 Thu>) + +* Release of "Compat" Version 28.1.2.1 + +This is a minor release adding the following changes: + +- Add =derived-mode-p= defined in Emacs 27 +- Add =provided-mode-derived-p= defined in Emacs 27 +- Add =read-multiple-choice= defined in Emacs 26 +- Add =file-name-absolute-p= defined in Emacs 28 + +The only other notable change is that the manual has been rewritten to +include much more documentation that had been the case previously. + +(Release <2022-08-24 Wed>) + +* Release of "Compat" Version 28.1.2.0 + +The main change of this release has been the major simplification of +Compat's initialisation system, improving the situation around issues +people had been reporting ([[compat:4]], once again) with unconventional +or unpopular packaging systems. + +In addition to this, the following functional changes have been made: + +- Fix =format-prompt= of an empty string as "default" argument +- Add =decoded-time-period= defined in Emacs 28 +- Add =subr-primitive-p= defined in Emacs 28 + +Minor improvements to manual are also part of this release. + +(Release <2022-07-18 Mon>) + +* Release of "Compat" Version 28.1.1.3 + +This release just contains a hot-fix for an issue introduced in the +last version, where compat.el raises an error during byte compilation. +See [[compat:4]]. + +(Release <2022-06-19 Sun>) + +* Release of "Compat" Version 28.1.1.2 + +Two main changes have necessitated a new patch release: + +1. Fix issues related to the loading of compat when uncompiled. See + [[https://lists.sr.ht/~pkal/compat-devel/%3C20220530191000.2183047-1-jonas%40bernoul.li%3E][this thread]] for more details on the problem. +2. Fix issues related to the loading of compat on old pre-releases + (think of 28.0.50). See [[https://lists.sr.ht/~pkal/compat-devel/%3Cf8635d7d-e233-448f-b325-9e850363241c%40www.fastmail.com%3E][this thread]] for more details on the + problem. + +(Released <2022-06-22 Wed>) + +* Release of "Compat" Version 28.1.1.1 + +This is a minor release fixing a bug in =json-serialize=, that could +cause unintended side-effects, not related to packages using Compat +directly (see [[compat:2]]). + +(Released <2022-05-05 Thu>) + +* Release of "Compat" Version 28.1.1.0 + +This release mostly fixes a number of smaller bugs that were not +identified as of 28.1.0.0. Nevertheless these warrent a version bump, +as some of these changes a functional. These include: + +- The addition of the =file-attribute-*= accessor functions. +- The addition of =file-attribute-collect=. +- Improvements to the Texinfo manual (via Jonas Bernoulli's recent + work on =ox-texinfo=). For the time being, the Texinfo file is + maintained in the repository itself, next to the =MANUAL= file. + This might change in the future. +- Adding a prefix to =string-trim=, =string-trim-left= and + =string-trim-right= (i.e. now =compat-string-trim=, + =compat-string-trim-left= and =compat-string-trim-right=) +- Improving the version inference used in the =compat-*= macros. + This improves the compile-time optimisation that strips away + functions that are known to be defined for a specific version. +- The addition of generalised variable (=setf=) support for + =compat-alist-get=. +- The addition of =image-property= and generalised variable support + for =image-property=. +- The addition of the function =compat-executable-find=. +- The addition of the function =compat-dired-get-marked-files=. +- The addition of the function =exec-path=. +- The addition of the function =make-lock-file-name=. +- The addition of the function =null-device=. +- The addition of the function =time-equal-p=. +- The addition of the function =date-days-in-month=. +- Handling out-of-directory byte compilation better. +- Fixing the usage and edge-cases of =and-let*=. + +(Released <2022-04-22 Fri>) diff --git a/elpa/compat-29.1.3.4/compat-25.el b/elpa/compat-29.1.3.4/compat-25.el new file mode 100644 index 00000000..f6ad2ad4 --- /dev/null +++ b/elpa/compat-29.1.3.4/compat-25.el @@ -0,0 +1,271 @@ +;;; compat-25.el --- Functionality added in Emacs 25.1 -*- lexical-binding: t; -*- + +;; Copyright (C) 2021-2023 Free Software Foundation, Inc. + +;; 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 . + +;;; Commentary: + +;; Functionality added in Emacs 25.1, needed by older Emacs versions. + +;;; Code: + +(eval-when-compile (require 'compat-macs)) + +(compat-version "25.1") + +;;;; Defined in alloc.c + +(compat-defun bool-vector (&rest objects) ;; + "Return a new bool-vector with specified arguments as elements. +Allows any number of arguments, including zero. +usage: (bool-vector &rest OBJECTS)" + (let ((vec (make-bool-vector (length objects) nil)) + (i 0)) + (while objects + (when (car objects) + (aset vec i t)) + (setq objects (cdr objects) + i (1+ i))) + vec)) + +;;;; Defined in fns.c + +(compat-defun sort (seq predicate) ;; + "Handle vector SEQ." + :extended t + (cond + ((listp seq) + (sort seq predicate)) + ((vectorp seq) + (let* ((list (sort (append seq nil) predicate)) + (p list) (i 0)) + (while p + (aset seq i (car p)) + (setq i (1+ i) p (cdr p))) + (apply #'vector list))) + ((signal 'wrong-type-argument 'list-or-vector-p)))) + +;;;; Defined in editfns.c + +(compat-defalias format-message format) ;; + +;;;; Defined in fileio.c + +(compat-defun directory-name-p (name) ;; + "Return non-nil if NAME ends with a directory separator character." + (eq (eval-when-compile + (if (memq system-type '(cygwin windows-nt ms-dos)) + ?\\ ?/)) + (aref name (1- (length name))))) + +;;;; Defined in doc.c + +(compat-defvar text-quoting-style nil ;; + "Style to use for single quotes in help and messages. + +The value of this variable determines substitution of grave accents +and apostrophes in help output (but not for display of Info +manuals) and in functions like `message' and `format-message', but not +in `format'. + +The value should be one of these symbols: + `curve': quote with curved single quotes ‘like this’. + `straight': quote with straight apostrophes \\='like this\\='. + `grave': quote with grave accent and apostrophe \\=`like this\\='; + i.e., do not alter the original quote marks. + nil: like `curve' if curved single quotes are displayable, + and like `grave' otherwise. This is the default. + +You should never read the value of this variable directly from a Lisp +program. Use the function `text-quoting-style' instead, as that will +compute the correct value for the current terminal in the nil case.") + +;;;; Defined in simple.el + +;; `save-excursion' behaved like `save-mark-and-excursion' before 25.1. +(compat-defalias save-mark-and-excursion save-excursion) ;; + +(declare-function region-bounds nil) ;; Defined in compat-26.el +(compat-defun region-noncontiguous-p () ;; + "Return non-nil if the region contains several pieces. +An example is a rectangular region handled as a list of +separate contiguous regions for each line." + (let ((bounds (region-bounds))) (and (cdr bounds) bounds))) + +;;;; Defined in subr.el + +(compat-defun string-greaterp (string1 string2) ;; + "Return non-nil if STRING1 is greater than STRING2 in lexicographic order. +Case is significant. +Symbols are also allowed; their print names are used instead." + (string-lessp string2 string1)) + +(compat-defmacro with-file-modes (modes &rest body) ;; + "Execute BODY with default file permissions temporarily set to MODES. +MODES is as for `set-default-file-modes'." + (declare (indent 1) (debug t)) + (let ((umask (make-symbol "umask"))) + `(let ((,umask (default-file-modes))) + (unwind-protect + (progn + (set-default-file-modes ,modes) + ,@body) + (set-default-file-modes ,umask))))) + +(compat-defmacro if-let (spec then &rest else) ;; + "Bind variables according to SPEC and evaluate THEN or ELSE. +Evaluate each binding in turn, as in `let*', stopping if a +binding value is nil. If all are non-nil return the value of +THEN, otherwise the last form in ELSE. + +Each element of SPEC is a list (SYMBOL VALUEFORM) that binds +SYMBOL to the value of VALUEFORM. An element can additionally be +of the form (VALUEFORM), which is evaluated and checked for nil; +i.e. SYMBOL can be omitted if only the test result is of +interest. It can also be of the form SYMBOL, then the binding of +SYMBOL is checked for nil. + +As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING) +like \((SYMBOL SOMETHING)). This exists for backward compatibility +with an old syntax that accepted only one binding." + (declare (indent 2) + (debug ([&or (symbolp form) + (&rest [&or symbolp (symbolp form) (form)])] + body))) + (when (and (<= (length spec) 2) (not (listp (car spec)))) + ;; Adjust the single binding case + (setq spec (list spec))) + (let ((empty (make-symbol "s")) + (last t) list) + (dolist (var spec) + (push `(,(if (cdr var) (car var) empty) + (and ,last ,(if (cdr var) (cadr var) (car var)))) + list) + (when (or (cdr var) (consp (car var))) + (setq last (caar list)))) + `(let* ,(nreverse list) + (if ,(caar list) ,then ,@else)))) + +(compat-defmacro when-let (spec &rest body) ;; + "Bind variables according to SPEC and conditionally evaluate BODY. +Evaluate each binding in turn, stopping if a binding value is nil. +If all are non-nil, return the value of the last form in BODY. + +The variable list SPEC is the same as in `if-let'." + (declare (indent 1) (debug if-let)) + (list 'if-let spec (macroexp-progn body))) + +;;;; Defined in subr-x.el + +(compat-defun hash-table-empty-p (hash-table) ;; + "Check whether HASH-TABLE is empty (has 0 elements)." + (zerop (hash-table-count hash-table))) + +(compat-defmacro thread-first (&rest forms) ;; + "Thread FORMS elements as the first argument of their successor. +Example: + (thread-first + 5 + (+ 20) + (/ 25) + - + (+ 40)) +Is equivalent to: + (+ (- (/ (+ 5 20) 25)) 40) +Note how the single `-' got converted into a list before +threading." + (declare (indent 1) + (debug (form &rest [&or symbolp (sexp &rest form)]))) + (let ((body (car forms))) + (dolist (form (cdr forms)) + (when (symbolp form) + (setq form (list form))) + (setq body (append (list (car form)) + (list body) + (cdr form)))) + body)) + +(compat-defmacro thread-last (&rest forms) ;; + "Thread FORMS elements as the last argument of their successor. +Example: + (thread-last + 5 + (+ 20) + (/ 25) + - + (+ 40)) +Is equivalent to: + (+ 40 (- (/ 25 (+ 20 5)))) +Note how the single `-' got converted into a list before +threading." + (declare (indent 1) (debug thread-first)) + (let ((body (car forms))) + (dolist (form (cdr forms)) + (when (symbolp form) + (setq form (list form))) + (setq body (append form (list body)))) + body)) + +;;;; Defined in macroexp.el + +(compat-defun macroexp-parse-body (body) ;; + "Parse a function BODY into (DECLARATIONS . EXPS)." + (let ((decls ())) + (while (and (cdr body) + (let ((e (car body))) + (or (stringp e) + (memq (car-safe e) + '(:documentation declare interactive cl-declare))))) + (push (pop body) decls)) + (cons (nreverse decls) body))) + +(compat-defun macroexp-quote (v) ;; + "Return an expression E such that `(eval E)' is V. + +E is either V or (quote V) depending on whether V evaluates to +itself or not." + (if (and (not (consp v)) + (or (keywordp v) + (not (symbolp v)) + (memq v '(nil t)))) + v + (list 'quote v))) + +(compat-defun macroexpand-1 (form &optional environment) ;; + "Perform (at most) one step of macro expansion." + (cond + ((consp form) + (let* ((head (car form)) + (env-expander (assq head environment))) + (if env-expander + (if (cdr env-expander) + (apply (cdr env-expander) (cdr form)) + form) + (if (not (and (symbolp head) (fboundp head))) + form + (let ((def (autoload-do-load (symbol-function head) head 'macro))) + (cond + ;; Follow alias, but only for macros, otherwise we may end up + ;; skipping an important compiler-macro (e.g. cl--block-wrapper). + ((and (symbolp def) (macrop def)) (cons def (cdr form))) + ((not (consp def)) form) + (t + (if (eq 'macro (car def)) + (apply (cdr def) (cdr form)) + form)))))))) + (t form))) + +(provide 'compat-25) +;;; compat-25.el ends here diff --git a/elpa/compat-29.1.3.4/compat-26.el b/elpa/compat-29.1.3.4/compat-26.el new file mode 100644 index 00000000..956c4a75 --- /dev/null +++ b/elpa/compat-29.1.3.4/compat-26.el @@ -0,0 +1,554 @@ +;;; compat-26.el --- Functionality added in Emacs 26.1 -*- lexical-binding: t; -*- + +;; Copyright (C) 2021-2023 Free Software Foundation, Inc. + +;; 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 . + +;;; Commentary: + +;; Functionality added in Emacs 26.1, needed by older Emacs versions. + +;;; Code: + +(eval-when-compile (require 'compat-macs)) +(compat-require compat-25 "25.1") + +(compat-version "26.1") + +;;;; Defined in fns.c + +(compat-defun buffer-hash (&optional buffer-or-name) ;; + "Return a hash of the contents of BUFFER-OR-NAME. +This hash is performed on the raw internal format of the buffer, +disregarding any coding systems. If nil, use the current buffer. + +This function is useful for comparing two buffers running in the same +Emacs, but is not guaranteed to return the same hash between different +Emacs versions. It should be somewhat more efficient on larger +buffers than `secure-hash' is, and should not allocate more memory. + +It should not be used for anything security-related. See +`secure-hash' for these applications." + (with-current-buffer (or buffer-or-name (current-buffer)) + (save-restriction + (widen) + (sha1 (current-buffer) (point-min) (point-max))))) + +(compat-defun mapcan (func sequence) ;; + "Apply FUNC to each element of SEQUENCE. +Concatenate the results by altering them (using `nconc'). +SEQUENCE may be a list, a vector, a boolean vector, or a string." + (apply #'nconc (mapcar func sequence))) + +(compat-defun line-number-at-pos (&optional position absolute) ;; + "Handle optional argument ABSOLUTE." + :extended t + (if absolute + (save-restriction + (widen) + (line-number-at-pos position)) + (line-number-at-pos position))) + +;;;; Defined in simple.el + +(compat-defun region-bounds () ;; + "Return the boundaries of the region. +Value is a list of one or more cons cells of the form (START . END). +It will have more than one cons cell when the region is non-contiguous, +see `region-noncontiguous-p' and `extract-rectangle-bounds'." + (if (eval-when-compile (< emacs-major-version 25)) + ;; FIXME: The `region-extract-function' of Emacs 24 has no support for the + ;; bounds argument. + (list (cons (region-beginning) (region-end))) + (funcall region-extract-function 'bounds))) + +;;;; Defined in subr.el + +(compat-defun provided-mode-derived-p (mode &rest modes) ;; + "Non-nil if MODE is derived from one of MODES. +Uses the `derived-mode-parent' property of the symbol to trace backwards. +If you just want to check `major-mode', use `derived-mode-p'." + ;; If MODE is an alias, then look up the real mode function first. + (let ((alias (symbol-function mode))) + (when (and alias (symbolp alias)) + (setq mode alias))) + (while + (and + (not (memq mode modes)) + (let* ((parent (get mode 'derived-mode-parent)) + (parentfn (symbol-function parent))) + (setq mode (if (and parentfn (symbolp parentfn)) parentfn parent))))) + mode) + +(compat-defun assoc (key alist &optional testfn) ;; + "Handle the optional TESTFN." + :extended t + (cond + ((or (eq testfn #'eq) + (and (not testfn) (or (symbolp key) (integerp key)))) ;; eq_comparable_value + (assq key alist)) + ((or (eq testfn #'equal) (not testfn)) + (assoc key alist)) + (t + (catch 'found + (dolist (ent alist) + (when (funcall testfn (car ent) key) + (throw 'found ent))))))) + +(compat-defun alist-get (key alist &optional default remove testfn) ;; + "Handle optional argument TESTFN." + :extended "25.1" + (ignore remove) + (let ((x (if (not testfn) + (assq key alist) + (compat--assoc key alist testfn)))) + (if x (cdr x) default))) + +(compat-guard t ;; + (gv-define-expander compat--alist-get + (lambda (do key alist &optional default remove testfn) + (macroexp-let2 macroexp-copyable-p k key + (gv-letplace (getter setter) alist + (macroexp-let2 nil p `(compat--assoc ,k ,getter ,testfn) + (funcall do (if (null default) `(cdr ,p) + `(if ,p (cdr ,p) ,default)) + (lambda (v) + (macroexp-let2 nil v v + (let ((set-exp + `(if ,p (setcdr ,p ,v) + ,(funcall setter + `(cons (setq ,p (cons ,k ,v)) + ,getter))))) + `(progn + ,(cond + ((null remove) set-exp) + ((or (eql v default) + (and (eq (car-safe v) 'quote) + (eq (car-safe default) 'quote) + (eql (cadr v) (cadr default)))) + `(if ,p ,(funcall setter `(delq ,p ,getter)))) + (t + `(cond + ((not (eql ,default ,v)) ,set-exp) + (,p ,(funcall setter + `(delq ,p ,getter)))))) + ,v)))))))))) + (unless (get 'alist-get 'gv-expander) + (put 'alist-get 'gv-expander (get 'compat--alist-get 'gv-expander)))) + +(compat-defun string-trim-left (string &optional regexp) ;; + "Handle optional argument REGEXP." + :extended t + (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string) + (substring string (match-end 0)) + string)) + +(compat-defun string-trim-right (string &optional regexp) ;; + "Handle optional argument REGEXP." + :extended t + (let ((i (string-match-p + (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'") + string))) + (if i (substring string 0 i) string))) + +(compat-defun string-trim (string &optional trim-left trim-right) ;; + "Handle optional arguments TRIM-LEFT and TRIM-RIGHT." + :extended t + (compat--string-trim-left + (compat--string-trim-right + string + trim-right) + trim-left)) + +(compat-defun caaar (x) ;; + "Return the `car' of the `car' of the `car' of X." + (declare (pure t)) + (car (car (car x)))) + +(compat-defun caadr (x) ;; + "Return the `car' of the `car' of the `cdr' of X." + (declare (pure t)) + (car (car (cdr x)))) + +(compat-defun cadar (x) ;; + "Return the `car' of the `cdr' of the `car' of X." + (declare (pure t)) + (car (cdr (car x)))) + +(compat-defun caddr (x) ;; + "Return the `car' of the `cdr' of the `cdr' of X." + (declare (pure t)) + (car (cdr (cdr x)))) + +(compat-defun cdaar (x) ;; + "Return the `cdr' of the `car' of the `car' of X." + (declare (pure t)) + (cdr (car (car x)))) + +(compat-defun cdadr (x) ;; + "Return the `cdr' of the `car' of the `cdr' of X." + (declare (pure t)) + (cdr (car (cdr x)))) + +(compat-defun cddar (x) ;; + "Return the `cdr' of the `cdr' of the `car' of X." + (declare (pure t)) + (cdr (cdr (car x)))) + +(compat-defun cdddr (x) ;; + "Return the `cdr' of the `cdr' of the `cdr' of X." + (declare (pure t)) + (cdr (cdr (cdr x)))) + +(compat-defun caaaar (x) ;; + "Return the `car' of the `car' of the `car' of the `car' of X." + (declare (pure t)) + (car (car (car (car x))))) + +(compat-defun caaadr (x) ;; + "Return the `car' of the `car' of the `car' of the `cdr' of X." + (declare (pure t)) + (car (car (car (cdr x))))) + +(compat-defun caadar (x) ;; + "Return the `car' of the `car' of the `cdr' of the `car' of X." + (declare (pure t)) + (car (car (cdr (car x))))) + +(compat-defun caaddr (x) ;; + "Return the `car' of the `car' of the `cdr' of the `cdr' of X." + (declare (pure t)) + (car (car (cdr (cdr x))))) + +(compat-defun cadaar (x) ;; + "Return the `car' of the `cdr' of the `car' of the `car' of X." + (declare (pure t)) + (car (cdr (car (car x))))) + +(compat-defun cadadr (x) ;; + "Return the `car' of the `cdr' of the `car' of the `cdr' of X." + (declare (pure t)) + (car (cdr (car (cdr x))))) + +(compat-defun caddar (x) ;; + "Return the `car' of the `cdr' of the `cdr' of the `car' of X." + (declare (pure t)) + (car (cdr (cdr (car x))))) + +(compat-defun cadddr (x) ;; + "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X." + (declare (pure t)) + (car (cdr (cdr (cdr x))))) + +(compat-defun cdaaar (x) ;; + "Return the `cdr' of the `car' of the `car' of the `car' of X." + (declare (pure t)) + (cdr (car (car (car x))))) + +(compat-defun cdaadr (x) ;; + "Return the `cdr' of the `car' of the `car' of the `cdr' of X." + (declare (pure t)) + (cdr (car (car (cdr x))))) + +(compat-defun cdadar (x) ;; + "Return the `cdr' of the `car' of the `cdr' of the `car' of X." + (declare (pure t)) + (cdr (car (cdr (car x))))) + +(compat-defun cdaddr (x) ;; + "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X." + (declare (pure t)) + (cdr (car (cdr (cdr x))))) + +(compat-defun cddaar (x) ;; + "Return the `cdr' of the `cdr' of the `car' of the `car' of X." + (declare (pure t)) + (cdr (cdr (car (car x))))) + +(compat-defun cddadr (x) ;; + "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X." + (declare (pure t)) + (cdr (cdr (car (cdr x))))) + +(compat-defun cdddar (x) ;; + "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X." + (declare (pure t)) + (cdr (cdr (cdr (car x))))) + +(compat-defun cddddr (x) ;; + "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X." + (declare (pure t)) + (cdr (cdr (cdr (cdr x))))) + +(compat-defvar gensym-counter 0 ;; + "Number used to construct the name of the next symbol created by `gensym'.") + +(compat-defun gensym (&optional prefix) ;; + "Return a new uninterned symbol. +The name is made by appending `gensym-counter' to PREFIX. +PREFIX is a string, and defaults to \"g\"." + (let ((num (prog1 gensym-counter + (setq gensym-counter + (1+ gensym-counter))))) + (make-symbol (format "%s%d" (or prefix "g") num)))) + +(compat-defmacro if-let* (varlist then &rest else) ;; + "Bind variables according to VARLIST and evaluate THEN or ELSE. +This is like `if-let' but doesn't handle a VARLIST of the form +\(SYMBOL SOMETHING) specially." + (declare (indent 2) + (debug ((&rest [&or symbolp (symbolp form) (form)]) + body))) + (let ((empty (make-symbol "s")) + (last t) list) + (dolist (var varlist) + (push `(,(if (cdr var) (car var) empty) + (and ,last ,(if (cdr var) (cadr var) (car var)))) + list) + (when (or (cdr var) (consp (car var))) + (setq last (caar list)))) + `(let* ,(nreverse list) + (if ,(caar list) ,then ,@else)))) + +(compat-defmacro when-let* (varlist &rest body) ;; + "Bind variables according to VARLIST and conditionally evaluate BODY. +This is like `when-let' but doesn't handle a VARLIST of the form +\(SYMBOL SOMETHING) specially." + (declare (indent 1) (debug if-let*)) + (list 'if-let* varlist (macroexp-progn body))) + +(compat-defmacro and-let* (varlist &rest body) ;; + "Bind variables according to VARLIST and conditionally evaluate BODY. +Like `when-let*', except if BODY is empty and all the bindings +are non-nil, then the result is non-nil." + (declare (indent 1) + (debug ((&rest [&or symbolp (symbolp form) (form)]) + body))) + (let ((empty (make-symbol "s")) + (last t) list) + (dolist (var varlist) + (push `(,(if (cdr var) (car var) empty) + (and ,last ,(if (cdr var) (cadr var) (car var)))) + list) + (when (or (cdr var) (consp (car var))) + (setq last (caar list)))) + `(let* ,(nreverse list) + (if ,(caar list) ,(macroexp-progn (or body '(t))))))) + +;;;; Defined in files.el + +(compat-defvar mounted-file-systems ;; + (eval-when-compile + (if (memq system-type '(windows-nt cygwin)) + "^//[^/]+/" + (concat + "^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/"))))) + "File systems that ought to be mounted.") + +(compat-defun file-local-name (file) ;; + "Return the local name component of FILE. +This function removes from FILE the specification of the remote host +and the method of accessing the host, leaving only the part that +identifies FILE locally on the remote system. +The returned file name can be used directly as argument of +`process-file', `start-file-process', or `shell-command'." + (or (file-remote-p file 'localname) file)) + +(compat-defun temporary-file-directory () ;; + "The directory for writing temporary files. +In case of a remote `default-directory', this is a directory for +temporary files on that remote host. If such a directory does +not exist, or `default-directory' ought to be located on a +mounted file system (see `mounted-file-systems'), the function +returns `default-directory'. +For a non-remote and non-mounted `default-directory', the value of +the variable `temporary-file-directory' is returned." + ;; NOTE: The handler may fail with an error, since the + ;; `temporary-file-directory' handler was introduced in Emacs 26. + (let ((handler (find-file-name-handler + default-directory 'temporary-file-directory))) + (or (and handler (ignore-errors (funcall handler 'temporary-file-directory))) + (if-let ((remote (file-remote-p default-directory))) + (concat remote "/tmp/") ;; FIXME: Guess /tmp on remote host + (if (string-match mounted-file-systems default-directory) + default-directory + temporary-file-directory))))) + +(compat-defun make-temp-file (prefix &optional dir-flag suffix text) ;; + "Handle optional argument TEXT." + :extended t + (let ((file (make-temp-file prefix dir-flag suffix))) + (when text + (with-temp-buffer + (insert text) + (write-region (point-min) (point-max) file))) + file)) + +(compat-defun make-nearby-temp-file (prefix &optional dir-flag suffix) ;; + "Create a temporary file as close as possible to `default-directory'. +If PREFIX is a relative file name, and `default-directory' is a +remote file name or located on a mounted file systems, the +temporary file is created in the directory returned by the +function `temporary-file-directory'. Otherwise, the function +`make-temp-file' is used. PREFIX, DIR-FLAG and SUFFIX have the +same meaning as in `make-temp-file'." + ;; NOTE: The handler may fail with an error, since the + ;; `make-nearby-temp-file' handler was introduced in Emacs 26. + (let ((handler (and (not (file-name-absolute-p default-directory)) + (find-file-name-handler + default-directory 'make-nearby-temp-file)))) + (or (and handler (ignore-errors (funcall handler 'make-nearby-temp-file + prefix dir-flag suffix))) + (let ((temporary-file-directory (temporary-file-directory))) + (make-temp-file prefix dir-flag suffix))))) + +(compat-defun file-attribute-type (attributes) ;; + "The type field in ATTRIBUTES returned by `file-attributes'. +The value is either t for directory, string (name linked to) for +symbolic link, or nil." + (nth 0 attributes)) + +(compat-defun file-attribute-link-number (attributes) ;; + "Return the number of links in ATTRIBUTES returned by `file-attributes'." + (nth 1 attributes)) + +(compat-defun file-attribute-user-id (attributes) ;; + "The UID field in ATTRIBUTES returned by `file-attributes'. +This is either a string or a number. If a string value cannot be +looked up, a numeric value, either an integer or a float, is +returned." + (nth 2 attributes)) + +(compat-defun file-attribute-group-id (attributes) ;; + "The GID field in ATTRIBUTES returned by `file-attributes'. +This is either a string or a number. If a string value cannot be +looked up, a numeric value, either an integer or a float, is +returned." + (nth 3 attributes)) + +(compat-defun file-attribute-access-time (attributes) ;; + "The last access time in ATTRIBUTES returned by `file-attributes'. +This a Lisp timestamp in the style of `current-time'." + (nth 4 attributes)) + +(compat-defun file-attribute-modification-time (attributes) ;; + "The modification time in ATTRIBUTES returned by `file-attributes'. +This is the time of the last change to the file's contents, and +is a Lisp timestamp in the style of `current-time'." + (nth 5 attributes)) + +(compat-defun file-attribute-status-change-time (attributes) ;; + "The status modification time in ATTRIBUTES returned by `file-attributes'. +This is the time of last change to the file's attributes: owner +and group, access mode bits, etc., and is a Lisp timestamp in the +style of `current-time'." + (nth 6 attributes)) + +(compat-defun file-attribute-size (attributes) ;; + "The integer size (in bytes) in ATTRIBUTES returned by `file-attributes'." + (nth 7 attributes)) + +(compat-defun file-attribute-modes (attributes) ;; + "The file modes in ATTRIBUTES returned by `file-attributes'. +This is a string of ten letters or dashes as in ls -l." + (nth 8 attributes)) + +(compat-defun file-attribute-inode-number (attributes) ;; + "The inode number in ATTRIBUTES returned by `file-attributes'. +It is a nonnegative integer." + (nth 10 attributes)) + +(compat-defun file-attribute-device-number (attributes) ;; + "The file system device number in ATTRIBUTES returned by `file-attributes'. +It is an integer." + (nth 11 attributes)) + +(compat-defun file-attribute-collect (attributes &rest attr-names) ;; + "Return a sublist of ATTRIBUTES returned by `file-attributes'. +ATTR-NAMES are symbols with the selected attribute names. + +Valid attribute names are: type, link-number, user-id, group-id, +access-time, modification-time, status-change-time, size, modes, +inode-number and device-number." + (let ((idx '((type . 0) + (link-number . 1) + (user-id . 2) + (group-id . 3) + (access-time . 4) + (modification-time . 5) + (status-change-time . 6) + (size . 7) + (modes . 8) + (inode-number . 10) + (device-number . 11))) + result) + (while attr-names + (let ((attr (pop attr-names))) + (if (assq attr idx) + (push (nth (cdr (assq attr idx)) + attributes) + result) + (error "Wrong attribute name '%S'" attr)))) + (nreverse result))) + +;;;; Defined in mouse.el + +(compat-defvar mouse-select-region-move-to-beginning nil ;; + "Effect of selecting a region extending backward from double click. +Nil means keep point at the position clicked (region end); +non-nil means move point to beginning of region.") + +;;;; Defined in image.el + +(compat-defun image-property (image property) ;; + "Return the value of PROPERTY in IMAGE. +Properties can be set with + + (setf (image-property IMAGE PROPERTY) VALUE) + +If VALUE is nil, PROPERTY is removed from IMAGE." + :feature image + (plist-get (cdr image) property)) + +;;;; Defined in rmc.el + +(compat-defun read-multiple-choice (prompt choices) ;; + "Ask user to select an entry from CHOICES, promting with PROMPT. +This function allows to ask the user a multiple-choice question. + +CHOICES should be a list of the form (KEY NAME [DESCRIPTION]). +KEY is a character the user should type to select the entry. +NAME is a short name for the entry to be displayed while prompting +\(if there's no room, it might be shortened). + +NOTE: This is a partial implementation of `read-multiple-choice', that +among other things doesn't offer any help and ignores the +optional DESCRIPTION field." + (let ((options + (mapconcat + (lambda (opt) + (format + "[%s] %s" + (key-description (string (car opt))) + (cadr opt))) + choices " ")) + choice) + (setq prompt (concat prompt " (" options "): ")) + (while (not (setq choice (assq (read-event prompt) choices))) + (message "Invalid choice") + (sit-for 1)) + choice)) + +(provide 'compat-26) +;;; compat-26.el ends here diff --git a/elpa/compat-29.1.3.4/compat-27.el b/elpa/compat-29.1.3.4/compat-27.el new file mode 100644 index 00000000..a2e47ca2 --- /dev/null +++ b/elpa/compat-29.1.3.4/compat-27.el @@ -0,0 +1,898 @@ +;;; compat-27.el --- Functionality added in Emacs 27.1 -*- lexical-binding: t; -*- + +;; Copyright (C) 2021-2023 Free Software Foundation, Inc. + +;; 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 . + +;;; Commentary: + +;; Functionality added in Emacs 27.1, needed by older Emacs versions. + +;;; Code: + +(eval-when-compile (require 'compat-macs)) +(compat-require compat-26 "26.1") + +(compat-version "27.1") + +;;;; Defined in fns.c + +(compat-defun proper-list-p (object) ;; + "Return OBJECT's length if it is a proper list, nil otherwise. +A proper list is neither circular nor dotted (i.e., its last cdr +is nil)." + (if (eval-when-compile (< emacs-major-version 26)) + ;; On older Emacs than 26.1 use Tortoise and Hare algorithm + (when (listp object) + (catch 'cycle + (let ((hare object) (tortoise object) + (max 2) (q 2)) + (while (consp hare) + (setq hare (cdr hare)) + (when (and (or (/= 0 (setq q (1- q))) + (ignore + (setq max (ash max 1) + q max + tortoise hare))) + (eq hare tortoise)) + (throw 'cycle nil))) + (and (null hare) (length object))))) + ;; Errors on 26.1 and newer + (and (listp object) (ignore-errors (length object))))) + +(compat-defun string-distance (string1 string2 &optional bytecompare) ;; + "Return Levenshtein distance between STRING1 and STRING2. +The distance is the number of deletions, insertions, and substitutions +required to transform STRING1 into STRING2. +If BYTECOMPARE is nil or omitted, compute distance in terms of characters. +If BYTECOMPARE is non-nil, compute distance in terms of bytes. +Letter-case is significant, but text properties are ignored." + ;; https://en.wikipedia.org/wiki/Levenshtein_distance + (let ((s1 (if bytecompare + (encode-coding-string string1 'raw-text) + (concat string1 ""))) + (s2 (if bytecompare + (encode-coding-string string2 'raw-text) + string2))) + (let* ((len1 (length s1)) + (len2 (length s2)) + (column (make-vector (1+ len1) 0))) + (dotimes (y len1) + (setf (aref column (1+ y)) y)) + (dotimes (x len2) + (setf (aref column 0) (1+ x)) + (let ((lastdiag x) olddiag) + (dotimes (y len1) + (setf olddiag (aref column (1+ y)) + (aref column (1+ y)) + (min (+ (if (= (aref s1 y) (aref s2 x)) 0 1) + lastdiag) + (1+ (aref column (1+ y))) + (1+ (aref column y))) + lastdiag olddiag)))) + (aref column len1)))) + +;;;; Defined in window.c + +(compat-defun recenter (&optional arg redisplay) ;; + "Handle optional argument REDISPLAY." + :extended t + (recenter arg) + (when (and redisplay recenter-redisplay) + (redisplay))) + +;;;; Defined in keymap.c + +(compat-defun lookup-key (keymap key &optional accept-default) ;; + "Allow for KEYMAP to be a list of keymaps." + :extended t + (cond + ((keymapp keymap) + (lookup-key keymap key accept-default)) + ((listp keymap) + (catch 'found + (dolist (map keymap) + (when-let ((fn (lookup-key map key accept-default))) + (throw 'found fn))))) + ((signal 'wrong-type-argument (list 'keymapp keymap))))) + +;;;; Defined in timefns.c + +(compat-defun time-equal-p (t1 t2) ;; + "Return non-nil if time value T1 is equal to time value T2. +A nil value for either argument stands for the current time. + +NOTE: This function is not as accurate as the actual `time-equal-p'." + (cond + ((eq t1 t2)) + ((and (consp t1) (consp t2)) + (equal t1 t2)) + (t + ;; Due to inaccuracies and the relatively slow evaluating of + ;; Emacs Lisp compared to C, we allow for slight inaccuracies + ;; (less than a millisecond) when comparing time values. + (< (abs (- (float-time t1) (float-time t2))) + (if (and t1 t2) 1e-6 1e-5))))) + +;;;; Defined in subr.el + +(compat-defalias fixnump integerp) ;; +(compat-defalias bignump ignore) ;; + +(compat-defmacro setq-local (&rest pairs) ;; + "Handle multiple assignments." + :extended t + (unless (zerop (mod (length pairs) 2)) + (error "PAIRS must have an even number of variable/value members")) + (let (body) + (while pairs + (let* ((sym (pop pairs)) + (val (pop pairs))) + (unless (symbolp sym) + (error "Attempting to set a non-symbol: %s" (car pairs))) + (push `(set (make-local-variable ',sym) ,val) + body))) + (cons 'progn (nreverse body)))) + +(compat-defmacro ignore-error (condition &rest body) ;; + "Execute BODY; if the error CONDITION occurs, return nil. +Otherwise, return result of last form in BODY. + +CONDITION can also be a list of error conditions." + (declare (debug t) (indent 1)) + `(condition-case nil (progn ,@body) (,condition nil))) + +(compat-defmacro dolist-with-progress-reporter (spec reporter-or-message &rest body) ;; + "Loop over a list and report progress in the echo area. +Evaluate BODY with VAR bound to each car from LIST, in turn. +Then evaluate RESULT to get return value, default nil. + +REPORTER-OR-MESSAGE is a progress reporter object or a string. In the latter +case, use this string to create a progress reporter. + +At each iteration, print the reporter message followed by progress +percentage in the echo area. After the loop is finished, +print the reporter message followed by the word \"done\". + +\(fn (VAR LIST [RESULT]) REPORTER-OR-MESSAGE BODY...)" + (declare (indent 2) (debug ((symbolp form &optional form) form body))) + (let ((prep (make-symbol "--dolist-progress-reporter--")) + (count (make-symbol "--dolist-count--")) + (list (make-symbol "--dolist-list--"))) + `(let ((,prep ,reporter-or-message) + (,count 0) + (,list ,(cadr spec))) + (when (stringp ,prep) + (setq ,prep (make-progress-reporter ,prep 0 (length ,list)))) + (dolist (,(car spec) ,list) + ,@body + (progress-reporter-update ,prep (setq ,count (1+ ,count)))) + (progress-reporter-done ,prep) + (or ,@(cdr (cdr spec)) nil)))) + +(compat-defun flatten-tree (tree) ;; + "Return a \"flattened\" copy of TREE. +In other words, return a list of the non-nil terminal nodes, or +leaves, of the tree of cons cells rooted at TREE. Leaves in the +returned list are in the same order as in TREE. + +\(flatten-tree \\='(1 (2 . 3) nil (4 5 (6)) 7)) +=> (1 2 3 4 5 6 7)" + (let (elems) + (while (consp tree) + (let ((elem (pop tree))) + (while (consp elem) + (push (cdr elem) tree) + (setq elem (car elem))) + (if elem (push elem elems)))) + (if tree (push tree elems)) + (nreverse elems))) + +(compat-defun xor (cond1 cond2) ;; + "Return the boolean exclusive-or of COND1 and COND2. +If only one of the arguments is non-nil, return it; otherwise +return nil." + (declare (pure t) (side-effect-free error-free)) + (cond ((not cond1) cond2) + ((not cond2) cond1))) + +(compat-defvar regexp-unmatchable "\\`a\\`" ;; + "Standard regexp guaranteed not to match any string at all." + :constant t) + +(compat-defun assoc-delete-all (key alist &optional test) ;; + "Handle optional argument TEST." + :extended "26.2" + (unless test (setq test #'equal)) + (while (and (consp (car alist)) + (funcall test (caar alist) key)) + (setq alist (cdr alist))) + (let ((tail alist) tail-cdr) + (while (setq tail-cdr (cdr tail)) + (if (and (consp (car tail-cdr)) + (funcall test (caar tail-cdr) key)) + (setcdr tail (cdr tail-cdr)) + (setq tail tail-cdr)))) + alist) + +(compat-defvar major-mode--suspended nil ;; + "Suspended major mode." + :local permanent) + +(compat-defun major-mode-suspend () ;; + "Exit current major mode, remembering it." + (let* ((prev-major-mode (or major-mode--suspended + (unless (eq major-mode 'fundamental-mode) + major-mode)))) + (kill-all-local-variables) + (setq-local major-mode--suspended prev-major-mode))) + +(compat-defun major-mode-restore (&optional avoided-modes) ;; + "Restore major mode earlier suspended with `major-mode-suspend'. +If there was no earlier suspended major mode, then fallback to `normal-mode', +though trying to avoid AVOIDED-MODES." + (if major-mode--suspended + (funcall (prog1 major-mode--suspended + (kill-local-variable 'major-mode--suspended))) + (let ((auto-mode-alist + (let ((alist (copy-sequence auto-mode-alist))) + (dolist (mode avoided-modes) + (setq alist (rassq-delete-all mode alist))) + alist)) + (magic-fallback-mode-alist + (let ((alist (copy-sequence magic-fallback-mode-alist))) + (dolist (mode avoided-modes) + (setq alist (rassq-delete-all mode alist))) + alist))) + (normal-mode)))) + +(compat-defun read-char-from-minibuffer-insert-char () ;; + "Insert the character you type into the minibuffer and exit minibuffer. +Discard all previous input before inserting and exiting the minibuffer." + (interactive) + (when (minibufferp) + (delete-minibuffer-contents) + (insert last-command-event) + (exit-minibuffer))) + +(compat-defun read-char-from-minibuffer-insert-other () ;; + "Reject a disallowed character typed into the minibuffer. +This command is intended to be bound to keys that users are not +allowed to type into the minibuffer. When the user types any +such key, this command discard all minibuffer input and displays +an error message." + (interactive) + (when (minibufferp) + (delete-minibuffer-contents) + (ding) + (discard-input) + (minibuffer-message "Wrong answer") + (sit-for 2))) + +(compat-defvar read-char-history nil ;; + "The default history for the `read-char-from-minibuffer' function.") + +(compat-defvar read-char-from-minibuffer-map ;; + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map [remap self-insert-command] #'read-char-from-minibuffer-insert-char) + (define-key map [remap exit-minibuffer] #'read-char-from-minibuffer-insert-other) + map) + "Keymap for the `read-char-from-minibuffer' function.") + +(compat-defvar read-char-from-minibuffer-map-hash ;; + (make-hash-table :test 'equal) + "Hash table of keymaps used by `read-char-from-minibuffer'." + :constant t) + +(compat-defun read-char-from-minibuffer (prompt &optional chars history) ;; + "Read a character from the minibuffer, prompting for it with PROMPT. +Like `read-char', but uses the minibuffer to read and return a character. +Optional argument CHARS, if non-nil, should be a list of characters; +the function will ignore any input that is not one of CHARS. +Optional argument HISTORY, if non-nil, should be a symbol that +specifies the history list variable to use for navigating in input +history using \\`M-p' and \\`M-n', with \\`RET' to select a character from +history. +If you bind the variable `help-form' to a non-nil value +while calling this function, then pressing `help-char' +causes it to evaluate `help-form' and display the result. +There is no need to explicitly add `help-char' to CHARS; +`help-char' is bound automatically to `help-form-show'." + (let* ((map (if (consp chars) + (or (gethash (list help-form (cons help-char chars)) + read-char-from-minibuffer-map-hash) + (let ((map (make-sparse-keymap)) + (msg help-form)) + (set-keymap-parent map read-char-from-minibuffer-map) + ;; If we have a dynamically bound `help-form' + ;; here, then the `C-h' (i.e., `help-char') + ;; character should output that instead of + ;; being a command char. + (when help-form + (define-key map (vector help-char) + (lambda () + (interactive) + (let ((help-form msg)) ; lexically bound msg + (help-form-show))))) + (dolist (char chars) + (define-key map (vector char) + #'read-char-from-minibuffer-insert-char)) + (define-key map [remap self-insert-command] + #'read-char-from-minibuffer-insert-other) + (puthash (list help-form (cons help-char chars)) + map read-char-from-minibuffer-map-hash) + map)) + read-char-from-minibuffer-map)) + ;; Protect this-command when called from pre-command-hook (bug#45029) + (this-command this-command) + (result (read-from-minibuffer prompt nil map nil (or history t))) + (char + (if (> (length result) 0) + ;; We have a string (with one character), so return the first one. + (elt result 0) + ;; The default value is RET. + (when history (push "\r" (symbol-value history))) + ?\r))) + ;; Display the question with the answer. + (message "%s%s" prompt (char-to-string char)) + char)) + +;;;; Defined in simple.el + +(compat-guard (not (fboundp 'decoded-time-second)) ;; + (cl-defstruct (decoded-time + (:constructor nil) + (:copier nil) + (:type list)) + (second nil :documentation "\ +This is an integer or a Lisp timestamp (TICKS . HZ) representing a nonnegative +number of seconds less than 61. (If not less than 60, it is a leap second, +which only some operating systems support.)") + (minute nil :documentation "This is an integer between 0 and 59 (inclusive).") + (hour nil :documentation "This is an integer between 0 and 23 (inclusive).") + (day nil :documentation "This is an integer between 1 and 31 (inclusive).") + (month nil :documentation "\ +This is an integer between 1 and 12 (inclusive). January is 1.") + (year nil :documentation "This is a four digit integer.") + (weekday nil :documentation "\ +This is a number between 0 and 6, and 0 is Sunday.") + (dst -1 :documentation "\ +This is t if daylight saving time is in effect, nil if it is not +in effect, and -1 if daylight saving information is not available. +Also see `decoded-time-dst'.") + (zone nil :documentation "\ +This is an integer indicating the UTC offset in seconds, i.e., +the number of seconds east of Greenwich."))) + +(compat-defun minibuffer-history-value () ;; + "Return the value of the minibuffer input history list. +If `minibuffer-history-variable' points to a buffer-local variable and +the minibuffer is active, return the buffer-local value for the buffer +that was current when the minibuffer was activated." + (buffer-local-value minibuffer-history-variable + (window-buffer (minibuffer-selected-window)))) + +;;;; Defined in minibuffer.el + +(compat-defmacro with-minibuffer-selected-window (&rest body) ;; + "Execute the forms in BODY from the minibuffer in its original window. +When used in a minibuffer window, select the window selected just before +the minibuffer was activated, and execute the forms." + (declare (indent 0) (debug t)) + `(when-let ((window (minibuffer-selected-window))) + (with-selected-window window + ,@body))) + +;;;; Defined in byte-run.el + +(compat-defmacro with-suppressed-warnings (_warnings &rest body) ;; + "Like `progn', but prevents compiler WARNINGS in BODY. +NOTE: The compatibility version behaves like `with-no-warnings'." + `(with-no-warnings ,@body)) + +;;;; Defined in image.el + +(compat-defun image--set-property (image property value) ;; + "Set PROPERTY in IMAGE to VALUE, internal use only." + :extended "26.1" + :feature image + (if (null value) + (while (cdr image) + (if (eq (cadr image) property) + (setcdr image (cdddr image)) + (setq image (cddr image)))) + (setcdr image (plist-put (cdr image) property value))) + value) + +;; HACK: image--set-property was broken with an off-by-one error on Emacs 26. +;; The bug was fixed in a4ad7bed187493c1c230f223b52c71f5c34f7c89. Therefore we +;; override the gv expander until Emacs 27.1. +(compat-guard ;; + (or (= emacs-major-version 26) (not (get 'image-property 'gv-expander))) + :feature image + (gv-define-setter image-property (value image prop) + `(,(if (< emacs-major-version 26) 'image--set-property 'compat--image--set-property) + ,image ,prop ,value))) + +;;;; Defined in files.el + +(compat-defun file-name-quoted-p (name &optional top) ;; + "Handle optional argument TOP." + :extended "26.1" + (let ((file-name-handler-alist (unless top file-name-handler-alist))) + (string-prefix-p "/:" (file-local-name name)))) + +(compat-defun file-name-quote (name &optional top) ;; + "Handle optional argument TOP." + :extended "26.1" + (let* ((file-name-handler-alist (unless top file-name-handler-alist)) + (localname (file-local-name name))) + (if (string-prefix-p "/:" localname) + name + (concat (file-remote-p name) "/:" localname)))) + +(compat-defun file-name-unquote (name &optional top) ;; + "Handle optional argument TOP." + :extended "26.1" + (let* ((file-name-handler-alist (unless top file-name-handler-alist)) + (localname (file-local-name name))) + (when (string-prefix-p "/:" localname) + (setq localname (if (= (length localname) 2) "/" (substring localname 2)))) + (concat (file-remote-p name) localname))) + +(compat-defun file-size-human-readable (file-size &optional flavor space unit) ;; + "Handle the optional arguments SPACE and UNIT." + :extended t + (let ((power (if (or (null flavor) (eq flavor 'iec)) + 1024.0 + 1000.0)) + (prefixes '("" "k" "M" "G" "T" "P" "E" "Z" "Y"))) + (while (and (>= file-size power) (cdr prefixes)) + (setq file-size (/ file-size power) + prefixes (cdr prefixes))) + (let* ((prefix (car prefixes)) + (prefixed-unit (if (eq flavor 'iec) + (concat + (if (string= prefix "k") "K" prefix) + (if (string= prefix "") "" "i") + (or unit "B")) + (concat prefix unit)))) + (format (if (and (>= (mod file-size 1.0) 0.05) + (< (mod file-size 1.0) 0.95)) + "%.1f%s%s" + "%.0f%s%s") + file-size + (if (string= prefixed-unit "") "" (or space "")) + prefixed-unit)))) + +(compat-defun file-size-human-readable-iec (size) ;; + "Human-readable string for SIZE bytes, using IEC prefixes." + (compat--file-size-human-readable size 'iec " ")) + +(compat-defun exec-path () ;; + "Return list of directories to search programs to run in remote subprocesses. +The remote host is identified by `default-directory'. For remote +hosts that do not support subprocesses, this returns nil. +If `default-directory' is a local directory, this function returns +the value of the variable `exec-path'." + (let ((handler (find-file-name-handler default-directory 'exec-path))) + ;; NOTE: The handler may fail since it was added in 27.1. + (or (and handler (ignore-errors (funcall handler 'exec-path))) + (if (file-remote-p default-directory) + ;; FIXME: Just return some standard path on remote + '("/bin" "/usr/bin" "/sbin" "/usr/sbin" "/usr/local/bin" "/usr/local/sbin") + exec-path)))) + +(compat-defun executable-find (command &optional remote) ;; + "Handle optional argument REMOTE." + :extended t + (if (and remote (file-remote-p default-directory)) + (let ((res (locate-file + command + (mapcar + (apply-partially + #'concat (file-remote-p default-directory)) + (exec-path)) + exec-suffixes 'file-executable-p))) + (when (stringp res) (file-local-name res))) + (executable-find command))) + +(compat-defun make-empty-file (filename &optional parents) ;; + "Create an empty file FILENAME. +Optional arg PARENTS, if non-nil then creates parent dirs as needed." + (when (and (file-exists-p filename) (null parents)) + (signal 'file-already-exists (list "File exists" filename))) + (let ((paren-dir (file-name-directory filename))) + (when (and paren-dir (not (file-exists-p paren-dir))) + (make-directory paren-dir parents))) + (write-region "" nil filename nil 0)) + +;;;; Defined in regexp-opt.el + +(compat-defun regexp-opt (strings &optional paren) ;; + "Handle an empty list of STRINGS." + :extended t + (if (null strings) + (let ((re "\\`a\\`")) + (cond ((null paren) + (concat "\\(?:" re "\\)")) + ((stringp paren) + (concat paren re "\\)")) + ((eq paren 'words) + (concat "\\<\\(" re "\\)\\>")) + ((eq paren 'symbols) + (concat "\\_\\(<" re "\\)\\_>")) + ((concat "\\(" re "\\)")))) + (regexp-opt strings paren))) + +;;;; Defined in package.el + +(declare-function lm-header "lisp-mnt") +(declare-function macroexp-file-name nil) + +(compat-defun package-get-version () ;; + "Return the version number of the package in which this is used. +Assumes it is used from an Elisp file placed inside the top-level directory +of an installed ELPA package. +The return value is a string (or nil in case we can’t find it)." + ;; No :feature since the function is autoloaded. + ;; In a sense, this is a lie, but it does just what we want: precompute + ;; the version at compile time and hardcodes it into the .elc file! + (declare (pure t)) + ;; Hack alert! + (let ((file (or (macroexp-file-name) buffer-file-name))) + (cond + ((null file) nil) + ;; Packages are normally installed into directories named "-", + ;; so get the version number from there. + ((string-match + "/[^/]+-\\([0-9]\\(?:[0-9.]\\|pre\\|beta\\|alpha\\|snapshot\\)+\\)/[^/]+\\'" + file) + (match-string 1 file)) + ;; For packages run straight from the an elpa.git clone, there's no + ;; "-" in the directory name, so we have to fetch the version + ;; the hard way. + ((let* ((pkgdir (file-name-directory file)) + (pkgname (file-name-nondirectory (directory-file-name pkgdir))) + (mainfile (expand-file-name (concat pkgname ".el") pkgdir))) + (when (file-readable-p mainfile) + (require 'lisp-mnt) + (with-temp-buffer + (insert-file-contents mainfile) + (or (lm-header "package-version") + (lm-header "version"))))))))) + +;;;; Defined in dired.el + +(compat-defun dired-get-marked-files + (&optional localp arg filter distinguish-one-marked error) + "Obsolete function." + :obsolete "The compatibility function has been made obsolete." + :feature dired + :extended t + (let ((result (dired-get-marked-files localp arg filter distinguish-one-marked))) + (if (and (null result) error) + (user-error (if (stringp error) error "No files specified")) + result))) + +;;;; Defined in time-date.el + +(compat-defun make-decoded-time ;; + (&key second minute hour day month year (dst -1) zone) + "Return a `decoded-time' structure with only the keywords given filled out." + :feature time-date + (list second minute hour day month year nil dst zone)) + +(compat-defun date-days-in-month (year month) ;; + "The number of days in MONTH in YEAR." + :feature time-date + (unless (and (numberp month) + (<= 1 month) + (<= month 12)) + (error "Month %s is invalid" month)) + (if (= month 2) + (if (date-leap-year-p year) + 29 + 28) + (if (memq month '(1 3 5 7 8 10 12)) + 31 + 30))) + +(compat-defun date-ordinal-to-time (year ordinal) ;; + "Convert a YEAR/ORDINAL to the equivalent `decoded-time' structure. +ORDINAL is the number of days since the start of the year, with +January 1st being 1." + (let ((month 1)) + (while (> ordinal (date-days-in-month year month)) + (setq ordinal (- ordinal (date-days-in-month year month)) + month (1+ month))) + (list nil nil nil ordinal month year nil nil nil))) + +;;;; Defined in text-property-search.el + +(declare-function make-prop-match nil) +(compat-guard (not (fboundp 'make-prop-match)) ;; + (cl-defstruct (prop-match) beginning end value)) + +(compat-defun text-property-search-forward ;; + (property &optional value predicate not-current) + "Search for the next region of text where PREDICATE is true. +PREDICATE is used to decide whether a value of PROPERTY should be +considered as matching VALUE. + +If PREDICATE is a function, it will be called with two arguments: +VALUE and the value of PROPERTY. The function should return +non-nil if these two values are to be considered a match. + +Two special values of PREDICATE can also be used: +If PREDICATE is t, that means a value must `equal' VALUE to be +considered a match. +If PREDICATE is nil (which is the default value), a value will +match if is not `equal' to VALUE. Furthermore, a nil PREDICATE +means that the match region is ended if the value changes. For +instance, this means that if you loop with + + (while (setq prop (text-property-search-forward \\='face)) + ...) + +you will get all distinct regions with non-nil `face' values in +the buffer, and the `prop' object will have the details about the +match. See the manual for more details and examples about how +VALUE and PREDICATE interact. + +If NOT-CURRENT is non-nil, the function will search for the first +region that doesn't include point and has a value of PROPERTY +that matches VALUE. + +If no matches can be found, return nil and don't move point. +If found, move point to the end of the region and return a +`prop-match' object describing the match. To access the details +of the match, use `prop-match-beginning' and `prop-match-end' for +the buffer positions that limit the region, and +`prop-match-value' for the value of PROPERTY in the region." + (let* ((match-p + (lambda (prop-value) + (funcall + (cond + ((eq predicate t) + #'equal) + ((eq predicate nil) + (lambda (val p-val) + (not (equal val p-val)))) + (predicate)) + value prop-value))) + (find-end + (lambda (start) + (let (end) + (if (and value + (null predicate)) + ;; This is the normal case: We're looking for areas where the + ;; values aren't, so we aren't interested in sub-areas where the + ;; property has different values, all non-matching value. + (let ((ended nil)) + (while (not ended) + (setq end (next-single-property-change (point) property)) + (if (not end) + (progn + (goto-char (point-max)) + (setq end (point) + ended t)) + (goto-char end) + (unless (funcall match-p (get-text-property (point) property)) + (setq ended t))))) + ;; End this at the first place the property changes value. + (setq end (next-single-property-change (point) property nil (point-max))) + (goto-char end)) + (make-prop-match + :beginning start + :end end + :value (get-text-property start property)))))) + (cond + ;; No matches at the end of the buffer. + ((eobp) + nil) + ;; We're standing in the property we're looking for, so find the + ;; end. + ((and (funcall match-p (get-text-property (point) property)) + (not not-current)) + (funcall find-end (point))) + (t + (let ((origin (point)) + (ended nil) + pos) + ;; Find the next candidate. + (while (not ended) + (setq pos (next-single-property-change (point) property)) + (if (not pos) + (progn + (goto-char origin) + (setq ended t)) + (goto-char pos) + (if (funcall match-p (get-text-property (point) property)) + (setq ended (funcall find-end (point))) + ;; Skip past this section of non-matches. + (setq pos (next-single-property-change (point) property)) + (unless pos + (goto-char origin) + (setq ended t))))) + (and (not (eq ended t)) + ended)))))) + +(compat-defun text-property-search-backward ;; + (property &optional value predicate not-current) + "Search for the previous region of text whose PROPERTY matches VALUE. + +Like `text-property-search-forward', which see, but searches backward, +and if a matching region is found, place point at the start of the region." + (let* ((match-p + (lambda (prop-value) + (funcall + (cond + ((eq predicate t) + #'equal) + ((eq predicate nil) + (lambda (val p-val) + (not (equal val p-val)))) + (predicate)) + value prop-value))) + (find-end + (lambda (start) + (let (end) + (if (and value + (null predicate)) + ;; This is the normal case: We're looking for areas where the + ;; values aren't, so we aren't interested in sub-areas where the + ;; property has different values, all non-matching value. + (let ((ended nil)) + (while (not ended) + (setq end (previous-single-property-change (point) property)) + (if (not end) + (progn + (goto-char (point-min)) + (setq end (point) + ended t)) + (goto-char (1- end)) + (unless (funcall match-p (get-text-property (point) property)) + (goto-char end) + (setq ended t))))) + ;; End this at the first place the property changes value. + (setq end (previous-single-property-change + (point) property nil (point-min))) + (goto-char end)) + (make-prop-match + :beginning end + :end (1+ start) + :value (get-text-property end property)))))) + (cond + ;; We're at the start of the buffer; no previous matches. + ((bobp) + nil) + ;; We're standing in the property we're looking for, so find the + ;; end. + ((funcall match-p (get-text-property (1- (point)) property)) + (let ((origin (point)) + (match (funcall find-end (1- (point)) property value predicate))) + ;; When we want to ignore the current element, then repeat the + ;; search if we haven't moved out of it yet. + (if (and not-current + (equal (get-text-property (point) property) + (get-text-property origin property))) + (text-property-search-backward property value predicate) + match))) + (t + (let ((origin (point)) + (ended nil) + pos) + ;; Find the previous candidate. + (while (not ended) + (setq pos (previous-single-property-change (point) property)) + (if (not pos) + (progn + (goto-char origin) + (setq ended t)) + (goto-char (1- pos)) + (if (funcall match-p (get-text-property (point) property)) + (setq ended + (funcall find-end (point))) + ;; Skip past this section of non-matches. + (setq pos (previous-single-property-change (point) property)) + (unless pos + (goto-char origin) + (setq ended t))))) + (and (not (eq ended t)) + ended)))))) + +;;;; Defined in ring.el + +(compat-defun ring-resize (ring size) ;; + "Set the size of RING to SIZE. +If the new size is smaller, then the oldest items in the ring are +discarded." + :feature ring + (when (integerp size) + (let ((length (ring-length ring)) + (new-vec (make-vector size nil))) + (if (= length 0) + (setcdr ring (cons 0 new-vec)) + (let* ((hd (car ring)) + (old-size (ring-size ring)) + (old-vec (cddr ring)) + (copy-length (min size length)) + (copy-hd (mod (+ hd (- length copy-length)) length))) + (setcdr ring (cons copy-length new-vec)) + ;; If the ring is wrapped, the existing elements must be written + ;; out in the right order. + (dotimes (j copy-length) + (aset new-vec j (aref old-vec (mod (+ copy-hd j) old-size)))) + (setcar ring 0)))))) + +;;;; Defined in map-ynp.el + +(compat-version "26.2") + +(compat-defvar read-answer-short 'auto ;; + "If non-nil, the `read-answer' function accepts single-character answers. +If t, accept short (single key-press) answers to the question. +If nil, require long answers. If `auto', accept short answers if +`use-short-answers' is non-nil, or the function cell of `yes-or-no-p' +is set to `y-or-n-p'. + +Note that this variable does not affect calls to the more +commonly-used `yes-or-no-p' function; it only affects calls to +the `read-answer' function. To control whether `yes-or-no-p' +requires a long or a short answer, see the `use-short-answers' +variable.") + +(compat-defun read-answer (question answers) ;; + "Read an answer either as a complete word or its character abbreviation. +Ask user a question and accept an answer from the list of possible answers. + +QUESTION should end in a space; this function adds a list of answers to it. + +ANSWERS is an alist with elements in the following format: + (LONG-ANSWER SHORT-ANSWER HELP-MESSAGE) +where + LONG-ANSWER is a complete answer, + SHORT-ANSWER is an abbreviated one-character answer, + HELP-MESSAGE is a string describing the meaning of the answer. + +SHORT-ANSWER is not necessarily a single character answer. It can be +also a function key like F1, a character event such as C-M-h, or +a control character like C-h. + +Example: + \\='((\"yes\" ?y \"perform the action\") + (\"no\" ?n \"skip to the next\") + (\"all\" ?! \"accept all remaining without more questions\") + (\"help\" ?h \"show help\") + (\"quit\" ?q \"exit\")) + +When `read-answer-short' is non-nil, accept short answers. + +Return a long answer even in case of accepting short ones. + +When `use-dialog-box' is t, pop up a dialog window to get user input." + ;; NOTE: For simplicity we provide a primitive implementation based on + ;; `read-multiple-choice', which does neither support long answers nor the the + ;; gui dialog box. + (cadr (read-multiple-choice + (string-trim-right question) + (delq nil + (mapcar (lambda (x) (unless (equal "help" (car x)) + (list (cadr x) (car x) (caddr x)))) + answers))))) + +(provide 'compat-27) +;;; compat-27.el ends here diff --git a/elpa/compat-28.1.2.2/compat-28.el b/elpa/compat-29.1.3.4/compat-28.el similarity index 64% rename from elpa/compat-28.1.2.2/compat-28.el rename to elpa/compat-29.1.3.4/compat-28.el index a3dc7693..57a40f71 100644 --- a/elpa/compat-28.1.2.2/compat-28.el +++ b/elpa/compat-29.1.3.4/compat-28.el @@ -1,11 +1,6 @@ -;;; compat-28.el --- Compatibility Layer for Emacs 28.1 -*- lexical-binding: t; -*- +;;; compat-28.el --- Functionality added in Emacs 28.1 -*- lexical-binding: t; -*- -;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. - -;; Author: Philip Kaludercic -;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht> -;; URL: https://git.sr.ht/~pkal/compat/ -;; Keywords: lisp +;; Copyright (C) 2021-2023 Free Software Foundation, Inc. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -22,31 +17,19 @@ ;;; Commentary: -;; Find here the functionality added in Emacs 28.1, needed by older -;; versions. -;; -;; Only load this library if you need to use one of the following -;; functions: -;; -;; - `unlock-buffer' -;; - `string-width' -;; - `directory-files' -;; - `json-serialize' -;; - `json-insert' -;; - `json-parse-string' -;; - `json-parse-buffer' -;; - `count-windows' +;; Functionality added in Emacs 28.1, needed by older Emacs versions. ;;; Code: -(require 'compat-macs "compat-macs.el") +(eval-when-compile (require 'compat-macs)) +(compat-require compat-27 "27.1") -(compat-declare-version "28.1") +(compat-version "28.1") ;;;; Defined in fns.c -;;* INCOMPLETE FEATURE: Should handle multibyte regular expressions -(compat-defun string-search (needle haystack &optional start-pos) +;; FIXME Should handle multibyte regular expressions +(compat-defun string-search (needle haystack &optional start-pos) ;; "Search for the string NEEDLE in the strign HAYSTACK. The return value is the position of the first occurrence of @@ -56,8 +39,9 @@ The optional START-POS argument says where to start searching in HAYSTACK and defaults to zero (start at the beginning). It must be between zero and the length of HAYSTACK, inclusive. -Case is always significant and text properties are ignored." - :note "Prior to Emacs 27 `string-match' has issues handling +Case is always significant and text properties are ignored. + +NOTE: Prior to Emacs 27 `string-match' has issues handling multibyte regular expressions. As the compatibility function for `string-search' is implemented via `string-match', these issues are inherited." @@ -68,7 +52,7 @@ issues are inherited." (let ((case-fold-search nil)) (string-match (regexp-quote needle) haystack start-pos)))) -(compat-defun length= (sequence length) +(compat-defun length= (sequence length) ;; [[compat-tests:length=]] "Returns non-nil if SEQUENCE has a length equal to LENGTH." (cond ((null sequence) (zerop length)) @@ -80,7 +64,7 @@ issues are inherited." (= (length sequence) length)) ((signal 'wrong-type-argument sequence)))) -(compat-defun length< (sequence length) +(compat-defun length< (sequence length) ;; [[compat-tests:length<]] "Returns non-nil if SEQUENCE is shorter than LENGTH." (cond ((null sequence) (not (zerop length))) @@ -90,7 +74,7 @@ issues are inherited." (< (length sequence) length)) ((signal 'wrong-type-argument sequence)))) -(compat-defun length> (sequence length) +(compat-defun length> (sequence length) ;; [[compat-tests:length>]] "Returns non-nil if SEQUENCE is longer than LENGTH." (cond ((listp sequence) @@ -101,62 +85,36 @@ issues are inherited." ;;;; Defined in fileio.c -(compat-defun file-name-concat (directory &rest components) +(compat-defun file-name-concat (directory &rest components) ;; "Append COMPONENTS to DIRECTORY and return the resulting string. Elements in COMPONENTS must be a string or nil. DIRECTORY or the non-final elements in COMPONENTS may or may not end with a slash -- if they don’t end with a slash, a slash will be inserted before contatenating." - (let ((seperator (eval-when-compile + (let ((separator (eval-when-compile (if (memq system-type '(ms-dos windows-nt cygwin)) "\\" "/"))) - (last (if components (car (last components)) directory))) - (mapconcat (lambda (part) - (if (eq part last) ;the last component is not modified - last - (replace-regexp-in-string - (concat seperator "+\\'") "" part))) - (cons directory components) - seperator))) + (components (delq nil + (mapcar (lambda (x) (and (not (equal "" x)) x)) + (cons directory components)))) + (result "")) + (while components + (let ((c (pop components))) + (setq result (concat result c + (and components + (not (string-suffix-p separator c)) + separator))))) + result)) ;;;; Defined in alloc.c -;;* UNTESTED (but also not necessary) -(compat-defun garbage-collect-maybe (_factor) - "Call ‘garbage-collect’ if enough allocation happened. -FACTOR determines what \"enough\" means here: If FACTOR is a -positive number N, it means to run GC if more than 1/Nth of the -allocations needed to trigger automatic allocation took place. -Therefore, as N gets higher, this is more likely to perform a GC. -Returns non-nil if GC happened, and nil otherwise." - :note "For releases of Emacs before version 28, this function will do nothing." - ;; Do nothing - nil) - -;;;; Defined in filelock.c - -(compat-defun unlock-buffer () - "Handle `file-error' conditions: - -Handles file system errors by calling ‘display-warning’ and -continuing as if the error did not occur." - :prefix t - (condition-case error - (unlock-buffer) - (file-error - (display-warning - '(unlock-file) - (message "%s, ignored" (error-message-string error)) - :warning)))) +(compat-defalias garbage-collect-maybe ignore) ;; ;;;; Defined in characters.c -(compat-defun string-width (string &optional from to) - "Handle optional arguments FROM and TO: - -Optional arguments FROM and TO specify the substring of STRING to -consider, and are interpreted as in `substring'." - :prefix t +(compat-defun string-width (string &optional from to) ;; + "Handle optional arguments FROM and TO." + :extended t (let* ((len (length string)) (from (or from 0)) (to (or to len))) @@ -166,80 +124,25 @@ consider, and are interpreted as in `substring'." ;;;; Defined in dired.c -;;* UNTESTED -(compat-defun directory-files (directory &optional full match nosort count) - "Handle additional optional argument COUNT: - -If COUNT is non-nil and a natural number, the function will - return COUNT number of file names (if so many are present)." - :prefix t +(compat-defun directory-files (directory &optional full match nosort count) ;; + "Handle additional optional argument COUNT." + :extended t (let ((files (directory-files directory full match nosort))) (when (natnump count) (setf (nthcdr count files) nil)) files)) -;;;; Defined in json.c - -(declare-function json-insert nil (object &rest args)) -(declare-function json-serialize nil (object &rest args)) -(declare-function json-parse-string nil (string &rest args)) -(declare-function json-parse-buffer nil (&rest args)) - -(compat-defun json-serialize (object &rest args) - "Handle top-level JSON values." - :prefix t - :min-version "27" - (if (or (listp object) (vectorp object)) - (apply #'json-serialize object args) - (substring (json-serialize (list object)) 1 -1))) - -(compat-defun json-insert (object &rest args) - "Handle top-level JSON values." - :prefix t - :min-version "27" - (if (or (listp object) (vectorp object)) - (apply #'json-insert object args) - ;; `compat-json-serialize' is not sharp-quoted as the byte - ;; compiled doesn't always know that the function has been - ;; defined, but it will only be used in this function if the - ;; prefixed definition of `json-serialize' (see above) has also - ;; been defined. - (insert (apply 'compat-json-serialize object args)))) - -(compat-defun json-parse-string (string &rest args) - "Handle top-level JSON values." - :prefix t - :min-version "27" - (if (string-match-p "\\`[[:space:]]*[[{]" string) - (apply #'json-parse-string string args) - ;; Wrap the string in an array, and extract the value back using - ;; `elt', to ensure that no matter what the value of `:array-type' - ;; is we can access the first element. - (elt (apply #'json-parse-string (concat "[" string "]") args) 0))) - -(compat-defun json-parse-buffer (&rest args) - "Handle top-level JSON values." - :prefix t - :min-version "27" - (if (looking-at-p "[[:space:]]*[[{]") - (apply #'json-parse-buffer args) - (catch 'escape - (atomic-change-group - (with-syntax-table - (let ((st (make-syntax-table))) - (modify-syntax-entry ?\" "\"" st) - (modify-syntax-entry ?. "_" st) - st) - (let ((inhibit-read-only t)) - (save-excursion - (insert "[") - (forward-sexp 1) - (insert "]")))) - (throw 'escape (elt (apply #'json-parse-buffer args) 0)))))) +(compat-defun directory-files-and-attributes (directory &optional full match nosort id-format count) ;; + "Handle additional optional argument COUNT." + :extended t + (let ((files (directory-files-and-attributes directory full match nosort id-format))) + (when (natnump count) + (setf (nthcdr count files) nil)) + files)) ;;;; xfaces.c -(compat-defun color-values-from-color-spec (spec) +(compat-defun color-values-from-color-spec (spec) ;; "Parse color SPEC as a numeric color and return (RED GREEN BLUE). This function recognises the following formats for SPEC: @@ -313,10 +216,48 @@ and BLUE, is normalized to have its value in [0,65535]." (<= 0 b) (<= b 65535)) (list r g b)))))))) +;;;; Defined in simple.el + +(compat-defun make-separator-line (&optional length) ;; + "Make a string appropriate for usage as a visual separator line. +If LENGTH is nil, use the window width." + (concat (propertize (make-string (or length (1- (window-width))) ?-) + 'face 'separator-line) + "\n")) + ;;;; Defined in subr.el -;;* INCOMPLETE FEATURE: Should handle multibyte regular expressions -(compat-defun string-replace (fromstring tostring instring) +(compat-defun process-lines-handling-status (program status-handler &rest args) ;; + "Execute PROGRAM with ARGS, returning its output as a list of lines. +If STATUS-HANDLER is non-nil, it must be a function with one +argument, which will be called with the exit status of the +program before the output is collected. If STATUS-HANDLER is +nil, an error is signaled if the program returns with a non-zero +exit status." + (with-temp-buffer + (let ((status (apply #'call-process program nil (current-buffer) nil args))) + (if status-handler + (funcall status-handler status) + (unless (eq status 0) + (error "%s exited with status %s" program status))) + (goto-char (point-min)) + (let (lines) + (while (not (eobp)) + (setq lines (cons (buffer-substring-no-properties + (line-beginning-position) + (line-end-position)) + lines)) + (forward-line 1)) + (nreverse lines))))) + +(compat-defun process-lines-ignore-status (program &rest args) ;; + "Execute PROGRAM with ARGS, returning its output as a list of lines. +The exit status of the program is ignored. +Also see `process-lines'." + (apply 'process-lines-handling-status program #'ignore args)) + +;; FIXME Should handle multibyte regular expressions +(compat-defun string-replace (fromstring tostring instring) ;; "Replace FROMSTRING with TOSTRING in INSTRING each time it occurs." (when (equal fromstring "") (signal 'wrong-length-argument '(0))) @@ -326,14 +267,13 @@ and BLUE, is normalized to have its value in [0,65535]." tostring instring t t))) -(compat-defun always (&rest _arguments) +(compat-defun always (&rest _arguments) ;; "Do nothing and return t. This function accepts any number of ARGUMENTS, but ignores them. Also see `ignore'." t) -;;* UNTESTED -(compat-defun insert-into-buffer (buffer &optional start end) +(compat-defun insert-into-buffer (buffer &optional start end) ;; "Insert the contents of the current buffer into BUFFER. If START/END, only insert that region from the current buffer. Point in BUFFER will be placed after the inserted text." @@ -341,8 +281,7 @@ Point in BUFFER will be placed after the inserted text." (with-current-buffer buffer (insert-buffer-substring current start end)))) -;;* UNTESTED -(compat-defun replace-string-in-region (string replacement &optional start end) +(compat-defun replace-string-in-region (string replacement &optional start end) ;; "Replace STRING with REPLACEMENT in the region from START to END. The number of replaced occurrences are returned, or nil if STRING doesn't exist in the region. @@ -359,18 +298,19 @@ Comparisons and replacements are done with fixed case." (error "End after end of buffer")) (setq end (point-max))) (save-excursion - (let ((matches 0) - (case-fold-search nil)) - (goto-char start) - (while (search-forward string end t) - (delete-region (match-beginning 0) (match-end 0)) - (insert replacement) - (setq matches (1+ matches))) - (and (not (zerop matches)) - matches)))) - -;;* UNTESTED -(compat-defun replace-regexp-in-region (regexp replacement &optional start end) + (goto-char start) + (save-restriction + (narrow-to-region start end) + (let ((matches 0) + (case-fold-search nil)) + (while (search-forward string nil t) + (delete-region (match-beginning 0) (match-end 0)) + (insert replacement) + (setq matches (1+ matches))) + (and (not (zerop matches)) + matches))))) + +(compat-defun replace-regexp-in-region (regexp replacement &optional start end) ;; "Replace REGEXP with REPLACEMENT in the region from START to END. The number of replaced occurrences are returned, or nil if REGEXP doesn't exist in the region. @@ -395,17 +335,18 @@ REPLACEMENT can use the following special elements: (error "End after end of buffer")) (setq end (point-max))) (save-excursion - (let ((matches 0) - (case-fold-search nil)) - (goto-char start) - (while (re-search-forward regexp end t) - (replace-match replacement t) - (setq matches (1+ matches))) - (and (not (zerop matches)) - matches)))) - -;;* UNTESTED -(compat-defun buffer-local-boundp (symbol buffer) + (goto-char start) + (save-restriction + (narrow-to-region start end) + (let ((matches 0) + (case-fold-search nil)) + (while (re-search-forward regexp nil t) + (replace-match replacement t) + (setq matches (1+ matches))) + (and (not (zerop matches)) + matches))))) + +(compat-defun buffer-local-boundp (symbol buffer) ;; "Return non-nil if SYMBOL is bound in BUFFER. Also see `local-variable-p'." (catch 'fail @@ -414,26 +355,23 @@ Also see `local-variable-p'." (void-variable nil (throw 'fail nil))) t)) -;;* UNTESTED -(compat-defmacro with-existing-directory (&rest body) +(compat-defmacro with-existing-directory (&rest body) ;; "Execute BODY with `default-directory' bound to an existing directory. If `default-directory' is already an existing directory, it's not changed." (declare (indent 0) (debug t)) - (let ((quit (make-symbol "with-existing-directory-quit"))) - `(catch ',quit - (dolist (dir (list default-directory - (expand-file-name "~/") - (getenv "TMPDIR") - "/tmp/" - ;; XXX: check if "/" works on non-POSIX - ;; system. - "/")) - (when (and dir (file-exists-p dir)) - (throw ',quit (let ((default-directory dir)) - ,@body))))))) - -;;* UNTESTED -(compat-defmacro dlet (binders &rest body) + `(let ((default-directory + (or (catch 'quit + (dolist (dir (list default-directory + (expand-file-name "~/") + temporary-file-directory + (getenv "TMPDIR") + "/tmp/")) + (when (and dir (file-exists-p dir)) + (throw 'quit dir)))) + "/"))) + ,@body)) + +(compat-defmacro dlet (binders &rest body) ;; "Like `let' but using dynamic scoping." (declare (indent 1) (debug let)) `(let (_) @@ -442,7 +380,7 @@ If `default-directory' is already an existing directory, it's not changed." binders) (let ,binders ,@body))) -(compat-defun ensure-list (object) +(compat-defun ensure-list (object) ;; "Return OBJECT as a list. If OBJECT is already a list, return OBJECT itself. If it's not a list, return a one-element list containing OBJECT." @@ -450,18 +388,19 @@ not a list, return a one-element list containing OBJECT." object (list object))) -(compat-defun subr-primitive-p (object) - "Return t if OBJECT is a built-in primitive function." - (subrp object)) +(compat-defalias subr-primitive-p subrp) ;; + +;;;; Defined in data.c + +(compat-defalias subr-native-elisp-p ignore) ;; ;;;; Defined in subr-x.el -(compat-defun string-clean-whitespace (string) +(compat-defun string-clean-whitespace (string) ;; "Clean up whitespace in STRING. All sequences of whitespaces in STRING are collapsed into a single space character, and leading/trailing whitespace is removed." - :feature 'subr-x (let ((blank "[[:blank:]\r\n]+")) (replace-regexp-in-string "^[[:blank:]\r\n]+\\|[[:blank:]\r\n]+$" @@ -469,12 +408,11 @@ removed." (replace-regexp-in-string blank " " string)))) -(compat-defun string-fill (string length) +(compat-defun string-fill (string length) ;; "Clean up whitespace in STRING. All sequences of whitespaces in STRING are collapsed into a single space character, and leading/trailing whitespace is removed." - :feature 'subr-x (with-temp-buffer (insert string) (goto-char (point-min)) @@ -483,13 +421,7 @@ removed." (fill-region (point-min) (point-max))) (buffer-string))) -(compat-defun string-lines (string &optional omit-nulls) - "Split STRING into a list of lines. -If OMIT-NULLS, empty lines will be removed from the results." - :feature 'subr-x - (split-string string "\n" omit-nulls)) - -(compat-defun string-pad (string length &optional padding start) +(compat-defun string-pad (string length &optional padding start) ;; "Pad STRING to LENGTH using PADDING. If PADDING is nil, the space character is used. If not nil, it should be a character. @@ -500,7 +432,6 @@ is done. If START is nil (or not present), the padding is done to the end of the string, and if non-nil, padding is done to the start of the string." - :feature 'subr-x (unless (natnump length) (signal 'wrong-type-argument (list 'natnump length))) (let ((pad-length (- length (length string)))) @@ -512,20 +443,18 @@ the string." (and (not start) (make-string pad-length (or padding ?\s))))))) -(compat-defun string-chop-newline (string) +(compat-defun string-chop-newline (string) ;; "Remove the final newline (if any) from STRING." - :feature 'subr-x (if (and (>= (length string) 1) (= (aref string (1- (length string))) ?\n)) (substring string 0 -1) string)) -(compat-defmacro named-let (name bindings &rest body) +(compat-defmacro named-let (name bindings &rest body) ;; "Looping construct taken from Scheme. Like `let', bind variables in BINDINGS and then evaluate BODY, but with the twist that BODY can evaluate itself recursively by calling NAME, where the arguments passed to NAME are used as the new values of the bound variables in the recursive invocation." - :feature 'subr-x (declare (indent 2) (debug (symbolp (&rest (symbolp form)) body))) (let ((fargs (mapcar (lambda (b) (let ((var (if (consp b) (car b) b))) @@ -596,10 +525,9 @@ as the new values of the bound variables in the recursive invocation." sets)) (cons 'setq (apply #'nconc (nreverse sets))))) (`(throw ',quit ,expr)))))) - (let ((tco-body (funcall tco (macroexpand-all (macroexp-progn body))))) - (when tco-body - (setq body `((catch ',quit - (while t (let ,rargs ,@(macroexp-unprogn tco-body)))))))) + (when-let ((tco-body (funcall tco (macroexpand-all (macroexp-progn body))))) + (setq body `((catch ',quit + (while t (let ,rargs ,@(macroexp-unprogn tco-body))))))) (let ((expand (macroexpand-all (macroexp-progn body) (list (cons name macro))))) (if total-tco `(let ,bindings ,expand) @@ -609,9 +537,7 @@ as the new values of the bound variables in the recursive invocation." ;;;; Defined in files.el -(declare-function compat--string-trim-left "compat-26" (string &optional regexp)) -(declare-function compat--directory-name-p "compat-25" (name)) -(compat-defun file-name-with-extension (filename extension) +(compat-defun file-name-with-extension (filename extension) ;; "Set the EXTENSION of a FILENAME. The extension (in a file name) is the part that begins with the last \".\". @@ -622,19 +548,18 @@ Errors if the FILENAME or EXTENSION are empty, or if the given FILENAME has the format of a directory. See also `file-name-sans-extension'." - (let ((extn (compat--string-trim-left extension "[.]"))) + (let ((extn (string-remove-prefix "." extension))) (cond ((string= filename "") (error "Empty filename")) ((string= extn "") (error "Malformed extension: %s" extension)) - ((compat--directory-name-p filename) + ((directory-name-p filename) (error "Filename is a directory: %s" filename)) (t (concat (file-name-sans-extension filename) "." extn))))) -;;* UNTESTED -(compat-defun directory-empty-p (dir) +(compat-defun directory-empty-p (dir) ;; "Return t if DIR names an existing directory containing no other files. Return nil if DIR does not name a directory, or if there was trouble determining whether DIR is a directory or empty. @@ -644,7 +569,7 @@ See `file-symlink-p' to distinguish symlinks." (and (file-directory-p dir) (null (directory-files dir nil directory-files-no-dot-files-regexp t)))) -(compat-defun file-modes-number-to-symbolic (mode &optional filetype) +(compat-defun file-modes-number-to-symbolic (mode &optional filetype) ;; "Return a string describing a file's MODE. For instance, if MODE is #o700, then it produces `-rwx------'. FILETYPE if provided should be a character denoting the type of file, @@ -652,7 +577,7 @@ such as `?d' for a directory, or `?l' for a symbolic link and will override the leading `-' char." (string (or filetype - (pcase (lsh mode -12) + (pcase (ash mode -12) ;; POSIX specifies that the file type is included in st_mode ;; and provides names for the file types but values only for ;; the permissions (e.g., S_IWOTH=2). @@ -682,8 +607,7 @@ the leading `-' char." (if (zerop (logand 1 mode)) ?- ?x) (if (zerop (logand 1 mode)) ?T ?t)))) -;;* UNTESTED -(compat-defun file-backup-file-names (filename) +(compat-defun file-backup-file-names (filename) ;; "Return a list of backup files for FILENAME. The list will be sorted by modification time so that the most recent files are first." @@ -702,7 +626,7 @@ recent files are first." (push candidate files)))) (sort files #'file-newer-than-file-p))) -(compat-defun make-lock-file-name (filename) +(compat-defun make-lock-file-name (filename) ;; "Make a lock file name for FILENAME. This prepends \".#\" to the non-directory part of FILENAME, and doesn't respect `lock-file-name-transforms', as Emacs 28.1 and @@ -712,21 +636,9 @@ onwards does." ".#" (file-name-nondirectory filename)) (file-name-directory filename))) -;;;; Defined in files-x.el - -(declare-function tramp-tramp-file-p "tramp" (name)) - -;;* UNTESTED -(compat-defun null-device () - "Return the best guess for the null device." - (require 'tramp) - (if (tramp-tramp-file-p default-directory) - "/dev/null" - null-device)) - ;;;; Defined in minibuffer.el -(compat-defun format-prompt (prompt default &rest format-args) +(compat-defun format-prompt (prompt default &rest format-args) ;; "Format PROMPT with DEFAULT. If FORMAT-ARGS is nil, PROMPT is used as a plain string. If FORMAT-ARGS is non-nil, PROMPT is used as a format control @@ -751,15 +663,56 @@ is included in the return value." default))) ": ")) -;;;; Defined in windows.el - -;;* UNTESTED -(compat-defun count-windows (&optional minibuf all-frames) - "Handle optional argument ALL-FRAMES: - -If ALL-FRAMES is non-nil, count the windows in all frames instead -just the selected frame." - :prefix t +;;;; Defined in faces.el + +(compat-defvar color-luminance-dark-limit 0.325 ;; + "The relative luminance below which a color is considered \"dark\". +A \"dark\" color in this sense provides better contrast with white +than with black; see `color-dark-p'. +This value was determined experimentally." + :constant t) + +(compat-defun color-dark-p (rgb) ;; + "Whether RGB is more readable against white than black. +RGB is a 3-element list (R G B), each component in the range [0,1]. +This predicate can be used both for determining a suitable (black or white) +contrast color with RGB as background and as foreground." + (unless (<= 0 (apply #'min rgb) (apply #'max rgb) 1) + (error "RGB components %S not in [0,1]" rgb)) + ;; Compute the relative luminance after gamma-correcting (assuming sRGB), + ;; and compare to a cut-off value determined experimentally. + ;; See https://en.wikipedia.org/wiki/Relative_luminance for details. + (let* ((sr (nth 0 rgb)) + (sg (nth 1 rgb)) + (sb (nth 2 rgb)) + ;; Gamma-correct the RGB components to linear values. + ;; Use the power 2.2 as an approximation to sRGB gamma; + ;; it should be good enough for the purpose of this function. + (r (expt sr 2.2)) + (g (expt sg 2.2)) + (b (expt sb 2.2)) + (y (+ (* r 0.2126) (* g 0.7152) (* b 0.0722)))) + (< y color-luminance-dark-limit))) + +;;;; Defined in window.el + +(compat-defmacro with-window-non-dedicated (window &rest body) ;; + "Evaluate BODY with WINDOW temporarily made non-dedicated. +If WINDOW is nil, use the selected window. Return the value of +the last form in BODY." + (declare (indent 1) (debug t)) + (let ((window-dedicated-sym (gensym)) + (window-sym (gensym))) + `(let* ((,window-sym (window-normalize-window ,window t)) + (,window-dedicated-sym (window-dedicated-p ,window-sym))) + (set-window-dedicated-p ,window-sym nil) + (unwind-protect + (progn ,@body) + (set-window-dedicated-p ,window-sym ,window-dedicated-sym))))) + +(compat-defun count-windows (&optional minibuf all-frames) ;; + "Handle optional argument ALL-FRAMES." + :extended t (if all-frames (let ((sum 0)) (dolist (frame (frame-list)) @@ -770,37 +723,61 @@ just the selected frame." ;;;; Defined in thingatpt.el -(declare-function mouse-set-point "mouse" (event &optional promote-to-region)) - -;;* UNTESTED -(compat-defun thing-at-mouse (event thing &optional no-properties) +(compat-defun thing-at-mouse (event thing &optional no-properties) ;; "Return the THING at mouse click. Like `thing-at-point', but tries to use the event where the mouse button is clicked to find a thing nearby." - :feature 'thingatpt + ;; No :feature specified, since the function is autoloaded. (save-excursion (mouse-set-point event) (thing-at-point thing no-properties))) +(compat-defun bounds-of-thing-at-mouse (event thing) ;; + "Determine start and end locations for THING at mouse click given by EVENT. +Like `bounds-of-thing-at-point', but tries to use the position in EVENT +where the mouse button is clicked to find the thing nearby." + ;; No :feature specified, since the function is autoloaded. + (save-excursion + (mouse-set-point event) + (bounds-of-thing-at-point thing))) + +;;;; Defined in mouse.el + +(compat-defun mark-thing-at-mouse (click thing) ;; + "Activate the region around THING found near the mouse CLICK." + (when-let ((bounds (bounds-of-thing-at-mouse click thing))) + (goto-char (if mouse-select-region-move-to-beginning + (car bounds) (cdr bounds))) + (push-mark (if mouse-select-region-move-to-beginning + (cdr bounds) (car bounds)) + t 'activate))) + ;;;; Defined in macroexp.el -;;* UNTESTED -(compat-defun macroexp-file-name () +(compat-defun macroexp-warn-and-return (msg form &optional _category _compile-only _arg) ;; + "Return code equivalent to FORM labeled with warning MSG. +CATEGORY is the category of the warning, like the categories that +can appear in `byte-compile-warnings'. +COMPILE-ONLY non-nil means no warning should be emitted if the code +is executed without being compiled first. +ARG is a symbol (or a form) giving the source code position for the message. +It should normally be a symbol with position and it defaults to FORM." + (macroexp--warn-and-return msg form)) + +(compat-defun macroexp-file-name () ;; "Return the name of the file from which the code comes. Returns nil when we do not know. A non-nil result is expected to be reliable when called from a macro in order to find the file in which the macro's call was found, and it should be reliable as well when used at the top-level of a file. Other uses risk returning non-nil value that point to the wrong file." - :feature 'macroexp (let ((file (car (last current-load-list)))) (or (if (stringp file) file) (bound-and-true-p byte-compile-current-file)))) ;;;; Defined in env.el -;;* UNTESTED -(compat-defmacro with-environment-variables (variables &rest body) +(compat-defmacro with-environment-variables (variables &rest body) ;; "Set VARIABLES in the environent and execute BODY. VARIABLES is a list of variable settings of the form (VAR VALUE), where VAR is the name of the variable (a string) and VALUE @@ -816,67 +793,45 @@ The previous values will be be restored upon exit." variables) ,@body)) -;;;; Defined in button.el - -;;* UNTESTED -(compat-defun button-buttonize (string callback &optional data) - "Make STRING into a button and return it. -When clicked, CALLBACK will be called with the DATA as the -function argument. If DATA isn't present (or is nil), the button -itself will be used instead as the function argument." - :feature 'button - (propertize string - 'face 'button - 'button t - 'follow-link t - 'category t - 'button-data data - 'keymap button-map - 'action callback)) - -;;;; Defined in autoload.el - -(defvar generated-autoload-file) - -;;* UNTESTED -(compat-defun make-directory-autoloads (dir output-file) - "Update autoload definitions for Lisp files in the directories DIRS. -DIR can be either a single directory or a list of -directories. (The latter usage is discouraged.) - -The autoloads will be written to OUTPUT-FILE. If any Lisp file -binds `generated-autoload-file' as a file-local variable, write -its autoloads into the specified file instead. - -The function does NOT recursively descend into subdirectories of the -directory or directories specified." - (let ((generated-autoload-file output-file)) - ;; We intentionally don't sharp-quote - ;; `update-directory-autoloads', because it was deprecated in - ;; Emacs 28 and we don't want to trigger the byte compiler for - ;; newer versions. - (apply 'update-directory-autoloads - (if (listp dir) dir (list dir))))) - ;;;; Defined in time-data.el -(compat-defun decoded-time-period (time) +(compat-defun decoded-time-period (time) ;; "Interpret DECODED as a period and return its length in seconds. For computational purposes, years are 365 days long and months are 30 days long." - :feature 'time-date - :version "28" - ;; Inlining the definitions from compat-27 - (+ (if (consp (nth 0 time)) - ;; Fractional second. - (/ (float (car (nth 0 time))) - (cdr (nth 0 time))) - (or (nth 0 time) 0)) - (* (or (nth 1 time) 0) 60) - (* (or (nth 2 time) 0) 60 60) - (* (or (nth 3 time) 0) 60 60 24) - (* (or (nth 4 time) 0) 60 60 24 30) - (* (or (nth 5 time) 0) 60 60 24 365))) - -(compat--inhibit-prefixed (provide 'compat-28)) + :feature time-date + (+ (if (consp (decoded-time-second time)) + (/ (float (car (decoded-time-second time))) + (cdr (decoded-time-second time))) + (or (decoded-time-second time) 0)) + (* (or (decoded-time-minute time) 0) 60) + (* (or (decoded-time-hour time) 0) 60 60) + (* (or (decoded-time-day time) 0) 60 60 24) + (* (or (decoded-time-month time) 0) 60 60 24 30) + (* (or (decoded-time-year time) 0) 60 60 24 365))) + +;;;; Defined in doc.c + +(compat-defun text-quoting-style () ;; + "Return the current effective text quoting style. +If the variable `text-quoting-style' is `grave', `straight' or +`curve', just return that value. If it is nil (the default), return +`grave' if curved quotes cannot be displayed (for instance, on a +terminal with no support for these characters), otherwise return +`quote'. Any other value is treated as `grave'. + +Note that in contrast to the variable `text-quoting-style', this +function will never return nil." + (cond + ((memq text-quoting-style '(grave straight curve)) + text-quoting-style) + ((not text-quoting-style) 'grave) + (t 'curve))) + +;;;; Defined in button.el + +;; Obsolete Alias since 29 +(compat-defalias button-buttonize buttonize :obsolete t) ;; + +(provide 'compat-28) ;;; compat-28.el ends here diff --git a/elpa/compat-29.1.3.4/compat-29.el b/elpa/compat-29.1.3.4/compat-29.el new file mode 100644 index 00000000..9cf4a769 --- /dev/null +++ b/elpa/compat-29.1.3.4/compat-29.el @@ -0,0 +1,1503 @@ +;;; compat-29.el --- Functionality added in Emacs 29.1 -*- lexical-binding: t; -*- + +;; Copyright (C) 2021-2023 Free Software Foundation, Inc. + +;; 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 . + +;;; Commentary: + +;; Functionality added in Emacs 29.1, needed by older Emacs versions. + +;;; Code: + +(eval-when-compile (require 'compat-macs)) +(compat-require compat-28 "28.1") + +;; Preloaded in loadup.el +;; TODO Update to 29.1 as soon as the Emacs emacs-29 branch version bumped +(compat-require seq "29.0") ;; + +;; TODO Update to 29.1 as soon as the Emacs emacs-29 branch version bumped +(compat-version "29.0") + +;;;; Defined in xdisp.c + +(compat-defun get-display-property (position prop &optional object properties) ;; + "Get the value of the `display' property PROP at POSITION. +If OBJECT, this should be a buffer or string where the property is +fetched from. If omitted, OBJECT defaults to the current buffer. + +If PROPERTIES, look for value of PROP in PROPERTIES instead of +the properties at POSITION." + (if properties + (unless (listp properties) + (signal 'wrong-type-argument (list 'listp properties))) + (setq properties (get-text-property position 'display object))) + (cond + ((vectorp properties) + (catch 'found + (dotimes (i (length properties)) + (let ((ent (aref properties i))) + (when (eq (car ent) prop) + (throw 'found (cadr ent ))))))) + ((consp (car properties)) + (condition-case nil + (cadr (assq prop properties)) + ;; Silently handle improper lists: + (wrong-type-argument nil))) + ((and (consp (cdr properties)) + (eq (car properties) prop)) + (cadr properties)))) + +;;;; Defined in fns.c + +(compat-defun ntake (n list) ;; + "Modify LIST to keep only the first N elements. +If N is zero or negative, return nil. +If N is greater or equal to the length of LIST, return LIST unmodified. +Otherwise, return LIST after truncating it." + (and (> n 0) (let ((cons (nthcdr (1- n) list))) + (when cons (setcdr cons nil)) + list))) + +(compat-defun take (n list) ;; + "Return the first N elements of LIST. +If N is zero or negative, return nil. +If N is greater or equal to the length of LIST, return LIST (or a copy)." + (declare (pure t) (side-effect-free t)) + (let (copy) + (while (and (< 0 n) list) + (push (pop list) copy) + (setq n (1- n))) + (nreverse copy))) + +(compat-defun string-equal-ignore-case (string1 string2) ;; + "Like `string-equal', but case-insensitive. +Upper-case and lower-case letters are treated as equal. +Unibyte strings are converted to multibyte for comparison." + (declare (pure t) (side-effect-free t)) + (eq t (compare-strings string1 0 nil string2 0 nil t))) + +(compat-defun plist-get (plist prop &optional predicate) ;; + "Handle optional argument PREDICATE." + :extended t + (if (or (null predicate) (eq predicate 'eq)) + (plist-get plist prop) + (catch 'found + (while (consp plist) + (when (funcall predicate prop (car plist)) + (throw 'found (cadr plist))) + (setq plist (cddr plist)))))) + +(compat-defun plist-put (plist prop val &optional predicate) ;; + "Handle optional argument PREDICATE." + :extended t + (if (or (null predicate) (eq predicate 'eq)) + (plist-put plist prop val) + (catch 'found + (let ((tail plist)) + (while (consp tail) + (when (funcall predicate prop (car tail)) + (setcar (cdr tail) val) + (throw 'found plist)) + (setq tail (cddr tail)))) + (nconc plist (list prop val))))) + +(compat-defun plist-member (plist prop &optional predicate) ;; + "Handle optional argument PREDICATE." + :extended t + (if (or (null predicate) (eq predicate 'eq)) + (plist-member plist prop) + (catch 'found + (while (consp plist) + (when (funcall predicate prop (car plist)) + (throw 'found plist)) + (setq plist (cddr plist)))))) + +;;;; Defined in gv.el + +(compat-guard t ;; + (gv-define-expander compat--plist-get + (lambda (do plist prop &optional predicate) + (macroexp-let2 macroexp-copyable-p key prop + (gv-letplace (getter setter) plist + (macroexp-let2 nil p `(cdr (compat--plist-member ,getter ,key ,predicate)) + (funcall do + `(car ,p) + (lambda (val) + `(if ,p + (setcar ,p ,val) + ,(funcall setter + `(cons ,key (cons ,val ,getter))))))))))) + (unless (get 'plist-get 'gv-expander) + (put 'plist-get 'gv-expander (get 'compat--plist-get 'gv-expander)))) + +;;;; Defined in editfns.c + +(compat-defun pos-bol (&optional n) ;; + "Return the position of the first character on the current line. +With optional argument N, scan forward N - 1 lines first. +If the scan reaches the end of the buffer, return that position. + +This function ignores text display directionality; it returns the +position of the first character in logical order, i.e. the smallest +character position on the logical line. See `vertical-motion' for +movement by screen lines. + +This function does not move point. Also see `line-beginning-position'." + (declare (side-effect-free t)) + (let ((inhibit-field-text-motion t)) + (line-beginning-position n))) + +(compat-defun pos-eol (&optional n) ;; + "Return the position of the last character on the current line. +With argument N not nil or 1, move forward N - 1 lines first. +If scan reaches end of buffer, return that position. + +This function ignores text display directionality; it returns the +position of the last character in logical order, i.e. the largest +character position on the line. + +This function does not move point. Also see `line-end-position'." + (declare (side-effect-free t)) + (let ((inhibit-field-text-motion t)) + (line-end-position n))) + +;;;; Defined in subr.el + +(compat-defmacro with-delayed-message (_args &rest body) ;; + "Like `progn', but display MESSAGE if BODY takes longer than TIMEOUT seconds. +The MESSAGE form will be evaluated immediately, but the resulting +string will be displayed only if BODY takes longer than TIMEOUT seconds. + +NOTE: The compatibility function never displays the message, +which is not problematic since the only effect of the function is +to display a progress message to the user. Backporting this +feature is not possible, since the implementation is directly +baked into the Elisp interpreter. + +\(fn (timeout message) &rest body)" + (declare (indent 1)) + (macroexp-progn body)) + +(compat-defun funcall-with-delayed-message (timeout message function) ;; + "Like `funcall', but display MESSAGE if FUNCTION takes longer than TIMEOUT. +TIMEOUT is a number of seconds, and can be an integer or a +floating point number. If FUNCTION takes less time to execute +than TIMEOUT seconds, MESSAGE is not displayed. + +NOTE: The compatibility function never displays the message, +which is not problematic since the only effect of the function is +to display a progress message to the user. Backporting this +feature is not possible, since the implementation is directly +baked into the Elisp interpreter." + (ignore timeout message) + (funcall function)) + +(compat-defun string-lines (string &optional omit-nulls keep-newlines) ;; + "Handle additional KEEP-NEWLINES argument." + :extended "28.1" + (if (equal string "") + (if omit-nulls + nil + (list "")) + (let ((lines nil) + (start 0)) + (while (< start (length string)) + (let ((newline (string-search "\n" string start))) + (if newline + (progn + (when (or (not omit-nulls) + (not (= start newline))) + (let ((line (substring string start + (if keep-newlines + (1+ newline) + newline)))) + (when (not (and keep-newlines omit-nulls + (equal line "\n"))) + (push line lines)))) + (setq start (1+ newline))) + (if (zerop start) + (push string lines) + (push (substring string start) lines)) + (setq start (length string))))) + (nreverse lines)))) + +(compat-defun readablep (object) ;; + "Say whether OBJECT has a readable syntax. +This means that OBJECT can be printed out and then read back +again by the Lisp reader. This function returns nil if OBJECT is +unreadable, and the printed representation (from `prin1') of +OBJECT if it is readable." + (declare (side-effect-free error-free)) + (ignore-errors (equal object (read (prin1-to-string object))))) + +(compat-defun buffer-local-restore-state (states) ;; + "Restore values of buffer-local variables recorded in STATES. +STATES should be an object returned by `buffer-local-set-state'." + (dolist (state states) + (if (cadr state) + (set (car state) (caddr state)) + (kill-local-variable (car state))))) + +(compat-defun buffer-local-set-state--get (pairs) ;; + "Internal helper function." + (let ((states nil)) + (while pairs + (push (list (car pairs) + (and (boundp (car pairs)) + (local-variable-p (car pairs))) + (and (boundp (car pairs)) + (symbol-value (car pairs)))) + states) + (setq pairs (cddr pairs))) + (nreverse states))) + +(compat-defmacro buffer-local-set-state (&rest pairs) ;; + "Like `setq-local', but allow restoring the previous state of locals later. +This macro returns an object that can be passed to `buffer-local-restore-state' +in order to restore the state of the local variables set via this macro. + +\(fn [VARIABLE VALUE]...)" + (declare (debug setq)) + (unless (zerop (mod (length pairs) 2)) + (error "PAIRS must have an even number of variable/value members")) + `(prog1 + (buffer-local-set-state--get ',pairs) + (,(if (fboundp 'compat--setq-local) 'compat--setq-local 'setq-local) + ,@pairs))) + +(compat-defun list-of-strings-p (object) ;; + "Return t if OBJECT is nil or a list of strings." + (declare (pure t) (side-effect-free t)) + (while (and (consp object) (stringp (car object))) + (setq object (cdr object))) + (null object)) + +(compat-defun plistp (object) ;; + "Non-nil if and only if OBJECT is a valid plist." + (let ((len (proper-list-p object))) + (and len (zerop (% len 2))))) + +(compat-defun delete-line () ;; + "Delete the current line." + (delete-region (pos-bol) (pos-bol 2))) + +(compat-defmacro with-narrowing (start end &rest rest) ;; + "Execute BODY with restrictions set to START and END. + +The current restrictions, if any, are restored upon return. + +With the optional :locked TAG argument, inside BODY, +`narrow-to-region' and `widen' can be used only within the START +and END limits, unless the restrictions are unlocked by calling +`narrowing-unlock' with TAG. See `narrowing-lock' for a more +detailed description. + +\(fn START END [:locked TAG] BODY)" + `(save-restriction + (narrow-to-region ,start ,end) + ;; Locking is ignored + ,@(if (eq (car rest) :locked) (cddr rest) rest))) + +(compat-defmacro with-memoization (place &rest code) ;; + "Return the value of CODE and stash it in PLACE. +If PLACE's value is non-nil, then don't bother evaluating CODE +and return the value found in PLACE instead." + (declare (indent 1)) + (gv-letplace (getter setter) place + `(or ,getter + ,(macroexp-let2 nil val (macroexp-progn code) + `(progn + ,(funcall setter val) + ,val))))) + +(compat-defalias string-split split-string) ;; + +(compat-defun compiled-function-p (object) ;; + "Return non-nil if OBJECT is a function that has been compiled. +Does not distinguish between functions implemented in machine code +or byte-code." + (or (subrp object) (byte-code-function-p object))) + +(compat-defun function-alias-p (func &optional noerror) ;; + "Return nil if FUNC is not a function alias. +If FUNC is a function alias, return the function alias chain. + +If the function alias chain contains loops, an error will be +signalled. If NOERROR, the non-loop parts of the chain is returned." + (declare (side-effect-free t)) + (let ((chain nil) + (orig-func func)) + (nreverse + (catch 'loop + (while (and (symbolp func) + (setq func (symbol-function func)) + (symbolp func)) + (when (or (memq func chain) + (eq func orig-func)) + (if noerror + (throw 'loop chain) + (signal 'cyclic-function-indirection (list orig-func)))) + (push func chain)) + chain)))) + +(compat-defun buffer-match-p (condition buffer-or-name &optional arg) ;; + "Return non-nil if BUFFER-OR-NAME matches CONDITION. +CONDITION is either: +- the symbol t, to always match, +- the symbol nil, which never matches, +- a regular expression, to match a buffer name, +- a predicate function that takes a buffer object and ARG as + arguments, and returns non-nil if the buffer matches, +- a cons-cell, where the car describes how to interpret the cdr. + The car can be one of the following: + * `derived-mode': the buffer matches if the buffer's major mode + is derived from the major mode in the cons-cell's cdr. + * `major-mode': the buffer matches if the buffer's major mode + is eq to the cons-cell's cdr. Prefer using `derived-mode' + instead when both can work. + * `not': the cadr is interpreted as a negation of a condition. + * `and': the cdr is a list of recursive conditions, that all have + to be met. + * `or': the cdr is a list of recursive condition, of which at + least one has to be met." + (letrec + ((buffer (get-buffer buffer-or-name)) + (match + (lambda (conditions) + (catch 'match + (dolist (condition conditions) + (when (cond + ((eq condition t)) + ((stringp condition) + (string-match-p condition (buffer-name buffer))) + ((functionp condition) + (condition-case nil + (funcall condition buffer) + (wrong-number-of-arguments + (funcall condition buffer arg)))) + ((eq (car-safe condition) 'major-mode) + (eq + (buffer-local-value 'major-mode buffer) + (cdr condition))) + ((eq (car-safe condition) 'derived-mode) + (provided-mode-derived-p + (buffer-local-value 'major-mode buffer) + (cdr condition))) + ((eq (car-safe condition) 'not) + (not (funcall match (cdr condition)))) + ((eq (car-safe condition) 'or) + (funcall match (cdr condition))) + ((eq (car-safe condition) 'and) + (catch 'fail + (dolist (c (cdr condition)) + (unless (funcall match (list c)) + (throw 'fail nil))) + t))) + (throw 'match t))))))) + (funcall match (list condition)))) + +(compat-defun match-buffers (condition &optional buffers arg) ;; + "Return a list of buffers that match CONDITION. +See `buffer-match' for details on CONDITION. By default all +buffers are checked, this can be restricted by passing an +optional argument BUFFERS, set to a list of buffers to check. +ARG is passed to `buffer-match', for predicate conditions in +CONDITION." + (let (bufs) + (dolist (buf (or buffers (buffer-list))) + (when (buffer-match-p condition (get-buffer buf) arg) + (push buf bufs))) + bufs)) + +(compat-defvar set-transient-map-timeout nil ;; + "Timeout in seconds for deactivation of a transient keymap. +If this is a number, it specifies the amount of idle time +after which to deactivate the keymap set by `set-transient-map', +thus overriding the value of the TIMEOUT argument to that function.") + +(compat-defvar set-transient-map-timer nil ;; + "Timer for `set-transient-map-timeout'.") + +(declare-function format-spec "format-spec") +(compat-defun set-transient-map (map &optional keep-pred on-exit message timeout) ;; + "Handle the optional arguments MESSAGE and TIMEOUT." + :extended t + (unless (fboundp 'format-spec) + (require 'format-spec)) + (let* ((timeout (or set-transient-map-timeout timeout)) + (message + (when message + (let (keys) + (map-keymap (lambda (key cmd) (and cmd (push key keys))) map) + (format-spec (if (stringp message) message "Repeat with %k") + `((?k . ,(mapconcat + (lambda (key) + (substitute-command-keys + (format "\\`%s'" + (key-description (vector key))))) + keys ", "))))))) + (clearfun (make-symbol "clear-transient-map")) + (exitfun + (lambda () + (internal-pop-keymap map 'overriding-terminal-local-map) + (remove-hook 'pre-command-hook clearfun) + (when message (message "")) + (when set-transient-map-timer (cancel-timer set-transient-map-timer)) + (when on-exit (funcall on-exit))))) + (fset clearfun + (lambda () + (with-demoted-errors "set-transient-map PCH: %S" + (if (cond + ((null keep-pred) nil) + ((and (not (eq map (cadr overriding-terminal-local-map))) + (memq map (cddr overriding-terminal-local-map))) + t) + ((eq t keep-pred) + (let ((mc (lookup-key map (this-command-keys-vector)))) + (when (and mc (symbolp mc)) + (setq mc (or (command-remapping mc) mc))) + (and mc (eq this-command mc)))) + (t (funcall keep-pred))) + (when message (message "%s" message)) + (funcall exitfun))))) + (add-hook 'pre-command-hook clearfun) + (internal-push-keymap map 'overriding-terminal-local-map) + (when timeout + (when set-transient-map-timer (cancel-timer set-transient-map-timer)) + (setq set-transient-map-timer (run-with-idle-timer timeout nil exitfun))) + (when message (message "%s" message)) + exitfun)) + +;;;; Defined in simple.el + +(compat-defun use-region-noncontiguous-p () ;; + "Return non-nil for a non-contiguous region if `use-region-p'." + (and (use-region-p) (region-noncontiguous-p))) + +(compat-defun use-region-beginning () ;; + "Return the start of the region if `use-region-p'." + (and (use-region-p) (region-beginning))) + +(compat-defun use-region-end () ;; + "Return the end of the region if `use-region-p'." + (and (use-region-p) (region-end))) + +(compat-defun get-scratch-buffer-create () ;; + "Return the *scratch* buffer, creating a new one if needed." + (or (get-buffer "*scratch*") + (let ((scratch (get-buffer-create "*scratch*"))) + ;; Don't touch the buffer contents or mode unless we know that + ;; we just created it. + (with-current-buffer scratch + (when initial-scratch-message + (insert (substitute-command-keys initial-scratch-message)) + (set-buffer-modified-p nil)) + (funcall initial-major-mode)) + scratch))) + +;;;; Defined in subr-x.el + +(compat-defmacro with-buffer-unmodified-if-unchanged (&rest body) ;; + "Like `progn', but change buffer-modified status only if buffer text changes. +If the buffer was unmodified before execution of BODY, and +buffer text after execution of BODY is identical to what it was +before, ensure that buffer is still marked unmodified afterwards. +For example, the following won't change the buffer's modification +status: + + (with-buffer-unmodified-if-unchanged + (insert \"a\") + (delete-char -1)) + +Note that only changes in the raw byte sequence of the buffer text, +as stored in the internal representation, are monitored for the +purpose of detecting the lack of changes in buffer text. Any other +changes that are normally perceived as \"buffer modifications\", such +as changes in text properties, `buffer-file-coding-system', buffer +multibyteness, etc. -- will not be noticed, and the buffer will still +be marked unmodified, effectively ignoring those changes." + (declare (debug t) (indent 0)) + (let ((hash (gensym)) + (buffer (gensym))) + `(let ((,hash (and (not (buffer-modified-p)) + (buffer-hash))) + (,buffer (current-buffer))) + (prog1 + (progn + ,@body) + ;; If we didn't change anything in the buffer (and the buffer + ;; was previously unmodified), then flip the modification status + ;; back to "unchanged". + (when (and ,hash (buffer-live-p ,buffer)) + (with-current-buffer ,buffer + (when (and (buffer-modified-p) + (equal ,hash (buffer-hash))) + (restore-buffer-modified-p nil)))))))) + +(compat-defun add-display-text-property (start end prop value ;; + &optional object) + "Add display property PROP with VALUE to the text from START to END. +If any text in the region has a non-nil `display' property, those +properties are retained. + +If OBJECT is non-nil, it should be a string or a buffer. If nil, +this defaults to the current buffer." + (let ((sub-start start) + (sub-end 0) + disp) + (while (< sub-end end) + (setq sub-end (next-single-property-change sub-start 'display object + (if (stringp object) + (min (length object) end) + (min end (point-max))))) + (if (not (setq disp (get-text-property sub-start 'display object))) + ;; No old properties in this range. + (put-text-property sub-start sub-end 'display (list prop value) + object) + ;; We have old properties. + (let ((vector nil)) + ;; Make disp into a list. + (setq disp + (cond + ((vectorp disp) + (setq vector t) + (append disp nil)) + ((not (consp (car disp))) + (list disp)) + (t + disp))) + ;; Remove any old instances. + (when-let ((old (assoc prop disp))) + (setq disp (delete old disp))) + (setq disp (cons (list prop value) disp)) + (when vector + (setq disp (vconcat disp))) + ;; Finally update the range. + (put-text-property sub-start sub-end 'display disp object))) + (setq sub-start sub-end)))) + +(compat-defmacro while-let (spec &rest body) ;; + "Bind variables according to SPEC and conditionally evaluate BODY. +Evaluate each binding in turn, stopping if a binding value is nil. +If all bindings are non-nil, eval BODY and repeat. + +The variable list SPEC is the same as in `if-let*'." + (declare (indent 1) (debug if-let)) + (let ((done (gensym "done"))) + `(catch ',done + (while t + (if-let* ,spec + (progn + ,@body) + (throw ',done nil)))))) + +;;;; Defined in files.el + +(compat-defun file-name-split (filename) ;; + "Return a list of all the components of FILENAME. +On most systems, this will be true: + + (equal (string-join (file-name-split filename) \"/\") filename)" + (let ((components nil)) + ;; If this is a directory file name, then we have a null file name + ;; at the end. + (when (directory-name-p filename) + (push "" components) + (setq filename (directory-file-name filename))) + ;; Loop, chopping off components. + (while (length> filename 0) + (push (file-name-nondirectory filename) components) + (let ((dir (file-name-directory filename))) + (setq filename (and dir (directory-file-name dir))) + ;; If there's nothing left to peel off, we're at the root and + ;; we can stop. + (when (and dir (equal dir filename)) + (push (if (equal dir "") "" + ;; On Windows, the first component might be "c:" or + ;; the like. + (substring dir 0 -1)) + components) + (setq filename nil)))) + components)) + +(compat-defun file-attribute-file-identifier (attributes) ;; + "The inode and device numbers in ATTRIBUTES returned by `file-attributes'. +The value is a list of the form (INODENUM DEVICE), where DEVICE could be +either a single number or a cons cell of two numbers. +This tuple of numbers uniquely identifies the file." + (nthcdr 10 attributes)) + +(compat-defun file-name-parent-directory (filename) ;; + "Return the directory name of the parent directory of FILENAME. +If FILENAME is at the root of the filesystem, return nil. +If FILENAME is relative, it is interpreted to be relative +to `default-directory', and the result will also be relative." + (let* ((expanded-filename (expand-file-name filename)) + (parent (file-name-directory (directory-file-name expanded-filename)))) + (cond + ;; filename is at top-level, therefore no parent + ((or (null parent) + ;; `equal' is enough, we don't need to resolve symlinks here + ;; with `file-equal-p', also for performance + (equal parent expanded-filename)) + nil) + ;; filename is relative, return relative parent + ((not (file-name-absolute-p filename)) + (file-relative-name parent)) + (t + parent)))) + +(compat-defvar file-has-changed-p--hash-table ;; + (make-hash-table :test #'equal) + "Internal variable used by `file-has-changed-p'.") + +(compat-defun file-has-changed-p (file &optional tag) ;; + "Return non-nil if FILE has changed. +The size and modification time of FILE are compared to the size +and modification time of the same FILE during a previous +invocation of `file-has-changed-p'. Thus, the first invocation +of `file-has-changed-p' always returns non-nil when FILE exists. +The optional argument TAG, which must be a symbol, can be used to +limit the comparison to invocations with identical tags; it can be +the symbol of the calling function, for example." + (let* ((file (directory-file-name (expand-file-name file))) + (remote-file-name-inhibit-cache t) + (fileattr (file-attributes file 'integer)) + (attr (and fileattr + (cons (file-attribute-size fileattr) + (file-attribute-modification-time fileattr)))) + (sym (concat (symbol-name tag) "@" file)) + (cachedattr (gethash sym file-has-changed-p--hash-table))) + (unless (equal attr cachedattr) + (puthash sym attr file-has-changed-p--hash-table)))) + +;;;; Defined in keymap.el + +(compat-defun key-valid-p (keys) ;; + "Say whether KEYS is a valid key. +A key is a string consisting of one or more key strokes. +The key strokes are separated by single space characters. + +Each key stroke is either a single character, or the name of an +event, surrounded by angle brackets. In addition, any key stroke +may be preceded by one or more modifier keys. Finally, a limited +number of characters have a special shorthand syntax. + +Here's some example key sequences. + + \"f\" (the key `f') + \"S o m\" (a three key sequence of the keys `S', `o' and `m') + \"C-c o\" (a two key sequence of the keys `c' with the control modifier + and then the key `o') + \"H-\" (the key named \"left\" with the hyper modifier) + \"M-RET\" (the \"return\" key with a meta modifier) + \"C-M-\" (the \"space\" key with both the control and meta modifiers) + +These are the characters that have shorthand syntax: +NUL, RET, TAB, LFD, ESC, SPC, DEL. + +Modifiers have to be specified in this order: + + A-C-H-M-S-s + +which is + + Alt-Control-Hyper-Meta-Shift-super" + (declare (pure t) (side-effect-free t)) + (let ((case-fold-search nil)) + (and + (stringp keys) + (string-match-p "\\`[^ ]+\\( [^ ]+\\)*\\'" keys) + (save-match-data + (catch 'exit + (let ((prefixes + "\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?")) + (dolist (key (split-string keys " ")) + ;; Every key might have these modifiers, and they should be + ;; in this order. + (when (string-match (concat "\\`" prefixes) key) + (setq key (substring key (match-end 0)))) + (unless (or (and (= (length key) 1) + ;; Don't accept control characters as keys. + (not (< (aref key 0) ?\s)) + ;; Don't accept Meta'd characters as keys. + (or (multibyte-string-p key) + (not (<= 127 (aref key 0) 255)))) + (and (string-match-p "\\`<[-_A-Za-z0-9]+>\\'" key) + ;; Don't allow . + (= (progn + (string-match + (concat "\\`<" prefixes) key) + (match-end 0)) + 1)) + (string-match-p + "\\`\\(NUL\\|RET\\|TAB\\|LFD\\|ESC\\|SPC\\|DEL\\)\\'" + key)) + ;; Invalid. + (throw 'exit nil))) + t)))))) + +(compat-defun keymap--check (key) ;; + "Signal an error if KEY doesn't have a valid syntax." + (unless (key-valid-p key) + (error "%S is not a valid key definition; see `key-valid-p'" key))) + +(compat-defun key-parse (keys) ;; + "Convert KEYS to the internal Emacs key representation. +See `kbd' for a descripion of KEYS." + (declare (pure t) (side-effect-free t)) + ;; A pure function is expected to preserve the match data. + (save-match-data + (let ((case-fold-search nil) + (len (length keys)) ; We won't alter keys in the loop below. + (pos 0) + (res [])) + (while (and (< pos len) + (string-match "[^ \t\n\f]+" keys pos)) + (let* ((word-beg (match-beginning 0)) + (word-end (match-end 0)) + (word (substring keys word-beg len)) + (times 1) + key) + ;; Try to catch events of the form "". + (if (string-match "\\`<[^ <>\t\n\f][^>\t\n\f]*>" word) + (setq word (match-string 0 word) + pos (+ word-beg (match-end 0))) + (setq word (substring keys word-beg word-end) + pos word-end)) + (when (string-match "\\([0-9]+\\)\\*." word) + (setq times (string-to-number (substring word 0 (match-end 1)))) + (setq word (substring word (1+ (match-end 1))))) + (cond ((string-match "^<<.+>>$" word) + (setq key (vconcat (if (eq (key-binding [?\M-x]) + 'execute-extended-command) + [?\M-x] + (or (car (where-is-internal + 'execute-extended-command)) + [?\M-x])) + (substring word 2 -2) "\r"))) + ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word) + (progn + (setq word (concat (match-string 1 word) + (match-string 3 word))) + (not (string-match + "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" + word)))) + (setq key (list (intern word)))) + ((or (equal word "REM") (string-match "^;;" word)) + (setq pos (string-match "$" keys pos))) + (t + (let ((orig-word word) (prefix 0) (bits 0)) + (while (string-match "^[ACHMsS]-." word) + (setq bits (+ bits + (cdr + (assq (aref word 0) + '((?A . ?\A-\0) (?C . ?\C-\0) + (?H . ?\H-\0) (?M . ?\M-\0) + (?s . ?\s-\0) (?S . ?\S-\0)))))) + (setq prefix (+ prefix 2)) + (setq word (substring word 2))) + (when (string-match "^\\^.$" word) + (setq bits (+ bits ?\C-\0)) + (setq prefix (1+ prefix)) + (setq word (substring word 1))) + (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r") + ("LFD" . "\n") ("TAB" . "\t") + ("ESC" . "\e") ("SPC" . " ") + ("DEL" . "\177"))))) + (when found (setq word (cdr found)))) + (when (string-match "^\\\\[0-7]+$" word) + (let ((n 0)) + (dolist (ch (cdr (string-to-list word))) + (setq n (+ (* n 8) ch -48))) + (setq word (vector n)))) + (cond ((= bits 0) + (setq key word)) + ((and (= bits ?\M-\0) (stringp word) + (string-match "^-?[0-9]+$" word)) + (setq key (mapcar (lambda (x) (+ x bits)) + (append word nil)))) + ((/= (length word) 1) + (error "%s must prefix a single character, not %s" + (substring orig-word 0 prefix) word)) + ((and (/= (logand bits ?\C-\0) 0) (stringp word) + ;; We used to accept . and ? here, + ;; but . is simply wrong, + ;; and C-? is not used (we use DEL instead). + (string-match "[@-_a-z]" word)) + (setq key (list (+ bits (- ?\C-\0) + (logand (aref word 0) 31))))) + (t + (setq key (list (+ bits (aref word 0))))))))) + (when key + (dolist (_ (number-sequence 1 times)) + (setq res (vconcat res key)))))) + res))) + +(compat-defun keymap-set (keymap key definition) ;; + "Set KEY to DEFINITION in KEYMAP. +KEY is a string that satisfies `key-valid-p'. + +DEFINITION is anything that can be a key's definition: + nil (means key is undefined in this keymap), + a command (a Lisp function suitable for interactive calling), + a string (treated as a keyboard macro), + a keymap (to define a prefix key), + a symbol (when the key is looked up, the symbol will stand for its + function definition, which should at that time be one of the above, + or another symbol whose function definition is used, etc.), + a cons (STRING . DEFN), meaning that DEFN is the definition + (DEFN should be a valid definition in its own right) and + STRING is the menu item name (which is used only if the containing + keymap has been created with a menu name, see `make-keymap'), + or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP, + or an extended menu item definition. + (See info node `(elisp)Extended Menu Items'.)" + (keymap--check key) + (when (stringp definition) + (keymap--check definition) + (setq definition (key-parse definition))) + (define-key keymap (key-parse key) definition)) + +(compat-defun keymap-unset (keymap key &optional remove) ;; + "Remove key sequence KEY from KEYMAP. +KEY is a string that satisfies `key-valid-p'. + +If REMOVE, remove the binding instead of unsetting it. This only +makes a difference when there's a parent keymap. When unsetting +a key in a child map, it will still shadow the same key in the +parent keymap. Removing the binding will allow the key in the +parent keymap to be used." + (keymap--check key) + (compat--define-key keymap (key-parse key) nil remove)) + +(compat-defun keymap-global-set (key command) ;; + "Give KEY a global binding as COMMAND. +COMMAND is the command definition to use; usually it is +a symbol naming an interactively-callable function. + +KEY is a string that satisfies `key-valid-p'. + +Note that if KEY has a local binding in the current buffer, +that local binding will continue to shadow any global binding +that you make with this function. + +NOTE: The compatibility version is not a command." + (keymap-set (current-global-map) key command)) + +(compat-defun keymap-local-set (key command) ;; + "Give KEY a local binding as COMMAND. +COMMAND is the command definition to use; usually it is +a symbol naming an interactively-callable function. + +KEY is a string that satisfies `key-valid-p'. + +The binding goes in the current buffer's local map, which in most +cases is shared with all other buffers in the same major mode. + +NOTE: The compatibility version is not a command." + (let ((map (current-local-map))) + (unless map + (use-local-map (setq map (make-sparse-keymap)))) + (keymap-set map key command))) + +(compat-defun keymap-global-unset (key &optional remove) ;; + "Remove global binding of KEY (if any). +KEY is a string that satisfies `key-valid-p'. + +If REMOVE (interactively, the prefix arg), remove the binding +instead of unsetting it. See `keymap-unset' for details. + +NOTE: The compatibility version is not a command." + (keymap-unset (current-global-map) key remove)) + +(compat-defun keymap-local-unset (key &optional remove) ;; + "Remove local binding of KEY (if any). +KEY is a string that satisfies `key-valid-p'. + +If REMOVE (interactively, the prefix arg), remove the binding +instead of unsetting it. See `keymap-unset' for details. + +NOTE: The compatibility version is not a command." + (when (current-local-map) + (keymap-unset (current-local-map) key remove))) + +(compat-defun keymap-substitute (keymap olddef newdef &optional oldmap prefix) ;; + "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF. +In other words, OLDDEF is replaced with NEWDEF wherever it appears. +Alternatively, if optional fourth argument OLDMAP is specified, we redefine +in KEYMAP as NEWDEF those keys that are defined as OLDDEF in OLDMAP. + +If you don't specify OLDMAP, you can usually get the same results +in a cleaner way with command remapping, like this: + (define-key KEYMAP [remap OLDDEF] NEWDEF) +\n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)" + ;; Don't document PREFIX in the doc string because we don't want to + ;; advertise it. It's meant for recursive calls only. Here's its + ;; meaning + + ;; If optional argument PREFIX is specified, it should be a key + ;; prefix, a string. Redefined bindings will then be bound to the + ;; original key, with PREFIX added at the front. + (unless prefix + (setq prefix "")) + (let* ((scan (or oldmap keymap)) + (prefix1 (vconcat prefix [nil])) + (key-substitution-in-progress + (cons scan key-substitution-in-progress))) + ;; Scan OLDMAP, finding each char or event-symbol that + ;; has any definition, and act on it with hack-key. + (map-keymap + (lambda (char defn) + (aset prefix1 (length prefix) char) + (substitute-key-definition-key defn olddef newdef prefix1 keymap)) + scan))) + +(compat-defun keymap-set-after (keymap key definition &optional after) ;; + "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding. +This is like `keymap-set' except that the binding for KEY is placed +just after the binding for the event AFTER, instead of at the beginning +of the map. Note that AFTER must be an event type (like KEY), NOT a command +\(like DEFINITION). + +If AFTER is t or omitted, the new binding goes at the end of the keymap. +AFTER should be a single event type--a symbol or a character, not a sequence. + +Bindings are always added before any inherited map. + +The order of bindings in a keymap matters only when it is used as +a menu, so this function is not useful for non-menu keymaps." + (keymap--check key) + (when (eq after t) (setq after nil)) ; nil and t are treated the same + (when (stringp after) + (keymap--check after) + (setq after (key-parse after))) + ;; If we're binding this key to another key, then parse that other + ;; key, too. + (when (stringp definition) + (keymap--check definition) + (setq definition (key-parse definition))) + (define-key-after keymap (key-parse key) definition + after)) + +(compat-defun keymap-lookup ;; + (keymap key &optional accept-default no-remap position) + "Return the binding for command KEY. +KEY is a string that satisfies `key-valid-p'. + +If KEYMAP is nil, look up in the current keymaps. If non-nil, it +should either be a keymap or a list of keymaps, and only these +keymap(s) will be consulted. + +The binding is probably a symbol with a function definition. + +Normally, `keymap-lookup' ignores bindings for t, which act as +default bindings, used when nothing else in the keymap applies; +this makes it usable as a general function for probing keymaps. +However, if the optional second argument ACCEPT-DEFAULT is +non-nil, `keymap-lookup' does recognize the default bindings, +just as `read-key-sequence' does. + +Like the normal command loop, `keymap-lookup' will remap the +command resulting from looking up KEY by looking up the command +in the current keymaps. However, if the optional third argument +NO-REMAP is non-nil, `keymap-lookup' returns the unmapped +command. + +If KEY is a key sequence initiated with the mouse, the used keymaps +will depend on the clicked mouse position with regard to the buffer +and possible local keymaps on strings. + +If the optional argument POSITION is non-nil, it specifies a mouse +position as returned by `event-start' and `event-end', and the lookup +occurs in the keymaps associated with it instead of KEY. It can also +be a number or marker, in which case the keymap properties at the +specified buffer position instead of point are used." + (keymap--check key) + (when (and keymap position) + (error "Can't pass in both keymap and position")) + (if keymap + (let ((value (lookup-key keymap (key-parse key) accept-default))) + (if (and (not no-remap) + (symbolp value)) + (or (command-remapping value) value) + value)) + (key-binding (key-parse key) accept-default no-remap position))) + +(compat-defun keymap-local-lookup (keys &optional accept-default) ;; + "Return the binding for command KEYS in current local keymap only. +KEY is a string that satisfies `key-valid-p'. + +The binding is probably a symbol with a function definition. + +If optional argument ACCEPT-DEFAULT is non-nil, recognize default +bindings; see the description of `keymap-lookup' for more details +about this." + (when-let ((map (current-local-map))) + (keymap-lookup map keys accept-default))) + +(compat-defun keymap-global-lookup (keys &optional accept-default _message) ;; + "Return the binding for command KEYS in current global keymap only. +KEY is a string that satisfies `key-valid-p'. + +The binding is probably a symbol with a function definition. +This function's return values are the same as those of `keymap-lookup' +\(which see). + +If optional argument ACCEPT-DEFAULT is non-nil, recognize default +bindings; see the description of `keymap-lookup' for more details +about this. + +NOTE: The compatibility version is not a command." + (keymap-lookup (current-global-map) keys accept-default)) + +(compat-defun define-keymap (&rest definitions) ;; + "Create a new keymap and define KEY/DEFINITION pairs as key bindings. +The new keymap is returned. + +Options can be given as keywords before the KEY/DEFINITION +pairs. Available keywords are: + +:full If non-nil, create a chartable alist (see `make-keymap'). + If nil (i.e., the default), create a sparse keymap (see + `make-sparse-keymap'). + +:suppress If non-nil, the keymap will be suppressed (see `suppress-keymap'). + If `nodigits', treat digits like other chars. + +:parent If non-nil, this should be a keymap to use as the parent + (see `set-keymap-parent'). + +:keymap If non-nil, instead of creating a new keymap, the given keymap + will be destructively modified instead. + +:name If non-nil, this should be a string to use as the menu for + the keymap in case you use it as a menu with `x-popup-menu'. + +:prefix If non-nil, this should be a symbol to be used as a prefix + command (see `define-prefix-command'). If this is the case, + this symbol is returned instead of the map itself. + +KEY/DEFINITION pairs are as KEY and DEF in `keymap-set'. KEY can +also be the special symbol `:menu', in which case DEFINITION +should be a MENU form as accepted by `easy-menu-define'. + +\(fn &key FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)" + (declare (indent defun)) + (let (full suppress parent name prefix keymap) + ;; Handle keywords. + (while (and definitions + (keywordp (car definitions)) + (not (eq (car definitions) :menu))) + (let ((keyword (pop definitions))) + (unless definitions + (error "Missing keyword value for %s" keyword)) + (let ((value (pop definitions))) + (pcase keyword + (:full (setq full value)) + (:keymap (setq keymap value)) + (:parent (setq parent value)) + (:suppress (setq suppress value)) + (:name (setq name value)) + (:prefix (setq prefix value)) + (_ (error "Invalid keyword: %s" keyword)))))) + + (when (and prefix + (or full parent suppress keymap)) + (error "A prefix keymap can't be defined with :full/:parent/:suppress/:keymap keywords")) + + (when (and keymap full) + (error "Invalid combination: :keymap with :full")) + + (let ((keymap (cond + (keymap keymap) + (prefix (define-prefix-command prefix nil name)) + (full (make-keymap name)) + (t (make-sparse-keymap name)))) + seen-keys) + (when suppress + (suppress-keymap keymap (eq suppress 'nodigits))) + (when parent + (set-keymap-parent keymap parent)) + + ;; Do the bindings. + (while definitions + (let ((key (pop definitions))) + (unless definitions + (error "Uneven number of key/definition pairs")) + (let ((def (pop definitions))) + (if (eq key :menu) + (easy-menu-define nil keymap "" def) + (if (member key seen-keys) + (error "Duplicate definition for key: %S %s" key keymap) + (push key seen-keys)) + (keymap-set keymap key def))))) + keymap))) + +(compat-defmacro defvar-keymap (variable-name &rest defs) ;; + "Define VARIABLE-NAME as a variable with a keymap definition. +See `define-keymap' for an explanation of the keywords and KEY/DEFINITION. + +In addition to the keywords accepted by `define-keymap', this +macro also accepts a `:doc' keyword, which (if present) is used +as the variable documentation string. + +The `:repeat' keyword can also be specified; it controls the +`repeat-mode' behavior of the bindings in the keymap. When it is +non-nil, all commands in the map will have the `repeat-map' +symbol property. + +More control is available over which commands are repeatable; the +value can also be a property list with properties `:enter' and +`:exit', for example: + + :repeat (:enter (commands ...) :exit (commands ...)) + +`:enter' specifies the list of additional commands that only +enter `repeat-mode'. When the list is empty, then by default all +commands in the map enter `repeat-mode'. This is useful when +there is a command that has the `repeat-map' symbol property, but +doesn't exist in this specific map. `:exit' is a list of +commands that exit `repeat-mode'. When the list is empty, no +commands in the map exit `repeat-mode'. This is useful when a +command exists in this specific map, but it doesn't have the +`repeat-map' symbol property on its symbol. + +\(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP REPEAT &rest [KEY DEFINITION]...)" + (declare (indent 1)) + (let ((opts nil) + doc repeat props) + (while (and defs + (keywordp (car defs)) + (not (eq (car defs) :menu))) + (let ((keyword (pop defs))) + (unless defs + (error "Uneven number of keywords")) + (cond + ((eq keyword :doc) (setq doc (pop defs))) + ((eq keyword :repeat) (setq repeat (pop defs))) + (t (push keyword opts) + (push (pop defs) opts))))) + (unless (zerop (% (length defs) 2)) + (error "Uneven number of key/definition pairs: %s" defs)) + + (let ((defs defs) + key seen-keys) + (while defs + (setq key (pop defs)) + (pop defs) + (unless (eq key :menu) + (if (member key seen-keys) + (error "Duplicate definition for key '%s' in keymap '%s'" + key variable-name) + (push key seen-keys))))) + + (when repeat + (let ((defs defs) + def) + (dolist (def (plist-get repeat :enter)) + (push `(put ',def 'repeat-map ',variable-name) props)) + (while defs + (pop defs) + (setq def (pop defs)) + (when (and (memq (car def) '(function quote)) + (not (memq (cadr def) (plist-get repeat :exit)))) + (push `(put ,def 'repeat-map ',variable-name) props))))) + + (let ((defvar-form + `(defvar ,variable-name + (define-keymap ,@(nreverse opts) ,@defs) + ,@(and doc (list doc))))) + (if props + `(progn + ,defvar-form + ,@(nreverse props)) + defvar-form)))) + +;;;; Defined in keymap.c + +(compat-defun define-key (keymap key def &optional remove) ;; + "Handle optional argument REMOVE." + :extended t + (if (not remove) + (define-key keymap key def) + ;; Canonicalize key + (setq key (key-parse (key-description key))) + (define-key keymap key nil) + ;; Split M-key in ESC key + (setq key (mapcan (lambda (k) + (if (and (integerp k) (/= (logand k ?\M-\0) 0)) + (list ?\e (logxor k ?\M-\0)) + (list k))) + key)) + ;; Delete single keys directly + (if (length= key 1) + (delete key keymap) + ;; Lookup submap and delete key from there + (let ((submap (lookup-key keymap (vconcat (butlast key))))) + (unless (keymapp submap) + (error "Not a keymap for %s" key)) + (when (symbolp submap) + (setq submap (symbol-function submap))) + (delete (last key) submap))) + def)) + +;;;; Defined in help.el + +(compat-defun substitute-quotes (string) ;; + "Substitute quote characters for display. +Each grave accent \\=` is replaced by left quote, and each +apostrophe \\=' is replaced by right quote. Left and right quote +characters are specified by `text-quoting-style'." + (cond ((eq (text-quoting-style) 'curve) + (string-replace "`" "‘" + (string-replace "'" "’" string))) + ((eq (text-quoting-style) 'straight) + (string-replace "`" "'" string)) + (t string))) + +;;;; Defined in button.el + +(compat-defun button--properties (callback data help-echo) ;; + "Helper function." + (list 'font-lock-face 'button + 'mouse-face 'highlight + 'help-echo help-echo + 'button t + 'follow-link t + 'category t + 'button-data data + 'keymap button-map + 'action callback)) + +(compat-defun buttonize (string callback &optional data help-echo) ;; + "Make STRING into a button and return it. +When clicked, CALLBACK will be called with the DATA as the +function argument. If DATA isn't present (or is nil), the button +itself will be used instead as the function argument. + +If HELP-ECHO, use that as the `help-echo' property. + +Also see `buttonize-region'." + (let ((string + (apply #'propertize string + (button--properties callback data help-echo)))) + ;; Add the face to the end so that it can be overridden. + (add-face-text-property 0 (length string) 'button t string) + string)) + +(compat-defun buttonize-region (start end callback &optional data help-echo) ;; + "Make the region between START and END into a button. +When clicked, CALLBACK will be called with the DATA as the +function argument. If DATA isn't present (or is nil), the button +itself will be used instead as the function argument. + +If HELP-ECHO, use that as the `help-echo' property. + +Also see `buttonize'." + (add-text-properties start end (button--properties callback data help-echo)) + (add-face-text-property start end 'button t)) + +;;;; Defined in rmc.el + +(compat-defun read-multiple-choice ;; + (prompt choices &optional _help-str _show-help long-form) + "Handle LONG-FORM argument." + :extended t + (if (not long-form) + (read-multiple-choice prompt choices) + (let ((answer + (completing-read + (concat prompt " (" + (mapconcat #'identity (mapcar #'cadr choices) "/") + ") ") + (mapcar #'cadr choices) nil t))) + (catch 'found + (dolist (c choices) + (when (equal answer (cadr c)) + (throw 'found c))))))) + +;;;; Defined in paragraphs.el + +(compat-defun count-sentences (start end) ;; + "Count sentences in current buffer from START to END." + (let ((sentences 0) + (inhibit-field-text-motion t)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (ignore-errors (forward-sentence)) + (setq sentences (1+ sentences))) + (when (/= (skip-chars-backward " \t\n") 0) + (setq sentences (1- sentences))) + sentences)))) + +;;;; Defined in cl-macs.el + +(compat-defmacro cl-with-gensyms (names &rest body) ;; + "Bind each of NAMES to an uninterned symbol and evaluate BODY." + ;; No :feature since macro is autoloaded + (declare (debug (sexp body)) (indent 1)) + `(let ,(cl-loop for name in names collect + `(,name (gensym (symbol-name ',name)))) + ,@body)) + +(compat-defmacro cl-once-only (names &rest body) ;; + "Generate code to evaluate each of NAMES just once in BODY. + +This macro helps with writing other macros. Each of names is +either (NAME FORM) or NAME, which latter means (NAME NAME). +During macroexpansion, each NAME is bound to an uninterned +symbol. The expansion evaluates each FORM and binds it to the +corresponding uninterned symbol. + +For example, consider this macro: + + (defmacro my-cons (x) + (cl-once-only (x) + \\=`(cons ,x ,x))) + +The call (my-cons (pop y)) will expand to something like this: + + (let ((g1 (pop y))) + (cons g1 g1)) + +The use of `cl-once-only' ensures that the pop is performed only +once, as intended. + +See also `macroexp-let2'." + ;; No :feature since macro is autoloaded + (declare (debug (sexp body)) (indent 1)) + (setq names (mapcar #'ensure-list names)) + (let ((our-gensyms (cl-loop for _ in names collect (gensym)))) + `(let ,(cl-loop for sym in our-gensyms collect `(,sym (gensym))) + `(let ,(list + ,@(cl-loop for name in names for gensym in our-gensyms + for to-eval = (or (cadr name) (car name)) + collect ``(,,gensym ,,to-eval))) + ,(let ,(cl-loop for name in names for gensym in our-gensyms + collect `(,(car name) ,gensym)) + ,@body))))) + +;;;; Defined in ert-x.el + +(compat-defmacro ert-with-temp-file (name &rest body) ;; + "Bind NAME to the name of a new temporary file and evaluate BODY. +Delete the temporary file after BODY exits normally or +non-locally. NAME will be bound to the file name of the temporary +file. + +The following keyword arguments are supported: + +:prefix STRING If non-nil, pass STRING to `make-temp-file' as + the PREFIX argument. Otherwise, use the value of + `ert-temp-file-prefix'. + +:suffix STRING If non-nil, pass STRING to `make-temp-file' as the + SUFFIX argument. Otherwise, use the value of + `ert-temp-file-suffix'; if the value of that + variable is nil, generate a suffix based on the + name of the file that `ert-with-temp-file' is + called from. + +:text STRING If non-nil, pass STRING to `make-temp-file' as + the TEXT argument. + +:buffer SYMBOL Open the temporary file using `find-file-noselect' + and bind SYMBOL to the buffer. Kill the buffer + after BODY exits normally or non-locally. + +:coding CODING If non-nil, bind `coding-system-for-write' to CODING + when executing BODY. This is handy when STRING includes + non-ASCII characters or the temporary file must have a + specific encoding or end-of-line format. + +See also `ert-with-temp-directory'." + :feature ert-x + (declare (indent 1) (debug (symbolp body))) + (cl-check-type name symbol) + (let (keyw prefix suffix directory text extra-keywords buffer coding) + (while (keywordp (setq keyw (car body))) + (setq body (cdr body)) + (pcase keyw + (:prefix (setq prefix (pop body))) + (:suffix (setq suffix (pop body))) + ;; This is only for internal use by `ert-with-temp-directory' + ;; and is therefore not documented. + (:directory (setq directory (pop body))) + (:text (setq text (pop body))) + (:buffer (setq buffer (pop body))) + (:coding (setq coding (pop body))) + (_ (push keyw extra-keywords) (pop body)))) + (when extra-keywords + (error "Invalid keywords: %s" (mapconcat #'symbol-name extra-keywords " "))) + (let ((temp-file (make-symbol "temp-file")) + (prefix (or prefix "emacs-test-")) + (suffix (or suffix + (thread-last + (file-name-base (or (macroexp-file-name) buffer-file-name)) + (replace-regexp-in-string (rx string-start + (group (+? not-newline)) + (regexp "-?tests?") + string-end) + "\\1") + (concat "-"))))) + `(let* ((coding-system-for-write ,(or coding coding-system-for-write)) + (,temp-file (,(if directory 'file-name-as-directory 'identity) + (,(if (fboundp 'compat--make-temp-file) + 'compat--make-temp-file 'make-temp-file) + ,prefix ,directory ,suffix ,text))) + (,name ,(if directory + `(file-name-as-directory ,temp-file) + temp-file)) + ,@(when buffer + (list `(,buffer (find-file-literally ,temp-file))))) + (unwind-protect + (progn ,@body) + (ignore-errors + ,@(when buffer + (list `(with-current-buffer ,buffer + (set-buffer-modified-p nil)) + `(kill-buffer ,buffer)))) + (ignore-errors + ,(if directory + `(delete-directory ,temp-file :recursive) + `(delete-file ,temp-file)))))))) + +(compat-defmacro ert-with-temp-directory (name &rest body) ;; + "Bind NAME to the name of a new temporary directory and evaluate BODY. +Delete the temporary directory after BODY exits normally or +non-locally. + +NAME is bound to the directory name, not the directory file +name. (In other words, it will end with the directory delimiter; +on Unix-like systems, it will end with \"/\".) + +The same keyword arguments are supported as in +`ert-with-temp-file' (which see), except for :text." + :feature ert-x + (declare (indent 1) (debug (symbolp body))) + (let ((tail body) keyw) + (while (keywordp (setq keyw (car tail))) + (setq tail (cddr tail)) + (pcase keyw (:text (error "Invalid keyword for directory: :text"))))) + `(ert-with-temp-file ,name + :directory t + ,@body)) + +(provide 'compat-29) +;;; compat-29.el ends here diff --git a/elpa/compat-28.1.2.2/compat-autoloads.el b/elpa/compat-29.1.3.4/compat-autoloads.el similarity index 52% rename from elpa/compat-28.1.2.2/compat-autoloads.el rename to elpa/compat-29.1.3.4/compat-autoloads.el index 8df84445..2044a1b7 100644 --- a/elpa/compat-28.1.2.2/compat-autoloads.el +++ b/elpa/compat-29.1.3.4/compat-autoloads.el @@ -6,17 +6,10 @@ (or (file-name-directory #$) (car load-path)))) -;;;### (autoloads nil "compat-27" "compat-27.el" (0 0 0 0)) -;;; Generated autoloads from compat-27.el +;;;### (autoloads nil "compat" "compat.el" (0 0 0 0)) +;;; Generated autoloads from compat.el -(register-definition-prefixes "compat-27" '("derived-mode-p")) - -;;;*** - -;;;### (autoloads nil "compat-help" "compat-help.el" (0 0 0 0)) -;;; Generated autoloads from compat-help.el - -(register-definition-prefixes "compat-help" '("compat---describe")) +(register-definition-prefixes "compat" '("compat-")) ;;;*** @@ -27,9 +20,8 @@ ;;;*** -;;;### (autoloads nil nil ("compat-24.el" "compat-25.el" "compat-26.el" -;;;;;; "compat-28.el" "compat-font-lock.el" "compat-pkg.el" "compat.el") -;;;;;; (0 0 0 0)) +;;;### (autoloads nil nil ("compat-25.el" "compat-26.el" "compat-27.el" +;;;;;; "compat-28.el" "compat-29.el" "compat-pkg.el") (0 0 0 0)) ;;;*** diff --git a/elpa/compat-29.1.3.4/compat-macs.el b/elpa/compat-29.1.3.4/compat-macs.el new file mode 100644 index 00000000..f34cb0d4 --- /dev/null +++ b/elpa/compat-29.1.3.4/compat-macs.el @@ -0,0 +1,266 @@ +;;; compat-macs.el --- Compatibility Macros -*- lexical-binding: t; no-byte-compile: t; -*- + +;; Copyright (C) 2021-2023 Free Software Foundation, Inc. + +;; 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 . + +;;; Commentary: + +;; This file provides *internal* macros, which are used by Compat to +;; facilitate the definition of compatibility functions, macros and +;; variables. The `compat-macs' feature should never be loaded at +;; runtime in your Emacs and will only be used during byte +;; compilation. Every definition provided here should be considered +;; internal and may change any time between Compat releases. + +;;; Code: + +;; We always require subr-x at compile time for the fboundp check +;; since definitions have been moved around. The cl-lib macros are +;; needed by compatibility definitions. +(require 'subr-x) +(require 'cl-lib) + +(defvar compat-macs--version nil + "Version of the currently defined compatibility definitions.") + +(defun compat-macs--strict (cond &rest error) + "Assert strict COND, otherwise fail with ERROR." + (when (bound-and-true-p compat-strict) + (apply #'compat-macs--assert cond error))) + +(defun compat-macs--assert (cond &rest error) + "Assert COND, otherwise fail with ERROR." + (unless cond (apply #'error error))) + +(defun compat-macs--docstring (type name docstring) + "Format DOCSTRING for NAME of TYPE. +Prepend compatibility notice to the actual documentation string." + (with-temp-buffer + (insert + (format + "[Compatibility %s for `%s', defined in Emacs %s. \ +See (compat) Emacs %s' for more details.]\n\n%s" + type name compat-macs--version compat-macs--version docstring)) + (let ((fill-column 80)) + (fill-region (point-min) (point-max))) + (buffer-string))) + +(defun compat-macs--check-attributes (attrs preds) + "Check ATTRS given PREDS predicate plist and return rest." + (while (keywordp (car attrs)) + (compat-macs--assert (cdr attrs) "Attribute list length is odd") + (compat-macs--assert (let ((p (plist-get preds (car attrs)))) + (and p (or (eq p t) (funcall p (cadr attrs))))) + "Invalid attribute %s" (car attrs)) + (setq attrs (cddr attrs))) + attrs) + +(defun compat-macs--guard (attrs preds fun) + "Guard compatibility definition generation. +The version constraints specified by ATTRS are checked. PREDS is +a plist of predicates for arguments which are passed to FUN." + (declare (indent 2)) + (compat-macs--assert compat-macs--version "No `compat-version' was declared") + (let* ((body (compat-macs--check-attributes + attrs `(,@preds :feature symbolp))) + (feature (plist-get attrs :feature)) + (attrs `(:body ,body ,@attrs)) + args) + ;; Require feature at compile time + (when feature + (compat-macs--assert (not (eq feature 'subr-x)) "Invalid feature subr-x") + (require feature)) + ;; The current Emacs must be older than the currently declared version. + (when (version< emacs-version compat-macs--version) + (while preds + (push (plist-get attrs (car preds)) args) + (setq preds (cddr preds))) + (setq body (apply fun (nreverse args))) + (if (and feature body) + `(with-eval-after-load ',feature ,@body) + (macroexp-progn body))))) + +(defun compat-macs--defun (type name arglist docstring rest) + "Define function NAME of TYPE with ARGLIST and DOCSTRING. +REST are attributes and the function BODY." + (compat-macs--guard + rest (list :extended (lambda (x) (or (booleanp x) (version-to-list x))) + :obsolete (lambda (x) (or (booleanp x) (stringp x))) + :body t) + (lambda (extended obsolete body) + (when (stringp extended) + (compat-macs--assert + (and (version< extended compat-macs--version) (version< "24.4" extended)) + "Invalid :extended version %s for %s %s" extended type name) + (setq extended (version<= extended emacs-version))) + (compat-macs--strict (eq extended (fboundp name)) + "Wrong :extended flag for %s %s" type name) + ;; Remove unsupported declares. It might be possible to set these + ;; properties otherwise. That should be looked into and implemented + ;; if it is the case. + (when (and (listp (car-safe body)) (eq (caar body) 'declare)) + (when (<= emacs-major-version 25) + (delq (assq 'side-effect-free (car body)) (car body)) + (delq (assq 'pure (car body)) (car body)))) + ;; Use `:extended' name if the function is already defined. + (let* ((defname (if (and extended (fboundp name)) + (intern (format "compat--%s" name)) + name)) + (def `(,(if (memq '&key arglist) + (if (eq type 'macro) 'cl-defmacro 'cl-defun) + (if (eq type 'macro) 'defmacro 'defun)) + ,defname ,arglist + ,(compat-macs--docstring type name docstring) + ,@body))) + `(,@(if (eq defname name) + ;; An additional fboundp check is performed at runtime to make + ;; sure that we never redefine an existing definition if Compat + ;; is loaded on a newer Emacs version. Declare the function, + ;; such that the byte compiler does not complain about possibly + ;; missing functions at runtime. The warnings are generated due + ;; to the fboundp check. + `((declare-function ,name nil) + (unless (fboundp ',name) ,def)) + (list def)) + ,@(when obsolete + `((make-obsolete + ',defname ,(if (stringp obsolete) obsolete "No substitute") + ,compat-macs--version)))))))) + +(defmacro compat-guard (cond &rest rest) + "Guard definition with a runtime COND and a version check. +The runtime condition must make sure that no definition is +overriden. REST is an attribute plist followed by the definition +body. The attributes specify the conditions under which the +definition is generated. + +- :feature :: Wrap the definition with `with-eval-after-load' for + the given feature." + (declare (debug ([&rest keywordp sexp] def-body)) + (indent 1)) + (compat-macs--guard rest '(:body t) + (lambda (body) + (compat-macs--assert body "The guarded body is empty") + (if (eq cond t) + body + (compat-macs--strict (eval cond t) "Guard %S failed" cond) + `((when ,cond ,@body)))))) + +(defmacro compat-defalias (name def &rest attrs) + "Define compatibility alias NAME as DEF. +ATTRS is a plist of attributes, which specify the conditions +under which the definition is generated. + +- :obsolete :: Mark the alias as obsolete if t. + +- :feature :: See `compat-guard'." + (declare (debug (name symbolp [&rest keywordp sexp]))) + (compat-macs--guard attrs '(:obsolete booleanp) + (lambda (obsolete) + (compat-macs--strict (not (fboundp name)) "%s already defined" name) + ;; The fboundp check is performed at runtime to make sure that we never + ;; redefine an existing definition if Compat is loaded on a newer Emacs + ;; version. + `((unless (fboundp ',name) + (defalias ',name ',def + ,(compat-macs--docstring 'function name + (get name 'function-documentation))) + ,@(when obsolete + `((make-obsolete ',name ',def ,compat-macs--version)))))))) + +(defmacro compat-defun (name arglist docstring &rest rest) + "Define compatibility function NAME with arguments ARGLIST. +The function must be documented in DOCSTRING. REST is an +attribute plist followed by the function body. The attributes +specify the conditions under which the definition is generated. + +- :extended :: Mark the function as extended if t. The function + must be called explicitly via `compat-call'. This attribute + should be used for functions which extend already existing + functions, e.g., functions which changed their calling + convention or their behavior. The value can also be a version + string, which specifies the Emacs version when the original + version of the function was introduced. + +- :obsolete :: Mark the function as obsolete if t, can be a + string describing the obsoletion. + +- :feature :: See `compat-guard'." + (declare (debug (&define name (&rest symbolp) + stringp + [&rest keywordp sexp] + def-body)) + (doc-string 3) (indent 2)) + (compat-macs--defun 'function name arglist docstring rest)) + +(defmacro compat-defmacro (name arglist docstring &rest rest) + "Define compatibility macro NAME with arguments ARGLIST. +The macro must be documented in DOCSTRING. REST is an attribute +plist followed by the macro body. See `compat-defun' for +details." + (declare (debug compat-defun) (doc-string 3) (indent 2)) + (compat-macs--defun 'macro name arglist docstring rest)) + +(defmacro compat-defvar (name initval docstring &rest attrs) + "Define compatibility variable NAME with initial value INITVAL. +The variable must be documented in DOCSTRING. ATTRS is a plist +of attributes, which specify the conditions under which the +definition is generated. + +- :constant :: Mark the variable as constant if t. + +- :local :: Make the variable buffer-local if t. If the value is + `permanent' make the variable additionally permanently local. + +- :obsolete :: Mark the variable as obsolete if t, can be a + string describing the obsoletion. + +- :feature :: See `compat-guard'." + (declare (debug (name form stringp [&rest keywordp sexp])) + (doc-string 3) (indent 2)) + (compat-macs--guard + attrs (list :constant #'booleanp + :local (lambda (x) (memq x '(nil t permanent))) + :obsolete (lambda (x) (or (booleanp x) (stringp x)))) + (lambda (constant local obsolete) + (compat-macs--strict (not (boundp name)) "%s already defined" name) + (compat-macs--assert (not (and constant local)) "Both :constant and :local") + ;; The boundp check is performed at runtime to make sure that we never + ;; redefine an existing definition if Compat is loaded on a newer Emacs + ;; version. + `((unless (boundp ',name) + (,(if constant 'defconst 'defvar) + ,name ,initval + ,(compat-macs--docstring 'variable name docstring)) + ,@(when obsolete + `((make-obsolete-variable + ',name ,(if (stringp obsolete) obsolete "No substitute") + ,compat-macs--version)))) + ,@(and local `((make-variable-buffer-local ',name))) + ,@(and (eq local 'permanent) `((put ',name 'permanent-local t))))))) + +(defmacro compat-version (version) + "Set the Emacs version that is currently being handled to VERSION." + (setq compat-macs--version version) + nil) + +(defmacro compat-require (feature version) + "Require FEATURE if the Emacs version is less than VERSION." + (when (version< emacs-version version) + (require feature) + `(require ',feature))) + +(provide 'compat-macs) +;;; compat-macs.el ends here diff --git a/elpa/compat-29.1.3.4/compat-pkg.el b/elpa/compat-29.1.3.4/compat-pkg.el new file mode 100644 index 00000000..fc1c8acd --- /dev/null +++ b/elpa/compat-29.1.3.4/compat-pkg.el @@ -0,0 +1,2 @@ +;; Generated package description from compat.el -*- no-byte-compile: t -*- +(define-package "compat" "29.1.3.4" "Emacs Lisp Compatibility Library" '((emacs "24.4") (seq "2.3")) :commit "42cf6f29bcab1d390046299c09285db7be03932c" :authors '(("Philip Kaludercic , Daniel Mendler" . "mail@daniel-mendler.de")) :maintainer '("Daniel Mendler , Compat Development" . "~pkal/compat-devel@lists.sr.ht") :keywords '("lisp") :url "https://github.com/emacs-compat/compat") diff --git a/elpa/compat-29.1.3.4/compat.el b/elpa/compat-29.1.3.4/compat.el new file mode 100644 index 00000000..48d30c54 --- /dev/null +++ b/elpa/compat-29.1.3.4/compat.el @@ -0,0 +1,93 @@ +;;; compat.el --- Emacs Lisp Compatibility Library -*- lexical-binding: t; -*- + +;; Copyright (C) 2021-2023 Free Software Foundation, Inc. + +;; Author: Philip Kaludercic , Daniel Mendler +;; Maintainer: Daniel Mendler , Compat Development <~pkal/compat-devel@lists.sr.ht> +;; Version: 29.1.3.4 +;; URL: https://github.com/emacs-compat/compat +;; Package-Requires: ((emacs "24.4") (seq "2.3")) +;; Keywords: lisp + +;; 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 . + +;;; Commentary: + +;; Compat is the Elisp forwards compatibility library, which provides +;; definitions introduced in newer Emacs versions. The definitions +;; are only installed if necessary for your current Emacs version. If +;; Compat is compiled on a recent version of Emacs, all of the +;; definitions are disabled at compile time, such that no negative +;; performance impact is incurred. The provided compatibility +;; implementations of functions and macros are at least subsets of the +;; actual implementations. Be sure to read the documentation string +;; and the Compat manual. +;; +;; Not every function provided in newer versions of Emacs is provided +;; here. Some depend on new features from the C core, others cannot +;; be implemented to a meaningful degree. Please consult the Compat +;; manual for details regarding the usage of the Compat library and +;; the provided functionality. + +;; The main audience for this library are not regular users, but +;; package maintainers. Therefore no commands, user-facing modes or +;; user options are implemented here. + +;;; Code: + +;; Ensure that the newest compatibility layer is required at compile +;; time and runtime, but only if needed. +(eval-when-compile + (defmacro compat--maybe-require-29 () + (when (< emacs-major-version 29) + (require 'compat-29) + '(require 'compat-29)))) +(compat--maybe-require-29) + +;;;; Macros for extended compatibility function calls + +(defmacro compat-function (fun) + "Return compatibility function symbol for FUN. + +If the Emacs version provides a sufficiently recent version of +FUN, the symbol FUN is returned itself. Otherwise the macro +returns the symbol of a compatibility function which supports the +behavior and calling convention of the current stable Emacs +version. For example Compat 29.1 will provide compatibility +functions which implement the behavior and calling convention of +Emacs 29.1. + +See also `compat-call' to directly call compatibility functions." + (let ((compat (intern (format "compat--%s" fun)))) + `#',(if (fboundp compat) compat fun))) + +(defmacro compat-call (fun &rest args) + "Call compatibility function or macro FUN with ARGS. + +A good example function is `plist-get' which was extended with an +additional predicate argument in Emacs 29.1. The compatibility +function, which supports this additional argument, can be +obtained via (compat-function plist-get) and called +via (compat-call plist-get plist prop predicate). It is not +possible to directly call (plist-get plist prop predicate) on +Emacs older than 29.1, since the original `plist-get' function +does not yet support the predicate argument. Note that the +Compat library never overrides existing functions. + +See also `compat-function' to lookup compatibility functions." + (let ((compat (intern (format "compat--%s" fun)))) + `(,(if (fboundp compat) compat fun) ,@args))) + +(provide 'compat) +;;; compat.el ends here diff --git a/elpa/compat-29.1.3.4/compat.info b/elpa/compat-29.1.3.4/compat.info new file mode 100644 index 00000000..8dc4614f --- /dev/null +++ b/elpa/compat-29.1.3.4/compat.info @@ -0,0 +1,2888 @@ +This is doc5ZeelO.info, produced by makeinfo version 6.7 from +compat.texi. + +Copyright © 2022-2023 Free Software Foundation, Inc. + + Permission is granted to copy, distribute and/or modify this + document under the terms of the GNU Free Documentation License, + Version 1.3 or any later version published by the Free Software + Foundation; with no Invariant Sections, with the Front-Cover Texts + being “A GNU Manual,” and with the Back-Cover Texts as in (a) + below. A copy of the license is included in the section entitled + “GNU Free Documentation License.” + + (a) The FSF’s Back-Cover Text is: “You have the freedom to copy and + modify this GNU manual.” + +INFO-DIR-SECTION Emacs +START-INFO-DIR-ENTRY +* Compat: (compat). Compatibility Library for Emacs Lisp. +END-INFO-DIR-ENTRY + + +File: doc5ZeelO.info, Node: Top, Next: Introduction, Up: (dir) + +"Compat" Manual +*************** + +This manual documents the usage of the "Compat" Emacs lisp library, the +forward-compatibility library for Emacs Lisp, corresponding to version +29.1.3.4. + + Copyright © 2022-2023 Free Software Foundation, Inc. + + Permission is granted to copy, distribute and/or modify this + document under the terms of the GNU Free Documentation License, + Version 1.3 or any later version published by the Free Software + Foundation; with no Invariant Sections, with the Front-Cover Texts + being “A GNU Manual,” and with the Back-Cover Texts as in (a) + below. A copy of the license is included in the section entitled + “GNU Free Documentation License.” + + (a) The FSF’s Back-Cover Text is: “You have the freedom to copy and + modify this GNU manual.” + +* Menu: + +* Introduction:: +* Support:: +* Development:: +* Function Index:: +* Variable Index:: + +— The Detailed Node Listing — + +Introduction + +* Overview:: +* Usage:: +* Limitations:: + +Support + +* Emacs 25.1:: Compatibility support for Emacs 25.1 +* Emacs 26.1:: Compatibility support for Emacs 26.1 +* Emacs 27.1:: Compatibility support for Emacs 27.1 +* Emacs 28.1:: Compatibility support for Emacs 28.1 +* Emacs 29.1:: Compatibility support for Emacs 29.1 + + + +File: doc5ZeelO.info, Node: Introduction, Next: Support, Prev: Top, Up: Top + +1 Introduction +************** + +* Menu: + +* Overview:: +* Usage:: +* Limitations:: + + +File: doc5ZeelO.info, Node: Overview, Next: Usage, Up: Introduction + +1.1 Overview +============ + +The objective of Compat is to provide "forwards compatibility" library +for Emacs Lisp. By using Compat, an Elisp package does not have to make +the decision to either use new and useful functionality or support old +versions of Emacs. + + The library provides support back until Emacs 24.4. The intended +audience are package developers that are interested in using newer +developments, without having to break compatibility. + + +File: doc5ZeelO.info, Node: Usage, Next: Limitations, Prev: Overview, Up: Introduction + +1.2 Usage +========= + +The intended use-case for this library is for package developers to add +as a dependency in the header: + + ;; Package-Requires: ((emacs "24.4") (compat "29.1.3.4")) + + There is no need to depend on ‘emacs’ 24.4 specifically. One can +choose to any newer version, if features not provided by Compat +necessitate it, for example bug fixes or UI improvements. + + In any file where compatibility forms are used, a + + (require 'compat) + + should be added early on. In packages which are part of Emacs itself +and which want to take advantage of Compat, the ‘noerror’ flag should be +specified: ‘(require 'compat nil 'noerror)’. In the future a minimal +version of Compat may be added to the Emacs core, such that the +‘noerror’ flag will not be necessary anymore. + + This will load all necessary Compat definitions. Compat also loads +the ‘seq’ library which is preloaded by default on Emacs 29. Note that +if Compat is installed on a recent version of Emacs, all of the +definitions are disabled at compile time, such that no negative +performance impact is incurred. + + Note that Compat provides replacement functions with extended +functionality for functions that are already defined (‘sort’, ‘assoc’, +...). These functions may have changed their calling convention +(additional optional arguments) or may have changed their behavior. +These functions must be looked up explicitly with ‘compat-function’ or +called explicitly with ‘compat-call’. We call them “Extended +Definitions”. In contrast, newly “Added Definitions” can be called as +usual. + + (compat-call assoc key alist testfn) ;; Call extended `assoc' + (mapcan fun seq) ;; Call newly added `mapcan' + + -- Macro: compat-call fun &rest args + This macro calls the compatibility function FUN with ARGS. Many + functions provided by Compat can be called directly without this + macro. However in the case where Compat provides an alternative + version of an existing function, the function call has to go + through ‘compat-call’. This happens for example when the calling + convention of a function has changed. + + -- Macro: compat-function fun + This macro returns the compatibility function symbol for FUN. See + ‘compat-call’ for a more convenient macro to directly call + compatibility functions. + + If Compat is used in core packages, where Compat must be required +currently with the ‘noerror’ flag, the macros ‘compat-call’ and +‘compat-function’ ar not available. In the future the macros could be +added to subr. Alternatively a minimal version of compat.el could be +added to the core. For now it is necessary to replicate the definition +of the macros within core packages. For example the package ERC defines +its own macro ‘erc-compat-call’, which replicates the Compat definition +precisely. + + This design has been chosen since Compat does not advise or override +existing functions. Generally Compat is written in defensive style +which is supposed to reduce potential breakage, and to increase the +chances of staying binary compatible across releases. The extensive +test coverage ensures that we can maintain high quality, which is +crucial for Compat which is not restricted to a namespace like usual +libraries. + + If you intend to use a compatibility function in your code it is +recommended that you take a look at the test suite ‘compat-tests.el’. +There you can see the supported calling conventions, which are +guaranteed to work on the supported Emacs versions. We ensure this +using continuous integration. All functions provided by Compat are +covered by the test suite. There is a link to the corresponding test on +the first line of each definition. + + You may want to subscribe to the compat-announce +(https://lists.sr.ht/~pkal/compat-announce) mailing list to be notified +when new versions are released or relevant changes are made. We also +provide a development mailing list +(https://lists.sr.ht/~pkal/compat-devel) (~pkal/compat-devel@lists.sr.ht +<~pkal/compat-devel@lists.sr.ht>). + + +File: doc5ZeelO.info, Node: Limitations, Prev: Usage, Up: Introduction + +1.3 Limitations +=============== + +The Compat library has a number of limitations. Complete backwards +compatibility cannot be provided due to the scope of Compat and for +technical reasons. The scope is intentionally restricted in order to +limit the size of Compat and to ensure that the library stays +maintainable. + + Emacs version 24.4 is chosen as the oldest version supported by +Compat, since Elisp has seen significant changes at that version. On +the library level, subr-x was introduced in 24.4. Most popular Emacs +packages already require 24.4 or even newer versions of Emacs. +Supporting for more historical Emacs versions would complicate +maintainance significantly while only few packages and users would +benefit. + + Below we list a number of reasons why certain functionality cannot be +provided. Note that in some special cases exceptions can be made and +functions can still be added to Compat even if they satisfy the criteria +from the list. In case you miss functionality which you think should +belong here, a *note report: Development. would be much appreciated. + + • The additional functionality is a command or a user-facing minor or + major mode. Compat is limited to functionality on the “library + level”. Generally functions provided by Compat are + non-interactive, such that the user interface (M-x) is unaffected + by the presence of Compat. + + • The function is not useful for package authors or not intended to + be used by packages, but is only useful on the configuration level. + The macro ‘setopt’ is such an example. + + • The added or extended function belongs to the “application level” + and not the “library level”. Features which are not preloaded + often belong to the “application level”. Application examples are + programming modes or modes like Dired, IRC and Gnus. If these + modes are extended with new functions, these are not ported back. + + • An existing function or macro was extended by some new + functionality. To support these cases, the function or macro would + have to be advised. Since this is invasive and adds significant + overhead, even when the new feature is not used, Compat does not + use advices. As a compromise, compatibility functions and macros + with a changed calling convention or behavior can be accessed via + the ‘compat-function’ and ‘compat-call’ macros. In this manual we + call such definitions “Extended Definitions”. An example is the + function ‘plist-get’. Note that extended functions are subject to + closer scrutiny, since their usage via ‘compat-call’ is not + completely painless. If a particular extended function does not + see much usage or the extension yields only marginal benefits, we + may not provide it as part of Compat. + + • Bug fixes are usually not ported back as part of Compat. Sometimes + library functions show wrong behavior for edge cases. In those + cases Compat could in principle provide a compatibility function + which is invoked via ‘compat-call’. Such extended definitions + would increase the maintainance burden of Compat. At the same time + the benefits would be small given that Compat does not override + existing definitions. + + • The definition belongs to an Emacs core package, which is also + distributed via ELPA. Compat does not have to provide backward + compatibility for core packages since the updated package can be + installed directly from ELPA. Examples include the libraries xref, + project, seq, map and transient. + + • New functionality depends on an entire new, non-trivial core + library, which is infeasible to duplicate within Compat. If a + backport of such a library is required, the preferred approach is + to either release the library separately on GNU ELPA as a core + package or as a separately maintained GNU ELPA package. An example + is the iso8601 library. + + • New functionality was implemented in the C core, or depends on + external libraries that cannot be reasonably duplicated in the + scope of a compatibility library. Sometimes new functions on the C + level rely on internal data structures, which we cannot access, + rendering a backport impossible. For example a missing libxml + cannot be emulated. + + • The semantics of Elisp changed on a deep level. For example the + addition of Bigint support in Emacs 27.1 cannot be replicated on + the level of Compat. + + +File: doc5ZeelO.info, Node: Support, Next: Development, Prev: Introduction, Up: Top + +2 Support +********* + +This section goes into the features that Compat manages and doesn’t +manage to provide for each Emacs version. + +* Menu: + +* Emacs 25.1:: Compatibility support for Emacs 25.1 +* Emacs 26.1:: Compatibility support for Emacs 26.1 +* Emacs 27.1:: Compatibility support for Emacs 27.1 +* Emacs 28.1:: Compatibility support for Emacs 28.1 +* Emacs 29.1:: Compatibility support for Emacs 29.1 + + +File: doc5ZeelO.info, Node: Emacs 25.1, Next: Emacs 26.1, Up: Support + +2.1 Emacs 25.1 +============== + +2.1.1 Added Definitions +----------------------- + +The following functions and macros are implemented in Emacs 25.1. These +functions are made available by Compat on Emacs versions older than +25.1. + + -- User Option: text-quoting-style + The value of this user option is a symbol that specifies the style + Emacs should use for single quotes in the wording of help and + messages. If the option’s value is ‘curve’, the style is ‘like + this’ with curved single quotes. If the value is ‘straight’, the + style is 'like this' with straight apostrophes. If the value is + ‘grave’, quotes are not translated and the style is `like this' + with grave accent and apostrophe, the standard style before Emacs + version 25. The default value ‘nil’ acts like ‘curve’ if curved + single quotes seem to be displayable, and like ‘grave’ otherwise. + + This option is useful on platforms that have problems with curved + quotes. You can customize it freely according to your personal + preference. + + -- Function: region-bounds + Return the boundaries of the region. Value is a list of one or + more cons cells of the form ‘(start . end)’. It will have more + than one cons cell when the region is non-contiguous, see + ‘region-noncontiguous-p’ and ‘extract-rectangle-bounds’. + + -- Function: region-noncontiguous-p + Return non-nil if the region contains several pieces. An example + is a rectangular region handled as a list of separate contiguous + regions for each line. + + -- Macro: save-mark-and-excursion body... + This macro is like ‘save-excursion’, but also saves and restores + the mark location and ‘mark-active’. This macro does what + ‘save-excursion’ did before Emacs 25.1. + + -- Function: format-message string &rest objects + This function acts like ‘format’, except it also converts any grave + accents (`) and apostrophes (') in STRING as per the value of + ‘text-quoting-style’. + + Typically grave accent and apostrophe in the format translate to + matching curved quotes, e.g., "Missing `%s'" might result in + "Missing ‘foo’". *Note (elisp)Text Quoting Style::, for how to + influence or inhibit this translation. + + *note (elisp)Formatting Strings::. + + -- Function: directory-name-p filename + This function returns non-‘nil’ if FILENAME ends with a directory + separator character. This is the forward slash ‘/’ on GNU and + other POSIX-like systems; MS-Windows and MS-DOS recognize both the + forward slash and the backslash ‘\’ as directory separators. + + *Note (elisp)Directory Names::. + + -- Function: string-greaterp string1 string2 + This function returns the result of comparing STRING1 and STRING2 + in the opposite order, i.e., it is equivalent to calling + ‘(string-lessp STRING2 STRING1)’. + + *Note (elisp)Text Comparison::. + + -- Macro: with-file-modes mode body... + This macro evaluates the BODY forms with the default permissions + for new files temporarily set to MODES (whose value is as for + ‘set-file-modes’ above). When finished, it restores the original + default file permissions, and returns the value of the last form in + BODY. + + This is useful for creating private files, for example. + + *Note (elisp)Changing Files::. + + -- Function: alist-get key alist &optional default remove + This function is similar to ‘assq’. It finds the first association + ‘(KEY . VALUE)’ by comparing KEY with ALIST elements, and, if + found, returns the VALUE of that association. If no association is + found, the function returns DEFAULT. + + This is a generalized variable (*note (elisp)Generalized + Variables::) that can be used to change a value with ‘setf’. When + using it to set a value, optional argument REMOVE non-‘nil’ means + to remove KEY’s association from ALIST if the new value is ‘eql’ to + DEFAULT. + + *note (elisp)Association Lists::. + + -- Macro: if-let (bindings...) then &rest else... + As with ‘let*’, BINDINGS will consist of ‘(SYMBOL VALUE-FORM)’ + entries that are evaluated and bound sequentially. If all + VALUE-FORM evaluate to non-‘nil’ values, then THEN is evaluated as + were the case with a regular ‘let*’ expression, with all the + variables bound. If any VALUE-FORM evaluates to ‘nil’, ELSE is + evaluated, without any bound variables. + + A binding may also optionally drop the SYMBOL, and simplify to + ‘(VALUE-FORM)’ if only the test is of interest. + + For the sake of backwards compatibility, it is possible to write a + single binding without a binding list: + + (if-let* (SYMBOL (test)) foo bar) + ≡ + (if-let* ((SYMBOL (test))) foo bar) + + -- Macro: when-let (bindings...) &rest body + As with ‘when’, if one is only interested in the case where all + BINDINGS are non-nil. Otherwise BINDINGS are interpreted just as + they are by ‘if-let*’. + + -- Function: hash-table-empty hash-table + Check whether HASH-TABLE is empty (has 0 elements). + + -- Macro: thread-first &rest forms + Combine FORMS into a single expression by “threading” each element + as the _first_ argument of their successor. Elements of FORMS can + either be an list of an atom. + + For example, consider the threading expression and it’s equivalent + macro expansion: + + (thread-first + 5 + (+ 20) + (/ 25) + - + (+ 40)) + ≡ + (+ (- (/ (+ 5 20) 25)) 40) + + Note how the single ‘-’ got converted into a list before threading. + This example uses arithmetic functions, but ‘thread-first’ is not + restricted to arithmetic or side-effect free code. + + -- Macro: thread-last &rest forms + Combine FORMS into a single expression by “threading” each element + as the _last_ argument of their successor. Elements of FORMS can + either be an list of an atom. + + For example, consider the threading expression and it’s equivalent + macro expansion: + + (thread-first + 5 + (+ 20) + (/ 25) + - + (+ 40)) + ≡ + (+ 40 (- (/ 25 (+ 20 5)))) + + Note how the single ‘-’ got converted into a list before threading. + This example uses arithmetic functions, but ‘thread-last’ is not + restricted to arithmetic or side-effect free code. + + -- Function: macroexpand-1 form &optional environment + This function expands macros like ‘macroexpand’, but it only + performs one step of the expansion: if the result is another macro + call, ‘macroexpand-1’ will not expand it. + + *Note Expansion: (elisp)Expansion. + + -- Function: macroexp-quote e + Return an expression E such that ‘(eval e)’ is V. + + -- Function: macroexp-parse body + Parse a function BODY into ‘(declarations . exps)’. + + -- Function: bool-vector &rest objects + This function creates and returns a bool-vector whose elements are + the arguments, OBJECTS. + + *Note (elisp)Bool-Vectors::. + +2.1.2 Extended Definitions +-------------------------- + +These functions must be called explicitly via ‘compat-call’, since their +calling convention or behavior was extended in Emacs 25.1: + + -- Function: compat-call sort sequence predicate + This function sorts SEQUENCE stably. Note that this function + doesn’t work for all sequences; it may be used only for lists and + vectors. If SEQUENCE is a list, it is modified destructively. + This functions returns the sorted SEQUENCE and compares elements + using PREDICATE. A stable sort is one in which elements with equal + sort keys maintain their relative order before and after the sort. + Stability is important when successive sorts are used to order + elements according to different criteria. + + *Note (elisp)Sequence Functions::. + + The compatibility version adds support for vectors to be sorted, + not just lists. + +2.1.3 Missing Definitions +------------------------- + +Compat does not provide support for the following Lisp features +implemented in 25.1: + + • The function ‘macroexp-macroexpand’. + • The macro ‘macroexp-let2*’. + • The function ‘directory-files-recursively’. + • New ‘pcase’ patterns. + • The hook ‘prefix-command-echo-keystrokes-functions’ and + ‘prefix-command-preserve-state-hook’. + • The hook ‘pre-redisplay-functions’. + • The function ‘make-process’. + • Support for the variable ‘inhibit-message’. + • The ‘define-inline’ functionality. + • The functions ‘string-collate-lessp’ and ‘string-collate-equalp’. + • The function ‘funcall-interactively’. + • The function ‘buffer-substring-with-bidi-context’. + • The function ‘font-info’. + • The function ‘default-font-width’. + • The function ‘window-font-height’ and ‘window-font-width’. + • The function ‘window-max-chars-per-line’. + • The function ‘set-binary-mode’. + • The functions ‘bufferpos-to-filepos’ and ‘filepos-to-bufferpos’. + • The ‘thunk’ library. + + +File: doc5ZeelO.info, Node: Emacs 26.1, Next: Emacs 27.1, Prev: Emacs 25.1, Up: Support + +2.2 Emacs 26.1 +============== + +2.2.1 Added Definitions +----------------------- + +The following functions and macros are implemented in Emacs 26.1. These +functions are made available by Compat on Emacs versions older than +26.1. + + -- Function: assoc-delete-all key alist + This function is like ‘assq-delete-all’ except that it uses ‘equal’ + to compare elements. + + -- Function: read-answer question answers + This function prompts the user with text in QUESTION, which should + end in the ‘SPC’ character. The function includes in the prompt + the possible responses in ANSWERS by appending them to the end of + QUESTION. The possible responses are provided in ANSWERS as an + alist whose elements are of the following form: + + (LONG-ANSWER SHORT-ANSWER HELP-MESSAGE) + + where LONG-ANSWER is the complete text of the user response, a + string; SHORT-ANSWER is a short form of the same response, a single + character or a function key; and HELP-MESSAGE is the text that + describes the meaning of the answer. If the variable + ‘read-answer-short’ is non-‘nil’, the prompt will show the short + variants of the possible answers and the user is expected to type + the single characters/keys shown in the prompt; otherwise the + prompt will show the long variants of the answers, and the user is + expected to type the full text of one of the answers and end by + pressing . If ‘use-dialog-box’ is non-‘nil’, and this + function was invoked by mouse events, the question and the answers + will be displayed in a GUI dialog box. + + The function returns the text of the LONG-ANSWER selected by the + user, regardless of whether long or short answers were shown in the + prompt and typed by the user. + + Here is an example of using this function: + + (let ((read-answer-short t)) + (read-answer "Foo " + '(("yes" ?y "perform the action") + ("no" ?n "skip to the next") + ("all" ?! "perform for the rest without more questions") + ("help" ?h "show help") + ("quit" ?q "exit")))) + + -- Function: mapcan function sequence + This function applies FUNCTION to each element of SEQUENCE, like + ‘mapcar’, but instead of collecting the results into a list, it + returns a single list with all the elements of the results (which + must be lists), by altering the results (using ‘nconc’; *note + (elisp)Rearrangement::). Like with ‘mapcar’, SEQUENCE can be of + any type except a char-table. + + ;; Contrast this: (mapcar #'list '(a b c d)) ⇒ ((a) (b) (c) + (d)) ;; with this: (mapcan #'list '(a b c d)) ⇒ (a b c d) + + *Note (elisp)Mapping Functions::. + + -- Function: cXXXr + -- Function: cXXXXr + *Note (elisp)List Elements::. + + -- Function: gensym &optional prefix + This function returns a symbol using ‘make-symbol’, whose name is + made by appending ‘gensym-counter’ to PREFIX and incrementing that + counter, guaranteeing that no two calls to this function will + generate a symbol with the same name. The prefix defaults to + ‘"g"’. + + -- Variable: gensym-counter + See ‘gensym’. + + -- Function: buffer-hash &optional buffer-or-name + Return a hash of BUFFER-OR-NAME. If ‘nil’, this defaults to the + current buffer. As opposed to ‘secure-hash’, this function + computes the hash based on the internal representation of the + buffer, disregarding any coding systems. It’s therefore only + useful when comparing two buffers running in the same Emacs, and is + not guaranteed to return the same hash between different Emacs + versions. It should be somewhat more efficient on larger buffers + than ‘secure-hash’ is, and should not allocate more memory. + + -- Macro: file-name-unquote name + This macro removes the quotation prefix ‘/:’ from the file NAME, if + any. If NAME is a remote file name, the local part of NAME is + unquoted. + + -- Function: file-name-quoted-p name + This macro returns non-‘nil’, when NAME is quoted with the prefix + ‘/:’. If NAME is a remote file name, the local part of NAME is + checked. + + *Note (elisp)File Name Expansion::. + + -- Function: file-name-quote name + This macro adds the quotation prefix ‘/:’ to the file NAME. For a + local file NAME, it prefixes NAME with ‘/:’. If NAME is a remote + file name, the local part of NAME (*note (elisp)Magic File Names::) + is quoted. If NAME is already a quoted file name, NAME is returned + unchanged. + + (substitute-in-file-name (compat-call file-name-quote "bar/~/foo")) ⇒ + "/:bar/~/foo" + + (substitute-in-file-name (compat-call file-name-quote "/ssh:host:bar/~/foo")) + ⇒ "/ssh:host:/:bar/~/foo" + + The macro cannot be used to suppress file name handlers from magic + file names (*note (elisp)Magic File Names::). + + *Note (elisp)File Name Expansion::. + + -- Function: make-nearby-temp-file prefix &optional dir-flag suffix + This function is similar to ‘make-temp-file’, but it creates a + temporary file as close as possible to ‘default-directory’. If + PREFIX is a relative file name, and ‘default-directory’ is a remote + file name or located on a mounted file systems, the temporary file + is created in the directory returned by the function + ‘temporary-file-directory’. Otherwise, the function + ‘make-temp-file’ is used. PREFIX, DIR-FLAG and SUFFIX have the + same meaning as in ‘make-temp-file’. + + (let ((default-directory "/ssh:remotehost:")) (make-nearby-temp-file + "foo")) ⇒ "/ssh:remotehost:/tmp/foo232J6v" + + -- Variable: mounted-file-systems + A regular expression matching files names that are probably on a + mounted file system. + + -- Function: temporary-file-directory + The directory for writing temporary files via + ‘make-nearby-temp-file’. In case of a remote ‘default-directory’, + this is a directory for temporary files on that remote host. If + such a directory does not exist, or ‘default-directory’ ought to be + located on a mounted file system (see ‘mounted-file-systems’), the + function returns ‘default-directory’. For a non-remote and + non-mounted ‘default-directory’, the value of the variable + ‘temporary-file-directory’ is returned. + + *Note (elisp)Unique File Names::. + + -- Macro: if-let* (bindings...) then &rest else + ‘if-let*’ is mostly equivalent to ‘if-let’, with the exception that + the legacy ‘(if (VAR (test)) foo bar)’ syntax is not permitted. + + -- Macro: when-let* (bindings...) then &rest else + ‘when-let*’ is mostly equivalent to ‘when-let’, with the exception + that the legacy ‘(when-let (VAR (test)) foo bar)’ syntax is not + permitted. + + -- Macro: and-let* (bindings...) &rest body + A combination of LET* and AND, analogous to ‘when-let*’. If all + BINDINGS are non-‘nil’ and BODY is ‘nil’, then the result of the + ‘and-let*’ form will be the last value bound in BINDINGS. + + **Please Note:** The implementation provided by Compat does not + include a bug that was observed with Emacs 26 (see + ). + + -- Function: file-local-name filename + This function returns the _local part_ of FILENAME. This is the + part of the file’s name that identifies it on the remote host, and + is typically obtained by removing from the remote file name the + parts that specify the remote host and the method of accessing it. + For example: + + (file-local-name "/ssh:USER@HOST:/foo/bar") ⇒ + "/foo/bar" + + For a remote FILENAME, this function returns a file name which + could be used directly as an argument of a remote process (*note + (elisp)Asynchronous Processes::, and *note (elisp)Synchronous + Processes::), and as the program to run on the remote host. If + FILENAME is local, this function returns it unchanged. + + *Note (elisp)Magic File Names::. + + -- Function: read-multiple-choice prompt choices + Ask user a multiple choice question. PROMPT should be a string + that will be displayed as the prompt. + + CHOICES is an alist where the first element in each entry is a + character to be entered, the second element is a short name for the + entry to be displayed while prompting (if there’s room, it might be + shortened), and the third, optional entry is a longer explanation + that will be displayed in a help buffer if the user requests more + help. + + See *note Reading One Event: (elisp)Reading One Event. + + -- Function: image-property + Defined in ‘image.el’. + + This function can also be used as a generalised variable. + + -- Function: file-attribute-type + Return the field _type_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-link-number + Return the field _link-number_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-user-id + Return the field _user-id_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-group-id + Return the field _group-id_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-access-time + Return the field _access-time_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-modification-time + Return the field _modification-time_ as generated by + ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-status-change-time + Return the field _modification-time_ as generated by + ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-size + Return the field _size_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-modes + Return the field _modes_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-inode-number + Return the field _inode-number_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-device-number + Return the field _device-number_ as generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-attribute-collect attributes &rest attr-names + Filter the file attributes ATTRIBUTES, as generated by + ‘file-attributes’, according to ATTR-NAMES. + + Valid attribute names for ATTR-NAMES are: type, link-number, + user-id, group-id, access-time, modification-time, + status-change-time, size, modes, inode-number and device-number. + + (file-attributes ".") ⇒ (t 1 1000 1000 (25329 18215 325481 96000) (25325 15364 530263 840000) (25325 15364 530263 840000) 788 "drwxr-xr-x" t 137819 40) + (file-attribute-collect (file-attributes ".") 'type 'modes + 'inode-number) ⇒ (t "drwxr-xr-x" 137819) + +2.2.2 Extended Definitions +-------------------------- + +These functions must be called explicitly via ‘compat-call’, since their +calling convention or behavior was extended in Emacs 26.1: + + -- Function: compat-call make-temp-file prefix &optional dir-flag + suffix text + This function creates a temporary file and returns its name. Emacs + creates the temporary file’s name by adding to PREFIX some random + characters that are different in each Emacs job. The result is + guaranteed to be a newly created file, containing TEXT if that’s + given as a string and empty otherwise. On MS-DOS, this function + can truncate PREFIX to fit into the 8+3 file-name limits. If + PREFIX is a relative file name, it is expanded against + ‘temporary-file-directory’. + + The compatibility version adds support for handling the optional + argument TEXT. + + (make-temp-file "foo") + ⇒ "/tmp/foo232J6v" + + When ‘make-temp-file’ returns, the file has been created and is + empty. At that point, you should write the intended contents into + the file. + + If DIR-FLAG is non-‘nil’, ‘make-temp-file’ creates an empty + directory instead of an empty file. It returns the file name, not + the directory name, of that directory. *Note (elisp)Directory + Names::. + + If SUFFIX is non-‘nil’, ‘make-temp-file’ adds it at the end of the + file name. + + If TEXT is a string, ‘make-temp-file’ inserts it in the file. + + To prevent conflicts among different libraries running in the same + Emacs, each Lisp program that uses ‘make-temp-file’ should have its + own PREFIX. The number added to the end of PREFIX distinguishes + between the same application running in different Emacs jobs. + Additional added characters permit a large number of distinct names + even in one Emacs job. + + -- Function: compat-call assoc key alist &optional testfn + This function returns the first association for KEY in ALIST, + comparing KEY against the alist elements using TESTFN if it is a + function, and ‘equal’ otherwise (*note (elisp)Equality + Predicates::). If TESTFN is a function, it is called with two + arguments: the CAR of an element from ALIST and KEY. The function + returns ‘nil’ if no association in ALIST has a CAR equal to KEY, as + tested by TESTFN. + + *Note (elisp)Association Lists::. + + The compatibility version adds support for handling the optional + argument TESTFN. + + -- Function: compat-call line-number-at-pos &optional pos absolute + This function returns the line number in the current buffer + corresponding to the buffer position POS. If POS is ‘nil’ or + omitted, the current buffer position is used. If ABSOLUTE is + ‘nil’, the default, counting starts at ‘(point-min)’, so the value + refers to the contents of the accessible portion of the + (potentially narrowed) buffer. If ABSOLUTE is non-‘nil’, ignore + any narrowing and return + + *Note (elisp)Text Lines::. + + The compatibility version adds support for handling the optional + argument ABSOLUTE. + + -- Function: compat-call alist-get key alist &optional default remove + testfn + *Note (elisp)Association Lists::. This function is similar to + ‘assq’. It finds the first association ‘(KEY . VALUE)’ by + comparing KEY with ALIST elements, and, if found, returns the VALUE + of that association. If no association is found, the function + returns DEFAULT. Comparison of KEY against ALIST elements uses the + function specified by TESTFN, defaulting to ‘eq’. + + *Note (elisp)Association Lists::. + + The compatibility version handles the optional argument TESTFN. It + can also be used as a *note Generalized Variables: + (elisp)generalised variable. + + -- Function: compat-call string-trim-left string &optional regexp + Remove the leading text that matches REGEXP from STRING. REGEXP + defaults to ‘[ \t\n\r]+’. + + *Note (elisp)Creating Strings::. + + The compatibility version handles the optional argument REGEXP. + + -- Function: compat-call string-trim-right string &optional regexp + Remove the trailing text that matches REGEXP from STRING. REGEXP + defaults to ‘[ \t\n\r]+’. + + *Note (elisp)Creating Strings::. + + The compatibility version handles the optional argument REGEXP. + + -- Function: compat-call string-trim string &optional trim-left + trim-right + Remove the leading text that matches TRIM-LEFT and trailing text + that matches TRIM-RIGHT from STRING. Both regexps default to ‘[ + \t\n\r]+’. + + *Note (elisp)Creating Strings::. + + The compatibility version handles the optional arguments TRIM-LEFT + and TRIM-RIGHT. + +2.2.3 Missing Definitions +------------------------- + +Compat does not provide support for the following Lisp features +implemented in 26.1: + + • The function ‘func-arity’. + • The function ‘secure-hash-algorithms’. + • The function ‘gnutls-available-p’. + • Support for records and record functions. + • The function ‘mapbacktrace’. + • The function ‘file-name-case-insensitive-p’. + • The additional elements of ‘parse-partial-sexp’. + • The function ‘add-variable-watcher’. + • The function ‘undo-amalgamate-change-group’. + • The function ‘char-from-name’ + • Signalling errors when ‘length’ or ‘member’ deal with list cycles. + • The function ‘frame-list-z-order’. + • The function ‘frame-restack’. + • All changes related to ‘display-buffer’. + • The function ‘window-swap-states’. + • The function ‘string-version-lessp’. + • The ‘svg’ library. + • The ‘xdg’ library. + + +File: doc5ZeelO.info, Node: Emacs 27.1, Next: Emacs 28.1, Prev: Emacs 26.1, Up: Support + +2.3 Emacs 27.1 +============== + +2.3.1 Added Definitions +----------------------- + +The following functions and macros are implemented in Emacs 27.1. These +functions are made available by Compat on Emacs versions older than +27.1. + + -- Function: major-mode-suspend + This function works like ‘fundamental-mode’, in that it kills all + buffer-local variables, but it also records the major mode in + effect, so that it could subsequently be restored. This function + and ‘major-mode-restore’ (described next) are useful when you need + to put a buffer under some specialized mode other than the one + Emacs chooses for it automatically, but would also like to be able + to switch back to the original mode later. + + -- Function: major-mode-restore &optional avoided-modes + This function restores the major mode recorded by + ‘major-mode-suspend’. If no major mode was recorded, this function + calls ‘normal-mode’, but tries to force it not to choose any modes + in AVOIDED-MODES, if that argument is non-‘nil’. + + -- Function: ring-resize ring size + Set the size of RING to SIZE. If the new size is smaller, then the + oldest items in the ring are discarded. + + -- Function: minibuffer-history-value + Return the value of the minibuffer input history list. If + MINIBUFFER-HISTORY-VARIABLE points to a buffer-local variable and + the minibuffer is active, return the buffer-local value for the + buffer that was current when the minibuffer was activated." + + -- Macro: with-minibuffer-selected-window &rest body + Execute the forms in BODY from the minibuffer in its original + window. When used in a minibuffer window, select the window + selected just before the minibuffer was activated, and execute the + forms. + + -- Function: read-char-from-minibuffer prompt &optional chars history + This function uses the minibuffer to read and return a single + character. Optionally, it ignores any input that is not a member + of CHARS, a list of accepted characters. The HISTORY argument + specifies the history list symbol to use; if it is omitted or + ‘nil’, this function doesn’t use the history. + + If you bind ‘help-form’ to a non-‘nil’ value while calling + ‘read-char-from-minibuffer’, then pressing ‘help-char’ causes it to + evaluate ‘help-form’ and display the result. + + -- Function: bignump object + This predicate tests whether its argument is a large integer, and + returns ‘t’ if so, ‘nil’ otherwise. Unlike small integers, large + integers can be ‘=’ or ‘eql’ even if they are not ‘eq’. + + -- Function: fixnump object + This predicate tests whether its argument is a small integer, and + returns ‘t’ if so, ‘nil’ otherwise. Small integers can be compared + with ‘eq’. + + -- Special Form: with-suppressed-warnings warnings body... + In execution, this is equivalent to ‘(progn BODY...)’, but the + compiler does not issue warnings for the specified conditions in + BODY. WARNINGS is an association list of warning symbols and + function/variable symbols they apply to. For instance, if you wish + to call an obsolete function called ‘foo’, but want to suppress the + compilation warning, say: + + (with-suppressed-warnings ((obsolete foo)) + (foo ...)) + + -- Function: proper-list-p object + This function returns the length of OBJECT if it is a proper list, + ‘nil’ otherwise (*note (elisp)Cons Cells::). In addition to + satisfying ‘listp’, a proper list is neither circular nor dotted. + + (proper-list-p '(a b c)) ⇒ 3 + (proper-list-p '(a b . c)) ⇒ nil + + *Note (elisp)List-related Predicates::. + + -- Function: string-distance string1 string2 &optional bytecompare + This function returns the _Levenshtein distance_ between the source + string STRING1 and the target string STRING2. The Levenshtein + distance is the number of single-character changes—deletions, + insertions, or replacements—required to transform the source string + into the target string; it is one possible definition of the _edit + distance_ between strings. + + Letter-case of the strings is significant for the computed + distance, but their text properties are ignored. If the optional + argument BYTECOMPARE is non-‘nil’, the function calculates the + distance in terms of bytes instead of characters. The byte-wise + comparison uses the internal Emacs representation of characters, so + it will produce inaccurate results for multibyte strings that + include raw bytes (*note (elisp)Text Representations::); make the + strings unibyte by encoding them (*note (elisp)Explicit Encoding::) + if you need accurate results with raw bytes. + + *Note (elisp)Text Comparison::. + + -- Macro: ignore-errors body... + This construct executes BODY, ignoring any errors that occur during + its execution. If the execution is without error, ‘ignore-errors’ + returns the value of the last form in BODY; otherwise, it returns + ‘nil’. + + Here’s the example at the beginning of this subsection rewritten + using ‘ignore-errors’: + + (ignore-errors (delete-file filename)) + + *Note (elisp)Handling Errors::. + + -- Macro: dolist-with-progress-reporter (var count [result]) + reporter-or-message body... + This is another convenience macro that works the same way as + ‘dolist’ does, but also reports loop progress using the functions + described above. As in ‘dotimes-with-progress-reporter’, + ‘reporter-or-message’ can be a progress reporter or a string. You + can rewrite the previous example with this macro as follows: + + (dolist-with-progress-reporter (k (number-sequence 0 500)) "Collecting + some mana for Emacs..." (sit-for 0.01)) + + *Note (elisp)Progress::. + + -- Function: flatten-tree tree + This function returns a “flattened” copy of TREE, that is, a list + containing all the non-‘nil’ terminal nodes, or leaves, of the tree + of cons cells rooted at TREE. Leaves in the returned list are in + the same order as in TREE. + + (flatten-tree '(1 (2 . 3) nil (4 5 (6)) 7)) ⇒(1 2 3 4 5 6 7) + + *Note (elisp)Building Lists::. + + -- Function: xor condition1 condition2 + This function returns the boolean exclusive-or of CONDITION1 and + CONDITION2. That is, ‘xor’ returns ‘nil’ if either both arguments + are ‘nil’, or both are non-‘nil’. Otherwise, it returns the value + of that argument which is non-‘nil’. + + Note that in contrast to ‘or’, both arguments are always evaluated. + + *Note (elisp)Combining Conditions::. + + -- Variable: regexp-unmatchable + This variable contains a regexp that is guaranteed not to match any + string at all. It is particularly useful as default value for + variables that may be set to a pattern that actually matches + something. + + *Note (elisp)Regexp Functions:: + + -- Function: decoded-time-second time + Return the SECONDS field of a ‘decoded-time’ record TIME. It can + also be used as a *note Generalized Variables: (elisp)generalised + variable. + + -- Function: decoded-time-minute time + Return the MINUTE field of a ‘decoded-time’ record TIME. It can + also be used as a *note Generalized Variables: (elisp)generalised + variable. + + -- Function: decoded-time-hour time + Return the HOUR field of a ‘decoded-time’ record TIME. It can also + be used as a *note Generalized Variables: (elisp)generalised + variable. + + -- Function: decoded-time-day time + Return the DAY field of a ‘decoded-time’ record TIME. It can also + be used as a *note Generalized Variables: (elisp)generalised + variable. + + -- Function: decoded-time-month time + Return the MONTH field of a ‘decoded-time’ record TIME. It can + also be used as a *note Generalized Variables: (elisp)generalised + variable. + + -- Function: decoded-time-year time + Return the YEAR field of a ‘decoded-time’ record TIME. It can also + be used as a *note Generalized Variables: (elisp)generalised + variable. + + -- Function: decoded-time-weekday time + Return the WEEKDAY field of a ‘decoded-time’ record TIME. It can + also be used as a *note Generalized Variables: (elisp)generalised + variable. + + -- Function: decoded-time-dst time + Return the DST (daylight saving time indicator) field of a + ‘decoded-time’ record TIME. It can also be used as a *note + Generalized Variables: (elisp)generalised variable. + + -- Function: decoded-time-zone time + Return the ZONE field of a ‘decoded-time’ record TIME. It can also + be used as a *note Generalized Variables: (elisp)generalised + variable. + + -- Function: package-get-version + Return the version number of the package in which this is used. + + -- Function: time-equal-p t1 t2 + This returns ‘t’ if the two time values T1 and T2 are equal. + + *Note (elisp)Time Calculations::. + + -- Function: date-days-in-month year month + Return the number of days in MONTH in YEAR. For instance, February + 2020 has 29 days. + + *Note (elisp)Time Calculations::. This function requires the + ‘time-date’ feature to be loaded. + + -- Function: date-ordinal-to-time year ordinal + Convert a YEAR/ORDINAL to the equivalent decoded-time structure. + ORDINAL is the number of days since the start of the year, with + January 1st being 1. + + *Note (elisp)Time Calculations::. This function requires the + ‘time-date’ feature to be loaded. + + -- User Option: exec-path + The value of this variable is a list of directories to search for + programs to run in subprocesses. Each element is either the name + of a directory (i.e., a string), or ‘nil’, which stands for the + default directory (which is the value of ‘default-directory’). + *Note executable-find: (elisp)Locating Files, for the details of + this search. + + The value of ‘exec-path’ is used by ‘call-process’ and + ‘start-process’ when the PROGRAM argument is not an absolute file + name. + + Generally, you should not modify ‘exec-path’ directly. Instead, + ensure that your ‘PATH’ environment variable is set appropriately + before starting Emacs. Trying to modify ‘exec-path’ independently + of ‘PATH’ can lead to confusing results. + + *Note (elisp)Subprocess Creation::. + + -- Function: provided-mode-derived-p mode &rest modes + This function returns non-‘nil’ if MODE is derived from any of the + major modes given by the symbols MODES. + + -- Function: file-size-human-readable-iec size + Human-readable string for SIZE bytes, using IEC prefixes. + + -- Function: make-empty-file filename &optional parents + This function creates an empty file named FILENAME. As + ‘make-directory’, this function creates parent directories if + PARENTS is non-‘nil’. If FILENAME already exists, this function + signals an error. + + -- Function: text-property-search-forward prop &optional value + predicate not-current + Search for the next region that has text property PROP set to VALUE + according to PREDICATE. + + This function is modeled after ‘search-forward’ and friends in that + it moves point, but it returns a structure that describes the match + instead of returning it in ‘match-beginning’ and friends. + + If the text property can’t be found, the function returns ‘nil’. + If it’s found, point is placed at the end of the region that has + this text property match, and a ‘prop-match’ structure is returned. + + PREDICATE can either be ‘t’ (which is a synonym for ‘equal’), ‘nil’ + (which means “not equal”), or a predicate that will be called with + two parameters: The first is VALUE, and the second is the value of + the text property we’re inspecting. + + If NOT-CURRENT, if point is in a region where we have a match, then + skip past that and find the next instance instead. + + The ‘prop-match’ structure has the following accessors: + ‘prop-match-beginning’ (the start of the match), ‘prop-match-end’ + (the end of the match), and ‘prop-match-value’ (the value of + PROPERTY at the start of the match). + + In the examples below, imagine that you’re in a buffer that looks + like this: + + This is a bold and here's bolditalic and this is the end. + + That is, the “bold” words are the ‘bold’ face, and the “italic” + word is in the ‘italic’ face. + + With point at the start: + + (while (setq match (text-property-search-forward 'face 'bold t)) + (push (buffer-substring (prop-match-beginning match) + (prop-match-end match)) + words)) + + This will pick out all the words that use the ‘bold’ face. + + (while (setq match (text-property-search-forward 'face nil t)) + (push (buffer-substring (prop-match-beginning match) + (prop-match-end match)) + words)) + + This will pick out all the bits that have no face properties, which + will result in the list ‘("This is a " "and here's " "and this is + the end")’ (only reversed, since we used ‘push’). + + (while (setq match (text-property-search-forward 'face nil nil)) + (push (buffer-substring (prop-match-beginning match) + (prop-match-end match)) + words)) + + This will pick out all the regions where ‘face’ is set to + something, but this is split up into where the properties change, + so the result here will be ‘("bold" "bold" "italic")’. + + For a more realistic example where you might use this, consider + that you have a buffer where certain sections represent URLs, and + these are tagged with ‘shr-url’. + + (while (setq match (text-property-search-forward 'shr-url nil nil)) + (push (prop-match-value match) urls)) + + This will give you a list of all those URLs. + + *Note (Property Search)elisp::. + + -- Function: text-property-search-backward prop &optional value + predicate not-current + This is just like ‘text-property-search-forward’, but searches + backward instead. Point is placed at the beginning of the matched + region instead of the end, though. + + *Note (Property Search)elisp::. + +2.3.2 Extended Definitions +-------------------------- + +These functions must be called explicitly via ‘compat-call’, since their +calling convention or behavior was extended in Emacs 27.1: + + -- Function: compat-call recenter &optional count redisplay + This function scrolls the text in the selected window so that point + is displayed at a specified vertical position within the window. + It does not move point with respect to the text. + + *Note (elisp)Textual Scrolling::. + + This compatibility version adds support for the optional argument + REDISPLAY. + + -- Function: compat-call lookup-key keymap key &optional + accept-defaults + This function returns the definition of KEY in KEYMAP. If the + string or vector KEY is not a valid key sequence according to the + prefix keys specified in KEYMAP, it must be too long and have extra + events at the end that do not fit into a single key sequence. Then + the value is a number, the number of events at the front of KEY + that compose a complete key. + + *Note (elisp)Low-Level Key Binding::. + + This compatibility version allows for KEYMAP to be a list of + keymaps, instead of just a singular keymap. + + -- Macro: compat-call setq-local &rest pairs + PAIRS is a list of variable and value pairs. This macro creates a + buffer-local binding in the current buffer for each of the + variables, and gives them a buffer-local value. It is equivalent + to calling ‘make-local-variable’ followed by ‘setq’ for each of the + variables. The variables should be unquoted symbols. + + (setq-local var1 "value1" + var2 "value2") + + *Note (elisp)Creating Buffer-Local::. + + This compatibility version allows for more than one variable to be + set at once, as can be done with ‘setq’. + + -- Function: compat-call regexp-opt strings &optional paren + This function returns an efficient regular expression that will + match any of the strings in the list STRINGS. This is useful when + you need to make matching or searching as fast as possible—for + example, for Font Lock mode. + + *Note (elisp)Regexp Functions::. + + The compatibility version of this functions handles the case where + STRINGS in an empty list. In that case, a regular expression is + generated that never matches anything (see ‘regexp-unmatchable’). + + -- Function: compat-call file-size-human-readable file-size &optional + flavor space unit + Return a string with a human readable representation of FILE-SIZE. + + The optional second argument FLAVOR controls the units and the + display format. If FLAVOR is... + + • ‘si’, each kilobyte is 1000 bytes and the produced suffixes + are ‘k’, ‘M’, ‘G’, ‘T’, etc. + • ‘iec’, each kilobyte is 1024 bytes and the produced suffixes + are ‘KiB’, ‘MiB’, ‘GiB’, ‘TiB’, etc. + • ‘nil’ or omitted, each kilobyte is 1024 bytes and the produced + suffixes are ‘k’, ‘M’, ‘G’, ‘T’, etc. + + The compatibility version handles the optional third (SPACE) and + forth (UNIT) arguments. The argument SPACE can be a string that is + placed between the number and the unit. The argument UNIT + determines the unit to use. By default it will be an empty string, + unless FLAVOR is ‘iec’, in which case it will be ‘B’. + + -- Function: compat-call assoc-delete-all key alist &optional test + This function is like ‘assq-delete-all’ except that it accepts an + optional argument TEST, a predicate function to compare the keys in + ALIST. If omitted or ‘nil’, TEST defaults to ‘equal’. As + ‘assq-delete-all’, this function often modifies the original list + structure of ALIST. + + *Note (elisp)Association Lists::. + + This compatibility version handles the optional third (TESTFN) + argument. + + -- Function: compat-call executable-find program &optional remote + This function searches for the executable file of the named PROGRAM + and returns the absolute file name of the executable, including its + file-name extensions, if any. It returns ‘nil’ if the file is not + found. The function searches in all the directories in + ‘exec-path’, and tries all the file-name extensions in + ‘exec-suffixes’ (*note (elisp)Subprocess Creation::). + + If REMOTE is non-‘nil’, and ‘default-directory’ is a remote + directory, PROGRAM is searched on the respective remote host. + + *Note (elisp)Locating Files::. + + This compatibility version adds support to handle the optional + second (REMOTE) argument. + +2.3.3 Missing Definitions +------------------------- + +Compat does not provide support for the following Lisp features +implemented in 27.1: + + • The functions ‘base64url-encode-*’. + • The function ‘decoded-time-add’. + • The function ‘decoded-time-set-defaults’. + • The function ‘time-convert’. + • The macro ‘benchmark-progn’. + • Support for ‘condition-case’ to handle t. + • The function ‘file-system-info’. + • The function ‘group-name’. + • The function ‘face-extend-p’ and ‘set-face-extend’. + • Additional ‘format-spec’ modifiers. + • Support for additional body forms for + ‘define-globalized-minor-mode’. + • The macro ‘with-connection-local-variables’ and related + functionality. + • The ‘iso8601’ library. + • The ‘exif’ library. + • The ‘image-converter’ library. + + +File: doc5ZeelO.info, Node: Emacs 28.1, Next: Emacs 29.1, Prev: Emacs 27.1, Up: Support + +2.4 Emacs 28.1 +============== + +2.4.1 Added Definitions +----------------------- + +The following functions and macros are implemented in Emacs 28.1. These +functions are made available by Compat on Emacs versions older than +28.1. + + -- Function: process-lines-ignore-status program &rest args + This function is just like ‘process-lines’, but does not signal an + error if PROGRAM exits with a non-zero exit status. + + -- Function: process-lines-handling-status program status-handler &rest + args + Execute PROGRAM with ARGS, returning its output as a list of lines. + If STATUS-HANDLER is non-nil, it must be a function with one + argument, which will be called with the exit status of the program + before the output is collected. If STATUS-HANDLER is nil, an error + is signaled if the program returns with a non-zero exit status. + + -- Function: text-quoting-style + You should not read the value of the variable ‘text-quoting-style’ + directly. Instead, use this function with the same name to + dynamically compute the correct quoting style on the current + terminal in the ‘nil’ case described above. + + -- Function: string-search needle haystack &optional start-pos + Return the position of the first instance of NEEDLE in HAYSTACK, + both of which are strings. If START-POS is non-‘nil’, start + searching from that position in NEEDLE. Return ‘nil’ if no match + was found. This function only considers the characters in the + strings when doing the comparison; text properties are ignored. + Matching is always case-sensitive. + + -- Function: length= sequence length + Return non-‘nil’ if the length of SEQUENCE is equal to LENGTH. + + -- Function: length< sequence length + Return non-‘nil’ if SEQUENCE is shorter than LENGTH. This may be + more efficient than computing the length of SEQUENCE if SEQUENCE is + a long list. + + -- Function: length> sequence length + Return non-‘nil’ if SEQUENCE is longer than LENGTH. + + -- Function: file-name-concat directory &rest components + Concatenate COMPONENTS to DIRECTORY, inserting a slash before the + components if DIRECTORY or the preceding component didn’t end with + a slash. + + (file-name-concat "/tmp" "foo") ⇒ "/tmp/foo" + + A DIRECTORY or components that are ‘nil’ or the empty string are + ignored—they are filtered out first and do not affect the results + in any way. + + This is almost the same as using ‘concat’, but DIRNAME (and the + non-final components) may or may not end with slash characters, and + this function will not double those characters. + + -- Function: garbage-collect-maybe factor + Suggest to run garbage collection, if _enough_ data has been + allocated. This is determined by the positive numerical argument + FACTOR, that would proportionally increase the likelihood of + garbage collection taking place. + + This compatibility function does nothing and ignores any + suggestion. + + -- Function: string-replace from-string to-string in-string + This function replaces all occurrences of FROM-STRING with + TO-STRING in IN-STRING and returns the result. It may return one + of its arguments unchanged, a constant string or a new string. + Case is significant, and text properties are ignored. + + -- Function: always &rest arguments + This function ignores any ARGUMENTS and returns ‘t’. + + *Note (elisp)Calling Functions::. + + -- Function: make-separator-line &optional length + Make a string appropriate for usage as a visual separator line. If + LENGTH is nil, use the window width. + + -- Function: insert-into-buffer to-buffer &optional start end + This is like ‘insert-buffer-substring’, but works in the opposite + direction: The text is copied from the current buffer into + TO-BUFFER. The block of text is copied to the current point in + TO-BUFFER, and point (in that buffer) is advanced to after the end + of the copied text. Is ‘start’/‘end’ is ‘nil’, the entire text in + the current buffer is copied over. + + *Note (elisp)Insertion::. + + -- Function: replace-string-in-region regexp replacement &optional + start end + This function replaces all the occurrences of REGEXP with + REPLACEMENT in the region of buffer text between START and END; + START defaults to position of point, and END defaults to the last + accessible position of the buffer. The search for REGEXP is + case-sensitive, and REPLACEMENT is inserted without changing its + letter-case. The REPLACEMENT string can use the same special + elements starting with ‘\’ as ‘replace-match’ does. The function + returns the number of replaced occurrences, or ‘nil’ if REGEXP is + not found. The function preserves the position of point. + + (replace-regexp-in-region "foo[ \t]+bar" "foobar") + *Note (elisp)Search and Replace::. + + -- Function: replace-regexp-in-string string replacement &optional + start end + This function works similarly to ‘replace-regexp-in-region’, but + searches for, and replaces, literal STRINGs instead of regular + expressions. + + *Note (elisp)Search and Replace::. + + -- Function: buffer-local-boundp variable buffer + This returns non-‘nil’ if there’s either a buffer-local binding of + VARIABLE (a symbol) in buffer BUFFER, or VARIABLE has a global + binding. + + *Note (elisp)Creating Buffer-Local::. + + -- Macro: with-existing-directory body... + This macro ensures that ‘default-directory’ is bound to an existing + directory before executing BODY. If ‘default-directory’ already + exists, that’s preferred, and otherwise some other directory is + used. This macro can be useful, for instance, when calling an + external command that requires that it’s running in a directory + that exists. The chosen directory is not guaranteed to be + writable. + + *Note (elisp)Testing Accessibility::. + + -- Macro: dlet (bindings...) forms... + This special form is like ‘let’, but it binds all variables + dynamically. This is rarely useful—you usually want to bind normal + variables lexically, and special variables (i.e., variables that + are defined with ‘defvar’) dynamically, and this is what ‘let’ + does. + + ‘dlet’ can be useful when interfacing with old code that assumes + that certain variables are dynamically bound (*note (elisp)Dynamic + Binding::), but it’s impractical to ‘defvar’ these variables. + ‘dlet’ will temporarily make the bound variables special, execute + the forms, and then make the variables non-special again. + + *Note (elisp)Local Variables::. + + -- Function: ensure-list object + This function returns OBJECT as a list. If OBJECT is already a + list, the function returns it; otherwise, the function returns a + one-element list containing OBJECT. + + This is usually useful if you have a variable that may or may not + be a list, and you can then say, for instance: + + (dolist (elem (ensure-list foo)) + (princ elem)) + + *Note (elisp)Building Lists::. + + -- Function: string-clean-whitespace string + Clean up the whitespace in STRING by collapsing stretches of + whitespace to a single space character, as well as removing all + whitespace from the start and the end of STRING. + + *Note (elisp)Creating Strings::. + + -- Function: string-fill string length + Attempt to Word-wrap STRING so that no lines are longer than + LENGTH. Filling is done on whitespace boundaries only. If there + are individual words that are longer than LENGTH, these will not be + shortened. + + *Note (elisp)Creating Strings::. + + -- Function: string-lines string &optional omit-nulls + Split STRING into a list of strings on newline boundaries. If the + optional argument OMIT-NULLS is non-‘nil’, remove empty lines from + the results. Note that this function returns trailing newlines on + Emacs 28, use ‘compat-call string-lines’ instead if you want + consistent behavior. + + -- Function: string-pad string length &optional padding start + Pad STRING to be of the given LENGTH using PADDING as the padding + character. PADDING defaults to the space character. If STRING is + longer than LENGTH, no padding is done. If START is ‘nil’ or + omitted, the padding is appended to the characters of STRING, and + if it’s non-‘nil’, the padding is prepended to STRING’s characters. + + *Note (elisp)Creating Strings::. + + -- Function: string-chop-newline string + Remove the final newline, if any, from STRING. + + *Note (elisp)Creating Strings::. + + -- Macro: named-let name bindings &rest body + This special form is a looping construct inspired from the Scheme + language. It is similar to ‘let’: It binds the variables in + BINDINGS, and then evaluates BODY. However, ‘named-let’ also binds + NAME to a local function whose formal arguments are the variables + in BINDINGS and whose body is BODY. This allows BODY to call + itself recursively by calling NAME, where the arguments passed to + NAME are used as the new values of the bound variables in the + recursive invocation. + + Recursive calls to NAME that occur in _tail positions_ in BODY are + guaranteed to be optimized as _tail calls_, which means that they + will not consume any additional stack space no matter how deeply + the recursion runs. Such recursive calls will effectively jump to + the top of the loop with new values for the variables. + + *Note (elisp)Local Variables::. + + -- Function: file-name-with-extension filename extension + This function returns FILENAME with its extension set to EXTENSION. + A single leading dot in the EXTENSION will be stripped if there is + one. For example: + + (file-name-with-extension "file" "el") + ⇒ "file.el" + (file-name-with-extension "file" ".el") + ⇒ "file.el" + (file-name-with-extension "file.c" "el") + ⇒ "file.el" + + Note that this function will error if FILENAME or EXTENSION are + empty, or if the FILENAME is shaped like a directory (i.e., if + ‘directory-name-p’ returns non-‘nil’). + + *Note File Name Components: (elisp)File Name Components. + + -- Function: directory-empty-p directory + This utility function returns ‘t’ if given DIRECTORY is an + accessible directory and it does not contain any files, i.e., is an + empty directory. It will ignore ‘.’ and ‘..’ on systems that + return them as files in a directory. + + Symbolic links to directories count as directories. See + FILE-SYMLINK-P to distinguish symlinks. + + *Note (elisp)Contents of Directories::. + + -- Function: format-prompt prompt default &rest format-args + Format PROMPT with default value DEFAULT according to the + ‘minibuffer-default-prompt-format’ variable. + + ‘minibuffer-default-prompt-format’ is a format string (defaulting + to ‘" (default %s)"’ that says how the “default” bit in prompts + like ‘"Local filename (default somefile): "’ are to be formatted. + + To allow the users to customize how this is displayed, code that + prompts the user for a value (and has a default) should look + something along the lines of this code snippet: + + (read-file-name + (format-prompt "Local filename" file) + nil file) + + If FORMAT-ARGS is ‘nil’, PROMPT is used as a literal string. If + FORMAT-ARGS is non-‘nil’, PROMPT is used as a format control + string, and PROMPT and FORMAT-ARGS are passed to ‘format’ (*note + (elisp)Formatting Strings::). + + ‘minibuffer-default-prompt-format’ can be ‘""’, in which case no + default values are displayed. + + If DEFAULT is ‘nil’, there is no default value, and therefore no + “default value” string is included in the result value. If DEFAULT + is a non-‘nil’ list, the first element of the list is used in the + prompt. + + *Note (elisp)Text from Minibuffer::. + + -- Function: thing-at-mouse event thing &optional no-properties + Mouse-EVENT equivalent of ‘thing-at-point’. THING can be ‘symbol’, + ‘list’, ‘sexp’, ‘filename’, ‘url’, ... among other things. + + When NO-PROPERTIES has a non-‘nil’ value, any text properties that + might have been present in the buffer are stripped away. + + -- Function: bounds-of-thing-at-mouse event thing + Determine start and end locations for THING at mouse click given by + EVENT. Like ‘bounds-of-thing-at-point’, but tries to use the + position in EVENT where the mouse button is clicked to find the + thing nearby. + + -- Function: mark-thing-at-mouse click thing + Activate the region around THING found near the mouse CLICK. + + -- Function: macroexp-file-name + Return the name of the file in which the code is currently being + evaluated, or ‘nil’ if it cannot be determined. + + -- Function: macroexp-warn-and-return msg form &optional category + compile-only arg + Return code equivalent to ‘form’ labeled with warning ‘msg’. + + -- Macro: with-environment-variables variables body... + This macro sets the environment variables according to VARIABLES + temporarily when executing BODY. The previous values are restored + when the form finishes. The argument VARIABLES should be a list of + pairs of strings of the form ‘(VAR VALUE)’, where VAR is the name + of the environment variable and VALUE is that variable’s value. + + (with-environment-variables (("LANG" "C") + ("LANGUAGE" "en_US:en")) + (call-process "ls" nil t)) + + *Note System Environment: (elisp)System Environment. + + -- Function: color-dark-p rgb + Whether RGB is more readable against white than black. RGB is a + 3-element list (R G B), each component in the range [0,1]. This + predicate can be used both for determining a suitable (black or + white) contrast color with RGB as background and as foreground. + + -- Function: color-values-from-color-spec spec + Convert the textual color specification SPEC to a color triple + ‘(RED GREEN blue)’. Each of RED, GREEN and ‘blue’ is a integer + value between 0 and 65535. + + The specification SPEC can be one of the following + • ‘#RGB’, where R, G and B are hex numbers of equal length, 1-4 + digits each. + • ‘rgb:R/G/B’, where R, G, and B are hex numbers, 1-4 digits + each. + • ‘rgbi:R/G/B’, where R, G and B are floating-point numbers in + [0,1]. + + -- Function: file-modes-number-to-symbolic modes + This function converts a numeric file mode specification in MODES + into the equivalent symbolic form. + + *Note Changing Files: (elisp)Changing Files. + + -- Function: file-backup-file-names filename + This function returns a list of all the backup file names for + FILENAME, or ‘nil’ if there are none. The files are sorted by + modification time, descending, so that the most recent files are + first. + + *Note (elisp)Backup Names::. + + -- Function: make-lock-file-name filename + Return a string containing a lock file name for FILENAME, obeying + ‘lock-file-name-transforms’. + + -- Function: decoded-time-period time + Interpret TIME as a period and return its length in seconds. For + computational purposes, years are 365 days long and months are 30 + days long. + + -- Function: subr-primitive-p object + Return ‘t’ if OBJECT is a primitive, built-in function. On systems + with native compilation ‘subrp’ does not distinguish between + built-in functions and functions that have been compiled. If + native compilation is not available, this function behaves + identically to ‘subrp’. + + -- Function: subr-native-elisp-p object + Return ‘t’ if OBJECT if the object is native compiled lisp. If + native compilation is not available, this function always returns + ‘nil’. + + -- Macro: with-window-non-dedicated window &rest body + Evaluate BODY with WINDOW temporarily made non-dedicated. If + WINDOW is nil, use the selected window. Return the value of the + last form in BODY. + +2.4.2 Extended Definitions +-------------------------- + +These functions must be called explicitly via ‘compat-call’, since their +calling convention or behavior was extended in Emacs 28.1: + + -- Function: compat-call string-width string &optional from to + This function returns the width in columns of the string STRING, if + it were displayed in the current buffer and the selected window. + Optional arguments FROM and TO specify the substring of STRING to + consider, and are interpreted as in ‘substring’ (*note + (elisp)Creating Strings::). + + The return value is an approximation: it only considers the values + returned by ‘char-width’ for the constituent characters, always + takes a tab character as taking ‘tab-width’ columns, ignores + display properties and fonts, etc. + + *Note (elisp)Size of Displayed Text::. + + This compatibility version handles the optional arguments FROM and + TO. + + -- Function: compat-call count-windows + Return the number of live windows on the selected frame. + + The optional argument MINIBUF specifies whether the minibuffer + window is included in the count. + + If ALL-FRAMES is non-‘nil’, count the windows in all frames instead + just the selected frame. + + This compatibility version handles the optional argument + ALL-FRAMES. + +2.4.3 Missing Definitions +------------------------- + +Compat does not provide support for the following Lisp features +implemented in 28.1: + + • Support for ‘interactive’ or ‘declare’ to list applicable modes. + • Support for ‘:interactive’ argument to ‘define-minor-mode’ and + ‘define-derived-mode’. + • Support for ‘:predicate’ argument to + ‘define-globalized-minor-mode’. + • Support for the ‘:success’ handler of ‘condition-case’. + • The function ‘benchmark-call’. + • Support for the ‘natnum’ defcustom type. + • Additional Edebug keywords. + • The libjansson JSON APIs, e.g., ‘json-parse-string’. + • The macro ‘pcase-setq’. + • The function ‘custom-add-choice’. + • The functions ‘dom-print’ and ‘dom-remove-attribute’. + • The function ‘dns-query-asynchronous’. + • The function ‘get-locale-names’. + • The functions ‘mail-header-parse-addresses-lax’ and + ‘mail-header-parse-address-lax’. + • The function ‘num-processors’. + • The function ‘object-intervals’. + • The function ‘require-theme’. + • The function ‘syntax-class-to-char’. + • The function ‘path-separator’. + • The function ‘null-device’. + • The function ‘macroexp-compiling-p’. + • The function ‘split-string-shell-command’. + • The function ‘string-limit’. + • The functions ‘innermost-minibuffer-p’ and + ‘minibuffer-innermost-command-loop-p’. + • The function ‘max-mini-window-lines’. + • The function ‘lock-file’ and ‘unlock-file’. + • The ‘multisession’ library. + + +File: doc5ZeelO.info, Node: Emacs 29.1, Prev: Emacs 28.1, Up: Support + +2.5 Emacs 29.1 +============== + +2.5.1 Added Definitions +----------------------- + +The following functions and macros are implemented in Emacs 29.1. These +functions are made available by Compat on Emacs versions older than +29.1. Note that due to upstream changes, it might happen that there +will be the need for changes, so use these functions with care. + + -- Function: count-sentences start end + Count sentences in current buffer from START to END. + + -- Function: readablep object + This predicate says whether OBJECT has “readable syntax”, i.e., it + can be written out and then read back by the Emacs Lisp reader. If + it can’t, this function returns ‘nil’; if it can, this function + returns a printed representation (via ‘prin1’). + + -- Function: substitute-quotes string + This function works like ‘substitute-command-keys’, but only + replaces quote characters. + + -- Function: get-scratch-buffer-create + Return the *scratch* buffer, creating a new one if needed. + + -- Function: use-region-noncontiguous-p + Return non-nil for a non-contiguous region if ‘use-region-p’. + + -- Function: use-region-end + Return the end of the region if ‘use-region-p’. + + -- Function: use-region-beginning + Return the start of the region if ‘use-region-p’. + + -- Macro: buffer-local-set-state variable value... + Minor modes often set buffer-local variables that affect some + features in Emacs. When a minor mode is switched off, the mode is + expected to restore the previous state of these variables. This + convenience macro helps with doing that: It works much like + ‘setq-local’, but returns an object that can be used to restore + these values back to their previous values/states (using the + companion function ‘buffer-local-restore-state’). + + -- Function: delete-line + Delete the current line. + + -- Function: list-of-strings-p object + Return ‘t’ if OBJECT is ‘nil’ or a list of strings. + + -- Function: plistp object + Non-nil if and only if OBJECT is a valid plist. + + -- Macro: with-memoization PLACE CODE... + This macro provides a simple way to do memoization. CODE is + evaluated and then stashed in PLACE. If PLACE’s value is + non-‘nil’, return that value instead of evaluating CODE. + + -- Macro: with-narrowing start end [:locked tag] &rest body + Execute BODY with restrictions set to START and END. The current + restrictions, if any, are restored upon return. With the optional + :locked TAG argument, inside TAG, ‘narrow-to-region’ and ‘widen’ + can be used only within the START and END limits, unless the + restrictions are unlocked by calling ‘narrowing-unlock’ with TAG. + See ‘narrowing-lock’ for a more detailed description. + + -- Function: pos-bol &optional count + Like ‘line-beginning-position’, but ignores fields (and is more + efficient). + + -- Function: pos-eol &optional count + Like ‘line-end-position’, but ignores fields (and is more + efficient). + + -- Macro: with-delayed-message (timeout message) body... + Sometimes it’s unclear whether an operation will take a long time + to execute or not, or it can be inconvenient to implement a + progress reporter. This macro can be used in those situations. + + (with-delayed-message (2 (format "Gathering data for %s" entry)) + (setq data (gather-data entry))) + + In this example, if the body takes more than two seconds to + execute, the message will be displayed. If it takes a shorter time + than that, the message won’t be displayed. In either case, the + body is evaluated as normally, and the return value of the final + element in the body is the return value of the macro. + + The MESSAGE element is evaluated before BODY, and is always + evaluated, whether the message is displayed or not. + + -- Function: funcall-with-delayed-message timeout message function + Like ‘funcall’, but display MESSAGE if FUNCTION takes longer than + TIMEOUT. TIMEOUT is a number of seconds, and can be an integer or + a floating point number. + + If FUNCTION takes less time to execute than TIMEOUT seconds, + MESSAGE is not displayed. + + -- Function: buttonize string callback &optional data help-echo + Sometimes it’s more convenient to make a string into a button + without inserting it into a buffer immediately, for instance when + creating data structures that may then, later, be inserted into a + buffer. This function makes STRING into such a string, and + CALLBACK will be called when the user clicks on the button. The + optional DATA parameter will be used as the parameter when CALLBACK + is called. If ‘nil’, the button is used as the parameter instead. + + -- Function: buttonize-region start end callback &optional data + help-echo + Make the region between START and END into a button. When clicked, + CALLBACK will be called with the DATA as the function argument. If + DATA isn’t present (or is nil), the button itself will be used + instead as the function argument. If HELP-ECHO, use that as the + help-echo property. + + -- Function: get-display-property position prop &optional object + properties + This convenience function can be used to get a specific display + property, no matter whether the ‘display’ property is a vector, a + list or a simple property. This is like ‘get-text-property’ (*note + Examining Properties: (elisp)Examining Properties.), but works on + the ‘display’ property only. + + POSITION is the position in the buffer or string to examine, and + PROP is the ‘display’ property to return. The optional OBJECT + argument should be either a string or a buffer, and defaults to the + current buffer. If the optional PROPERTIES argument is non-‘nil’, + it should be a ‘display’ property, and in that case, POSITION and + OBJECT are ignored. (This can be useful if you’ve already gotten + the ‘display’ property with ‘get-char-property’, for instance + (*note Examining Properties: (elisp)Examining Properties.). + + -- Function: add-display-text-property start end prop value &optional + object + Add display property PROP with VALUE to the text from START to END. + If any text in the region has a non-nil ‘display’ property, those + properties are retained. + + If OBJECT is non-‘nil’, it should be a string or a buffer. If + ‘nil’, this defaults to the current buffer. + + -- Function: take n list + This function returns the N first elements of LIST. Essentially, + it returns the part of LIST that ‘nthcdr’ skips. + + ‘take’ returns LIST if shorter than N elements; it returns ‘nil’ if + N is zero or negative. + + (take 3 '(a b c d)) + ⇒ (a b c) + (take 10 '(a b c d)) + ⇒ (a b c d) + (take 0 '(a b c d)) + ⇒ nil + + -- Function: ntake n list + This is a version of ‘take’ that works by destructively modifying + the list structure of the argument. That makes it faster, but the + original value of LIST may be lost. + + ‘ntake’ returns LIST unmodified if shorter than N elements; it + returns ‘nil’ if N is zero or negative. Otherwise, it returns LIST + truncated to its first N elements. + + This means that it is usually a good idea to use the return value + and not just rely on the truncation effect unless N is known to be + positive. + + -- Function: compiled-function-p object + This function returns ‘t’ if OBJECT is a function object that is + not in the form of ELisp source code but something like machine + code or byte code instead. More specifically it returns ‘t’ if the + function is built-in, or byte-compiled, or natively-compiled, or a + function loaded from a dynamic module. + + -- Function: function-alias-p object &optional noerror + Checks whether OBJECT is a function alias. If it is, it returns a + list of symbols representing the function alias chain, else ‘nil’. + For instance, if ‘a’ is an alias for ‘b’, and ‘b’ is an alias for + ‘c’: + + (function-alias-p 'a) + ⇒ (b c) + + If there’s a loop in the definitions, an error will be signalled. + If NOERROR is non-‘nil’, the non-looping parts of the chain is + returned instead. + + -- Function: string-equal-ignore-case string1 string2 + ‘string-equal-ignore-case’ compares strings ignoring case + differences, like ‘char-equal’ when ‘case-fold-search’ is ‘t’. + + *Note (elisp)Text Comparison::. + + -- Function: string-split string &optional separators omit-nulls trim + ‘string-split’ is an alias for the function ‘split-string’. The + name follows the convention of other string functions. + + *Note (elisp)Creating Strings::. + + -- Function: buffer-match-p condition buffer-or-name &optional arg + This function checks if a buffer designated by ‘buffer-or-name’ + satisfies a ‘condition’. Optional third argument ARG is passed to + the predicate function in CONDITION. A condition can be one of the + following: + • A string, interpreted as a regular expression. The buffer + satisfies the condition if the regular expression matches the + buffer name. + • A predicate function, which should return non-‘nil’ if the + buffer matches. If the function expects one argument, it is + called with BUFFER-OR-NAME as the argument; if it expects 2 + arguments, the first argument is BUFFER-OR-NAME and the second + is ARG (or ‘nil’ if ARG is omitted). + • A cons-cell ‘(OPER . EXPR)’ where OPER is one of + ‘not’ + Satisfied if EXPR doesn’t satisfy ‘buffer-match-p’ with + the same buffer and ‘arg’. + ‘or’ + Satisfied if EXPR is a list and _any_ condition in EXPR + satisfies ‘buffer-match-p’, with the same buffer and + ‘arg’. + ‘and’ + Satisfied if EXPR is a list and _all_ conditions in EXPR + satisfy ‘buffer-match-p’, with the same buffer and ‘arg’. + ‘derived-mode’ + Satisfied if the buffer’s major mode derives from EXPR. + ‘major-mode’ + Satisfied if the buffer’s major mode is equal to EXPR. + Prefer using ‘derived-mode’ instead when both can work. + • t Satisfied by any buffer. A convenient alternative to ‘""’ + (empty string), ‘(and)’ (empty conjunction) or ‘always’. + + *Note (elisp)Buffer List::. + + -- Function: match-buffers condition &optional buffers arg + This function returns a list of all buffers that satisfy a + ‘condition’, as defined for ‘buffer-match-p’. By default all + buffers are considered, but this can be restricted via the second + optional ‘buffer-list’ argument. Optional third argument ARG will + be used by CONDITION in the same way as ‘buffer-match-p’ does. + + *Note (elisp)Buffer List::. + + -- Function: string-glyph-split string + When character compositions are in effect, sequence of characters + can be composed for display to form _grapheme clusters_, for + example to display accented characters, or ligatures, or Emoji, or + when complex text shaping requires that for some scripts. When + that happens, characters no longer map in a simple way to display + columns, and display layout decisions with such strings, such as + truncating too wide strings, can be a complex job. This function + helps in performing suvh jobs: it splits up its argument STRING + into a list of substrings, where each substring produces a single + grapheme cluster that should be displayed as a unit. Lisp programs + can then use this list to construct visually-valid substrings of + STRING which will look correctly on display, or compute the width + of any substring of STRING by adding the width of its constituents + in the returned list, etc. + + For instance, if you want to display a string without the first + glyph, you can say: + + (apply #'insert (cdr (string-glyph-split string)))) + + *Note (elisp)Size of Displayed Text::. + + -- Macro: with-buffer-unmodified-if-unchanged &rest body... + Evaluate BODY like ‘progn’, but change buffer-modified status only + if buffer text changes. If the buffer was unmodified before + execution of BODY, and buffer text after execution of BODY is + identical to what it was before, ensure that buffer is still marked + unmodified afterwards. + + Note that only changes in the raw byte sequence of the buffer text, + as stored in the internal representation, are monitored for the + purpose of detecting the lack of changes in buffer text. Any other + changes that are normally perceived as "buffer modifications", such + as changes in text properties, ‘buffer-file-coding-system’, buffer + multibyteness, etc. – will not be noticed, and the buffer will + still be marked unmodified, effectively ignoring those changes. + + -- Function: file-attribute-file-identifier + Return the fields ‘(inodenum device)’ as a list from attributes + generated by ‘file-attributes’. + + *Note (elisp)File Attributes::. + + -- Function: file-name-split filename + This function splits a file name into its components, and can be + thought of as the inverse of ‘string-join’ with the appropriate + directory separator. For example, + + (file-name-split "/tmp/foo.txt") + ⇒ ("" "tmp" "foo.txt") + (string-join (file-name-split "/tmp/foo.txt") "/") + ⇒ "/tmp/foo.txt" + + -- Function: file-name-parent-directory filename + This function returns the directory name of the parent directory of + FILENAME. If FILENAME is at the root directory of the filesystem, + it returns ‘nil’. A relative FILENAME is assumed to be relative to + ‘default-directory’, and the return value will also be relative in + that case. If the return value is non-‘nil’, it ends in a slash. + + *Note (elisp)Directory Names::. + + -- Function: file-has-changed-p file &optional tag + This function returns non-‘nil’ if the time stamp of FILENAME has + changed since the last call. When called for the first time for + some FILENAME, it records the last modification time and size of + the file, and returns non-‘nil’ when FILENAME exists. Thereafter, + when called for the same FILENAME, it compares the current time + stamp and size with the recorded ones, and returns non-‘nil’ only + if either the time stamp or the size (or both) are different. This + is useful when a Lisp program wants to re-read a file whenever it + changes. With an optional argument TAG, which must be a symbol, + the size and modification time comparisons are limited to calls + with the same tag. + + *Note (elisp)File Attributes::. + + -- Function: key-valid-p keys + Say whether KEYS is a valid key. A key is a string consisting of + one or more key strokes. The key strokes are separated by single + space characters. + + Each key stroke is either a single character, or the name of an + event, surrounded by angle brackets. In addition, any key stroke + may be preceded by one or more modifier keys. Finally, a limited + number of characters have a special shorthand syntax. + + Here’s some example key sequences. + + ‘f’ + The key ‘f’. + ‘S o m’ + A three key sequence of the keys ‘S’, ‘o’ and ‘m’. + ‘C-c o’ + A two key sequence of the keys ‘c’ with the control modifier + and then the key ‘o’. + ‘H-’ + The key named "left" with the hyper modifier. + ‘M-RET’ + The "return" key with a meta modifier. + ‘C-M-’ + The "space" key with both the control and meta modifiers. + + These are the characters that have shorthand syntax: ‘NUL’, ‘RET’, + ‘TAB’, ‘LFD’, ‘ESC’, ‘SPC’, ‘DEL’. + + Modifiers have to be specified in this order + Alt (A)-Control (C)-Hyper (H)-Meta (M)-Shift (s)-Super (s) + + -- Function: key-parse keys + Convert KEYS to the internal Emacs key representation. See + ‘key-valid-p’ for a description of valid key sequences. Examples + include ‘f’, ‘C-c C-c’, ‘H-’, ‘M-RET’ or ‘C-M-’. + + -- Function: keymap-set keymap key definition + This function sets the binding for KEY in KEYMAP. (If KEY is more + than one event long, the change is actually made in another keymap + reached from KEYMAP.) The argument BINDING can be any Lisp object, + but only certain types are meaningful. (For a list of meaningful + types, see *note (elisp)Key Lookup::.) The value returned by + ‘keymap-set’ is BINDING. + + If KEY is ‘’, this sets the default binding in KEYMAP. When an + event has no binding of its own, the Emacs command loop uses the + keymap’s default binding, if there is one. + + Every prefix of KEY must be a prefix key (i.e., bound to a keymap) + or undefined; otherwise an error is signaled. If some prefix of + KEY is undefined, then ‘keymap-set’ defines it as a prefix key so + that the rest of KEY can be defined as specified. + + If there was previously no binding for KEY in KEYMAP, the new + binding is added at the beginning of KEYMAP. The order of bindings + in a keymap makes no difference for keyboard input, but it does + matter for menu keymaps (*note (elisp)Menu Keymaps::). + + *Note (elisp)Changing Key Bindings::. + + -- Function: keymap-global-set key command + This function sets the binding of KEY in the current global map to + BINDING. + + (keymap-global-set KEY BINDING) + ≡ + (keymap-set (current-global-map) KEY BINDING) + + *Note (elisp)Key Binding Commands::. + + -- Function: keymap-local-set key command + This function sets the binding of KEY in the current local keymap + to BINDING. + + (keymap-local-set KEY BINDING) + ≡ + (keymap-set (current-local-map) KEY BINDING) + + *Note (elisp)Key Binding Commands::. + + -- Function: keymap-global-unset key &optional remove + This function removes the binding of KEY from the current global + map. + + One use of this function is in preparation for defining a longer + key that uses KEY as a prefix—which would not be allowed if KEY has + a non-prefix binding. For example: + + (keymap-global-unset "C-l") + ⇒ nil + (keymap-global-set "C-l C-l" 'redraw-display) + ⇒ nil + + *Note (elisp)Key Binding Commands::. + + -- Function: keymap-local-unset key &optional remove + This function removes the binding of KEY from the current local + map. + + *Note (elisp)Key Binding Commands::. + + -- Function: keymap-substitute keymap olddef newdef &optional oldmap + prefix + Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as + OLDDEF. In other words, OLDDEF is replaced with NEWDEF wherever it + appears. Alternatively, if optional fourth argument OLDMAP is + specified, we redefine in KEYMAP as NEWDEF those keys that are + defined as OLDDEF in OLDMAP. + + -- Function: keymap-lookup keymap key &optional accept-default no-remap + position + This function returns the definition of KEY in KEYMAP. All the + other functions described in this chapter that look up keys use + ‘keymap-lookup’. Here are examples: + + (keymap-lookup (current-global-map) "C-x C-f") + ⇒ find-file + (keymap-lookup (current-global-map) "C-x C-f 1 2 3 4 5") + ⇒ 2 + + *Note (elisp)Functions for Key Lookup::. + + -- Function: keymap-local-lookup keys &optional accept-default + Like ‘keymap-lookup’, but restricting the search for commands bound + to KEYS to the current local keymap. + + -- Function: keymap-global-lookup keys &optional accept-default + Like ‘keymap-lookup’, but restricting the search for commands bound + to KEYS to the current global keymap. + + -- Function: define-keymap &rest definitions + You can create a keymap with the functions described above, and + then use ‘keymap-set’ (*note (elisp)Changing Key Bindings::) to + specify key bindings in that map. When writing modes, however, you + frequently have to bind a large number of keys at once, and using + ‘keymap-set’ on them all can be tedious and error-prone. Instead + you can use ‘define-keymap’, which creates a keymap and binds a + number of keys. Here’s a very basic example: + + (define-keymap + "n" #'forward-line + "f" #'previous-line + "C-c C-c" #'quit-window) + + This function creates a new sparse keymap, defines the keystrokes + in PAIRS, and returns the new keymap. + + PAIRS is a list of alternating key bindings and key definitions, as + accepted by ‘keymap-set’. In addition, the key can be the special + symbol ‘:menu’, in which case the definition should be a menu + definition as accepted by ‘easy-menu-define’ (*note (elisp)Easy + Menu::). Here’s a brief example of this usage: + + (define-keymap :full t + "g" #'eww-reload + :menu '("Eww" + ["Exit" quit-window t] + ["Reload" eww-reload t])) + + A number of keywords can be used before the key/definition pairs to + change features of the new keymap. If any of the feature keywords + is missing from the ‘define-keymap’ call, the default value for + that feature is ‘nil’. Here’s a list of the available feature + keywords: + + ‘:full’ + If non-‘nil’, create a char-table keymap (as from + ‘make-keymap’) instead of a sparse keymap (as from + ‘make-sparse-keymap’ (*note (elisp)Creating Keymaps::). A + sparse keymap is the default. + + ‘:parent’ + If non-‘nil’, the value should be a keymap to use as the + parent (*note (elisp)Inheritance and Keymaps::). + + ‘:keymap’ + If non-‘nil’, the value should be a keymap. Instead of + creating a new keymap, the specified keymap is modified + instead. + + ‘:suppress’ + If non-‘nil’, the keymap will be suppressed with + ‘suppress-keymap’ (*note (elisp)Changing Key Bindings::). By + default, digits and the minus sign are exempt from + suppressing, but if the value is ‘nodigits’, this suppresses + digits and minus-sign like it does with other characters. + + ‘:name’ + If non-‘nil’, the value should be a string to use as the menu + for the keymap if you use it as a menu with ‘x-popup-menu’ + (*note (elisp)Pop-Up Menus::). + + ‘:prefix’ + If non-‘nil’, the value should be a symbol to be used as a + prefix command (*note (elisp)Prefix Keys::). If this is the + case, this symbol is returned by ‘define-keymap’ instead of + the map itself. + + -- Function: defvar-keymap (variable-name &rest defs) + By far, the most common thing to do with a keymap is to bind it to + a variable. This is what virtually all modes do—a mode called + ‘foo’ almost always has a variable called ‘foo-mode-map’. + + This macro defines NAME as a variable, passes OPTIONS and PAIRS to + ‘define-keymap’, and uses the result as the default value for the + variable. + + OPTIONS is like the keywords in ‘define-keymap’, but there’s an + additional ‘:doc’ keyword that provides the doc string for the + defined variable. + + Here’s an example: + + (defvar-keymap eww-textarea-map + :parent text-mode-map + "RET" #'forward-line + "TAB" #'shr-next-link) + + -- Macro: while-let spec then-forms... + Like ‘when-let’, but repeat until a binding in SPEC is ‘nil’. The + return value is always ‘nil’. + + This is comparable to ‘and-let*’. + + -- Macro: ert-with-temp-file name &rest body + Bind NAME to the name of a new temporary file and evaluate BODY. + Delete the temporary file after BODY exits normally or non-locally. + NAME will be bound to the file name of the temporary file. See the + docstring for supported keyword arguments. + + -- Macro: ert-with-temp-directory name &rest body + Bind NAME to the name of a new temporary directory and evaluate + BODY. Delete the temporary directory after BODY exits normally or + non-locally. + + NAME is bound to the directory name, not the directory file name. + (In other words, it will end with the directory delimiter; on + Unix-like systems, it will end with "/".) + + The same keyword arguments are supported as in ‘ert-with-temp-file’ + (which see), except for ‘:text’. + + -- Macro: cl-with-gensyms names... body + This macro expands to code that executes BODY with each of the + variables in NAMES bound to a fresh uninterned symbol, or “gensym”, + in Common Lisp parlance. For macros requiring more than one + gensym, use of ‘cl-with-gensyms’ shortens the code and renders + one’s intentions clearer. Compare: + + (defmacro my-macro (foo) + (let ((bar (gensym "bar")) + (baz (gensym "baz")) + (quux (gensym "quux"))) + `(let ((,bar (+ ...))) + ...))) + + (defmacro my-macro (foo) + (cl-with-gensyms (bar baz quux) + `(let ((,bar (+ ...))) + ...))) + + -- Macro: cl-once-only ((variable form)...) body + This macro is primarily to help the macro programmer ensure that + forms supplied by the user of the macro are evaluated just once by + its expansion even though the result of evaluating the form is to + occur more than once. Less often, this macro is used to ensure + that forms supplied by the macro programmer are evaluated just + once. + + Each VARIABLE may be used to refer to the result of evaluating FORM + in BODY. ‘cl-once-only’ binds each VARIABLE to a fresh uninterned + symbol during the evaluation of BODY. Then, ‘cl-once-only’ wraps + the final expansion in code to evaluate each FORM and bind the + result to the corresponding uninterned symbol. Thus, when the + macro writer substitutes the value for VARIABLE into the expansion + they are effectively referring to the result of evaluating FORM, + rather than FORM itself. Another way to put this is that each + VARIABLE is bound to an expression for the (singular) result of + evaluating FORM. + + The most common case is where VARIABLE is one of the arguments to + the macro being written, so ‘(variable variable)’ may be + abbreviated to just ‘variable’. + + For example, consider this macro: + + (defmacro my-list (x y &rest forms) + (let ((x-result (gensym)) + (y-result (gensym))) + `(let ((,x-result ,x) + (,y-result ,y)) + (list ,x-result ,y-result ,x-result ,y-result + (progn ,@forms)))) + + In a call like ‘(my-list (pop foo) ...)’ the intermediate binding + to ‘x-result’ ensures that the ‘pop’ is not done twice. But as a + result the code is rather complex: the reader must keep track of + how ‘x-result’ really just means the first parameter of the call to + the macro, and the required use of multiple gensyms to avoid + variable capture by ‘(progn ,@forms)’ obscures things further. + ‘cl-once-only’ takes care of these details: + + (defmacro my-list (x y &rest forms) + (cl-once-only (x y) + `(list ,x ,y ,x ,y + (progn ,@forms)))) + +2.5.2 Extended Definitions +-------------------------- + +These functions must be called explicitly via ‘compat-call’, since their +calling convention or behavior was extended in Emacs 29.1: + + -- Function: compat-call set-transient-map keymap &optional keep-pred + on-exit message timeout + This function adds KEYMAP as a “transient” keymap, which takes + precedence over other keymaps for one (or more) subsequent keys. + + Normally, KEYMAP is used just once, to look up the very next key. + If the optional argument KEEP-PRED is ‘t’, the map stays active as + long as the user types keys defined in KEYMAP; when the user types + a key that is not in KEYMAP, the transient keymap is deactivated + and normal key lookup continues for that key. + + The KEEP-PRED argument can also be a function. In that case, the + function is called with no arguments, prior to running each + command, while KEYMAP is active; it should return non-‘nil’ if + KEYMAP should stay active. + + The optional argument ON-EXIT, if non-‘nil’, specifies a function + that is called, with no arguments, after KEYMAP is deactivated. + + The optional argument MESSAGE specifies the message to display + after activating the transient map. If MESSAGE is a string, it is + the format string for the message, and any ‘%k’ specifier in that + string is replaced with the list of keys from the transient map. + Any other non-‘nil’ value of MESSAGE stands for the default message + format ‘Repeat with %k’. + + If the optional argument TIMEOUT is non-‘nil’, it should be a + number that specifies how many seconds of idle time to wait before + deactivating KEYMAP. The value of the variable + ‘set-transient-map-timeout’, if non-‘nil’, overrides the value of + this argument. + + This function works by adding and removing KEYMAP from the variable + ‘overriding-terminal-local-map’, which takes precedence over all + other active keymaps (*note (Searching Keymaps)elisp::). + + -- Function: compat-call string-lines string &optional omit-nulls + keep-newlines + Split STRING into a list of strings on newline boundaries. If the + optional argument OMIT-NULLS is non-‘nil’, remove empty lines from + the results. If the optional argument KEEP-NEWLINES is non-‘nil’, + don’t remove the trailing newlines from the result strings. + + *Note (elisp)Creating Strings::. + + -- Function: compat-call define-key + This function is like ‘keymap-set’ (*note (elisp)Changing Key + Bindings::, but understands only the legacy key syntaxes. + + In addition, this function also has a REMOVE argument. If it is + non-‘nil’, the definition will be removed. This is almost the same + as setting the definition to ‘nil’, but makes a difference if the + KEYMAP has a parent, and KEY is shadowing the same binding in the + parent. With REMOVE, subsequent lookups will return the binding in + the parent, whereas with a ‘nil’ definition the lookups will return + ‘nil’. + + *Note (elisp)Low-Level Key Binding::. + + This compatibility version handles the optional argument REMOVE. + + -- Function: compat-call plist-get plist prop &optional predicate + This returns the value of the PROPERTY property stored in the + property list PLIST. Comparisons are done with PREDICATE, and + defaults to ‘eq’. It accepts a malformed PLIST argument. If + PROPERTY is not found in the PLIST, it returns ‘nil’. + + *Note (elisp)Plist Access::. + + This compatibility version handles the optional argument PREDICATE. + This is a generalized variable (*note (elisp)Generalized + Variables::) that can be used to change a value with ‘setf’. + + -- Function: compat-call plist-put plist prop val &optional predicate + This stores VALUE as the value of the PROPERTY property in the + property list PLIST. Comparisons are done with PREDICATE, and + defaults to ‘eq’. It may modify PLIST destructively, or it may + construct a new list structure without altering the old. The + function returns the modified property list, so you can store that + back in the place where you got PLIST. + + *Note (elisp)Plist Access::. + + This compatibility version handles the optional argument PREDICATE. + + -- Function: compat-call plist-member plist prop &optional predicate + This returns non-‘nil’ if PLIST contains the given PROPERTY. + Comparisons are done with PREDICATE, and defaults to ‘eq’. Unlike + ‘plist-get’, this allows you to distinguish between a missing + property and a property with the value ‘nil’. The value is + actually the tail of PLIST whose ‘car’ is PROPERTY. + + *Note (elisp)Plist Access::. + + This compatibility version handles the optional argument PREDICATE. + +2.5.3 Missing Definitions +------------------------- + +Compat does not provide support for the following Lisp features +implemented in 29.1: + + • The function ‘imagep’. + • The function ‘image-at-point-p’. + • The function ‘function-documentation’. + • The macro ‘with-undo-amalgamate’. + • The function ‘string-glyph-split’. + • The function ‘string-limit’. + • The function ‘string-pixel-width’ and ‘buffer-text-pixel-size’. + • The function ‘minibuffer-lazy-highlight-setup’. + • The function ‘pp-emacs-lisp-code’. + • The functions ‘xdg-state-home’, ‘xdg-current-desktop’ and + ‘xdg-session-type’. + • The macro ‘setopt’. + • The ‘oclosure’ library. + • The ‘textsec’ library. + • The ‘range’ library. + • The ‘string-edit’ library. + • The ‘vtable’ library. + • The ‘pixel-fill’ library. + + +File: doc5ZeelO.info, Node: Development, Next: Function Index, Prev: Support, Up: Top + +3 Development +************* + +Compat is developed on GitHub. + + Bug reports, patches and comments are best sent to the issue tracker +(https://github.com/emacs-compat/compat/issues). These may include +issues in the compatibility code, missing definitions or performance +issues. We also provide a development mailing list +(https://lists.sr.ht/~pkal/compat-devel) (~pkal/compat-devel@lists.sr.ht +<~pkal/compat-devel@lists.sr.ht>). + + Please note that as a GNU ELPA package, Compat requires contributors +to have signed the FSF copyright assignment +(https://www.gnu.org/software/emacs/manual/html_node/emacs/Copyright-Assignment.html), +before any non-trivial contribution (roughly 15 lines of code) can be +applied. It is important that you provide tests when you contribute new +functionality. Compat has 100% test coverage by the test suite. We use +continuous integration to check if patches preserve existing +functionality. + + +File: doc5ZeelO.info, Node: Function Index, Next: Variable Index, Prev: Development, Up: Top + +Appendix A Function Index +************************* + +[index] +* Menu: + +* add-display-text-property: Emacs 29.1. (line 137) +* alist-get: Emacs 25.1. (line 82) +* always: Emacs 28.1. (line 80) +* and-let*: Emacs 26.1. (line 158) +* assoc-delete-all: Emacs 26.1. (line 13) +* bignump: Emacs 27.1. (line 55) +* bool-vector: Emacs 25.1. (line 178) +* bounds-of-thing-at-mouse: Emacs 28.1. (line 289) +* buffer-hash: Emacs 26.1. (line 80) +* buffer-local-boundp: Emacs 28.1. (line 122) +* buffer-local-restore-state: Emacs 29.1. (line 39) +* buffer-local-set-state: Emacs 29.1. (line 39) +* buffer-match-p: Emacs 29.1. (line 205) +* buttonize: Emacs 29.1. (line 103) +* buttonize-region: Emacs 29.1. (line 112) +* cl-once-only: Emacs 29.1. (line 588) +* cl-with-gensyms: Emacs 29.1. (line 569) +* color-dark-p: Emacs 28.1. (line 320) +* color-values-from-color-spec: Emacs 28.1. (line 326) +* compat-call: Usage. (line 43) +* compat-call <1>: Emacs 26.1. (line 278) +* compat-call alist-get: Emacs 26.1. (line 344) +* compat-call assoc: Emacs 26.1. (line 316) +* compat-call assoc-delete-all: Emacs 27.1. (line 417) +* compat-call count-windows: Emacs 28.1. (line 402) +* compat-call define-key: Emacs 29.1. (line 685) +* compat-call executable-find: Emacs 27.1. (line 429) +* compat-call file-size-human-readable: Emacs 27.1. (line 397) +* compat-call line-number-at-pos: Emacs 26.1. (line 330) +* compat-call lookup-key: Emacs 27.1. (line 356) +* compat-call plist-get: Emacs 29.1. (line 701) +* compat-call plist-member: Emacs 29.1. (line 725) +* compat-call plist-put: Emacs 29.1. (line 713) +* compat-call recenter: Emacs 27.1. (line 346) +* compat-call regexp-opt: Emacs 27.1. (line 385) +* compat-call set-transient-map: Emacs 29.1. (line 640) +* compat-call setq-local: Emacs 27.1. (line 370) +* compat-call sort: Emacs 25.1. (line 190) +* compat-call string-lines: Emacs 29.1. (line 676) +* compat-call string-trim: Emacs 26.1. (line 375) +* compat-call string-trim-left: Emacs 26.1. (line 359) +* compat-call string-trim-right: Emacs 26.1. (line 367) +* compat-call string-width: Emacs 28.1. (line 385) +* compat-function: Usage. (line 51) +* compiled-function-p: Emacs 29.1. (line 173) +* count-sentences: Emacs 29.1. (line 14) +* cXXXr: Emacs 26.1. (line 66) +* cXXXXr: Emacs 26.1. (line 67) +* date-days-in-month: Emacs 27.1. (line 213) +* date-ordinal-to-time: Emacs 27.1. (line 220) +* decoded-time-day: Emacs 27.1. (line 175) +* decoded-time-dst: Emacs 27.1. (line 195) +* decoded-time-hour: Emacs 27.1. (line 170) +* decoded-time-minute: Emacs 27.1. (line 165) +* decoded-time-month: Emacs 27.1. (line 180) +* decoded-time-period: Emacs 28.1. (line 357) +* decoded-time-second: Emacs 27.1. (line 160) +* decoded-time-weekday: Emacs 27.1. (line 190) +* decoded-time-year: Emacs 27.1. (line 185) +* decoded-time-zone: Emacs 27.1. (line 200) +* define-keymap: Emacs 29.1. (line 457) +* defvar-keymap: Emacs 29.1. (line 525) +* delete-line: Emacs 29.1. (line 48) +* directory-empty-p: Emacs 28.1. (line 240) +* directory-name-p: Emacs 25.1. (line 56) +* dlet: Emacs 28.1. (line 140) +* dolist-with-progress-reporter: Emacs 27.1. (line 119) +* ensure-list: Emacs 28.1. (line 155) +* ert-with-temp-directory: Emacs 29.1. (line 557) +* ert-with-temp-file: Emacs 29.1. (line 551) +* file-attribute-access-time: Emacs 26.1. (line 223) +* file-attribute-collect: Emacs 26.1. (line 260) +* file-attribute-device-number: Emacs 26.1. (line 255) +* file-attribute-file-identifier: Emacs 29.1. (line 286) +* file-attribute-group-id: Emacs 26.1. (line 218) +* file-attribute-inode-number: Emacs 26.1. (line 250) +* file-attribute-link-number: Emacs 26.1. (line 208) +* file-attribute-modes: Emacs 26.1. (line 245) +* file-attribute-modification-time: Emacs 26.1. (line 228) +* file-attribute-size: Emacs 26.1. (line 240) +* file-attribute-status-change-time: Emacs 26.1. (line 234) +* file-attribute-type: Emacs 26.1. (line 203) +* file-attribute-user-id: Emacs 26.1. (line 213) +* file-backup-file-names: Emacs 28.1. (line 345) +* file-has-changed-p: Emacs 29.1. (line 311) +* file-local-name: Emacs 26.1. (line 167) +* file-modes-number-to-symbolic: Emacs 28.1. (line 339) +* file-name-concat: Emacs 28.1. (line 50) +* file-name-parent-directory: Emacs 29.1. (line 302) +* file-name-quote: Emacs 26.1. (line 102) +* file-name-quoted-p: Emacs 26.1. (line 95) +* file-name-split: Emacs 29.1. (line 292) +* file-name-unquote: Emacs 26.1. (line 90) +* file-name-with-extension: Emacs 28.1. (line 222) +* file-size-human-readable-iec: Emacs 27.1. (line 251) +* fixnump: Emacs 27.1. (line 60) +* flatten-tree: Emacs 27.1. (line 132) +* format-message: Emacs 25.1. (line 44) +* format-prompt: Emacs 28.1. (line 251) +* funcall-with-delayed-message: Emacs 29.1. (line 95) +* function-alias-p: Emacs 29.1. (line 180) +* garbage-collect-maybe: Emacs 28.1. (line 65) +* gensym: Emacs 26.1. (line 70) +* get-display-property: Emacs 29.1. (line 120) +* get-scratch-buffer-create: Emacs 29.1. (line 27) +* hash-table-empty: Emacs 25.1. (line 120) +* if-let: Emacs 25.1. (line 97) +* if-let*: Emacs 26.1. (line 149) +* ignore-errors: Emacs 27.1. (line 106) +* image-property: Emacs 26.1. (line 198) +* insert-into-buffer: Emacs 28.1. (line 89) +* key-parse: Emacs 29.1. (line 358) +* key-valid-p: Emacs 29.1. (line 326) +* keymap-global-lookup: Emacs 29.1. (line 453) +* keymap-global-set: Emacs 29.1. (line 387) +* keymap-global-unset: Emacs 29.1. (line 407) +* keymap-local-lookup: Emacs 29.1. (line 449) +* keymap-local-set: Emacs 29.1. (line 397) +* keymap-local-unset: Emacs 29.1. (line 422) +* keymap-lookup: Emacs 29.1. (line 436) +* keymap-set: Emacs 29.1. (line 363) +* keymap-substitute: Emacs 29.1. (line 428) +* length<: Emacs 28.1. (line 42) +* length=: Emacs 28.1. (line 39) +* length>: Emacs 28.1. (line 47) +* list-of-strings-p: Emacs 29.1. (line 51) +* macroexp-file-name: Emacs 28.1. (line 298) +* macroexp-parse: Emacs 25.1. (line 175) +* macroexp-quote: Emacs 25.1. (line 172) +* macroexp-warn-and-return: Emacs 28.1. (line 302) +* macroexpand-1: Emacs 25.1. (line 165) +* major-mode-restore: Emacs 27.1. (line 22) +* major-mode-suspend: Emacs 27.1. (line 13) +* make-empty-file: Emacs 27.1. (line 254) +* make-lock-file-name: Emacs 28.1. (line 353) +* make-nearby-temp-file: Emacs 26.1. (line 120) +* make-separator-line: Emacs 28.1. (line 85) +* mapcan: Emacs 26.1. (line 53) +* mark-thing-at-mouse: Emacs 28.1. (line 295) +* match-buffers: Emacs 29.1. (line 239) +* minibuffer-history-value: Emacs 27.1. (line 32) +* named-let: Emacs 28.1. (line 204) +* ntake: Emacs 29.1. (line 160) +* package-get-version: Emacs 27.1. (line 205) +* plistp: Emacs 29.1. (line 54) +* pos-bol: Emacs 29.1. (line 70) +* pos-eol: Emacs 29.1. (line 74) +* process-lines-handling-status: Emacs 28.1. (line 17) +* process-lines-ignore-status: Emacs 28.1. (line 13) +* proper-list-p: Emacs 27.1. (line 76) +* provided-mode-derived-p: Emacs 27.1. (line 247) +* read-answer: Emacs 26.1. (line 17) +* read-char-from-minibuffer: Emacs 27.1. (line 44) +* read-multiple-choice: Emacs 26.1. (line 185) +* readablep: Emacs 29.1. (line 17) +* region-bounds: Emacs 25.1. (line 28) +* region-noncontiguous-p: Emacs 25.1. (line 34) +* replace-regexp-in-string: Emacs 28.1. (line 114) +* replace-string-in-region: Emacs 28.1. (line 99) +* ring-resize: Emacs 27.1. (line 28) +* save-mark-and-excursion: Emacs 25.1. (line 39) +* string-chop-newline: Emacs 28.1. (line 199) +* string-clean-whitespace: Emacs 28.1. (line 168) +* string-distance: Emacs 27.1. (line 86) +* string-equal-ignore-case: Emacs 29.1. (line 193) +* string-fill: Emacs 28.1. (line 175) +* string-glyph-split: Emacs 29.1. (line 248) +* string-greaterp: Emacs 25.1. (line 64) +* string-lines: Emacs 28.1. (line 183) +* string-pad: Emacs 28.1. (line 190) +* string-replace: Emacs 28.1. (line 74) +* string-search: Emacs 28.1. (line 31) +* string-split: Emacs 29.1. (line 199) +* subr-native-elisp-p: Emacs 28.1. (line 369) +* subr-primitive-p: Emacs 28.1. (line 362) +* substitute-quotes: Emacs 29.1. (line 23) +* take: Emacs 29.1. (line 146) +* temporary-file-directory: Emacs 26.1. (line 137) +* text-property-search-backward: Emacs 27.1. (line 332) +* text-property-search-forward: Emacs 27.1. (line 260) +* text-quoting-style: Emacs 28.1. (line 25) +* thing-at-mouse: Emacs 28.1. (line 282) +* thread-first: Emacs 25.1. (line 123) +* thread-last: Emacs 25.1. (line 144) +* time-equal-p: Emacs 27.1. (line 208) +* use-region-beginning: Emacs 29.1. (line 36) +* use-region-end: Emacs 29.1. (line 33) +* use-region-noncontiguous-p: Emacs 29.1. (line 30) +* when-let: Emacs 25.1. (line 115) +* when-let*: Emacs 26.1. (line 153) +* while-let: Emacs 29.1. (line 545) +* with-buffer-unmodified-if-unchanged: Emacs 29.1. (line 271) +* with-delayed-message: Emacs 29.1. (line 78) +* with-environment-variables: Emacs 28.1. (line 306) +* with-existing-directory: Emacs 28.1. (line 129) +* with-file-modes: Emacs 25.1. (line 71) +* with-memoization: Emacs 29.1. (line 57) +* with-minibuffer-selected-window: Emacs 27.1. (line 38) +* with-narrowing: Emacs 29.1. (line 62) +* with-suppressed-warnings: Emacs 27.1. (line 65) +* with-window-non-dedicated: Emacs 28.1. (line 374) +* xor: Emacs 27.1. (line 142) + + +File: doc5ZeelO.info, Node: Variable Index, Prev: Function Index, Up: Top + +Appendix B Variable Index +************************* + +[index] +* Menu: + +* exec-path: Emacs 27.1. (line 228) +* gensym-counter: Emacs 26.1. (line 77) +* mounted-file-systems: Emacs 26.1. (line 133) +* regexp-unmatchable: Emacs 27.1. (line 152) +* set-transient-map-timeout: Emacs 29.1. (line 666) +* text-quoting-style: Emacs 25.1. (line 13) + + + +Tag Table: +Node: Top829 +Node: Introduction2258 +Node: Overview2421 +Node: Usage2947 +Node: Limitations7161 +Node: Support11786 +Node: Emacs 25.112371 +Node: Emacs 26.121773 +Node: Emacs 27.139025 +Node: Emacs 28.159422 +Node: Emacs 29.179048 +Node: Development113288 +Node: Function Index114308 +Node: Variable Index129229 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: diff --git a/elpa/compat-28.1.2.2/dir b/elpa/compat-29.1.3.4/dir similarity index 100% rename from elpa/compat-28.1.2.2/dir rename to elpa/compat-29.1.3.4/dir diff --git a/elpa/dash-20210826.1149/dash-autoloads.el b/elpa/dash-20230502.1324/dash-autoloads.el similarity index 65% rename from elpa/dash-20210826.1149/dash-autoloads.el rename to elpa/dash-20230502.1324/dash-autoloads.el index 3a96693f..6783a8d0 100644 --- a/elpa/dash-20210826.1149/dash-autoloads.el +++ b/elpa/dash-20230502.1324/dash-autoloads.el @@ -1,4 +1,4 @@ -;;; dash-autoloads.el --- automatically extracted autoloads +;;; dash-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- ;; ;;; Code: @@ -12,10 +12,19 @@ (autoload 'dash-fontify-mode "dash" "\ Toggle fontification of Dash special variables. -If called interactively, enable Dash-Fontify mode if ARG is -positive, and disable it if ARG is zero or negative. If called -from Lisp, also enable the mode if ARG is omitted or nil, and -toggle it if ARG is `toggle'; disable the mode otherwise. +This is a minor mode. If called interactively, toggle the +`Dash-Fontify mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `dash-fontify-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. Dash-Fontify mode is a buffer-local minor mode intended for Emacs Lisp buffers. Enabling it causes the special variables bound in @@ -44,11 +53,15 @@ or call the function `global-dash-fontify-mode'.") (autoload 'global-dash-fontify-mode "dash" "\ Toggle Dash-Fontify mode in all buffers. With prefix ARG, enable Global Dash-Fontify mode if ARG is positive; -otherwise, disable it. If called from Lisp, enable the mode if -ARG is omitted or nil. +otherwise, disable it. + +If called from Lisp, toggle the mode if ARG is `toggle'. +Enable the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. Dash-Fontify mode is enabled in all buffers where `dash--turn-on-fontify-mode' would do it. + See `dash-fontify-mode' for more information on Dash-Fontify mode. \(fn &optional ARG)" t nil) @@ -57,7 +70,7 @@ See `dash-fontify-mode' for more information on Dash-Fontify mode. Register the Dash Info manual with `info-lookup-symbol'. This allows Dash symbols to be looked up with \\[info-lookup-symbol]." t nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dash" '("!cdr" "!cons" "--" "->" "-a" "-butlast" "-c" "-d" "-e" "-f" "-gr" "-i" "-juxt" "-keep" "-l" "-m" "-no" "-o" "-p" "-r" "-s" "-t" "-u" "-value-to-list" "-when-let" "-zip" "dash-"))) +(register-definition-prefixes "dash" '("!cdr" "!cons" "--" "->" "-a" "-butlast" "-c" "-d" "-e" "-f" "-gr" "-i" "-juxt" "-keep" "-l" "-m" "-no" "-o" "-p" "-r" "-s" "-t" "-u" "-value-to-list" "-when-let" "-zip" "dash-")) ;;;*** diff --git a/elpa/dash-20210826.1149/dash-pkg.el b/elpa/dash-20230502.1324/dash-pkg.el similarity index 58% rename from elpa/dash-20210826.1149/dash-pkg.el rename to elpa/dash-20230502.1324/dash-pkg.el index 7dc2d7a3..dc5b0e80 100644 --- a/elpa/dash-20210826.1149/dash-pkg.el +++ b/elpa/dash-20230502.1324/dash-pkg.el @@ -1,6 +1,8 @@ -(define-package "dash" "20210826.1149" "A modern list library for Emacs" +(define-package "dash" "20230502.1324" "A modern list library for Emacs" '((emacs "24")) - :commit "da167c51e9fd167a48d06c7c0ee8e3ac7abd9718" :authors + :commit "96eaba028ac069ea0e5cc70de15b0229126a054a" :authors + '(("Magnar Sveen" . "magnars@gmail.com")) + :maintainers '(("Magnar Sveen" . "magnars@gmail.com")) :maintainer '("Magnar Sveen" . "magnars@gmail.com") diff --git a/elpa/dash-20210826.1149/dash.el b/elpa/dash-20230502.1324/dash.el similarity index 73% rename from elpa/dash-20210826.1149/dash.el rename to elpa/dash-20230502.1324/dash.el index 6386c5f6..f02a5345 100644 --- a/elpa/dash-20210826.1149/dash.el +++ b/elpa/dash-20230502.1324/dash.el @@ -1,6 +1,6 @@ ;;; dash.el --- A modern list library for Emacs -*- lexical-binding: t -*- -;; Copyright (C) 2012-2021 Free Software Foundation, Inc. +;; Copyright (C) 2012-2023 Free Software Foundation, Inc. ;; Author: Magnar Sveen ;; Version: 2.19.1 @@ -29,11 +29,19 @@ ;;; Code: -;; TODO: `gv' was introduced in Emacs 24.3, so remove this and all -;; calls to `defsetf' when support for earlier versions is dropped. (eval-when-compile + ;; TODO: Emacs 24.3 first introduced `gv', so remove this and all + ;; calls to `defsetf' when support for earlier versions is dropped. (unless (fboundp 'gv-define-setter) - (require 'cl))) + (require 'cl)) + + ;; - 24.3 started complaining about unknown `declare' props. + ;; - 25 introduced `pure' and `side-effect-free'. + ;; - 30 introduced `important-return-value'. + (when (boundp 'defun-declarations-alist) + (dolist (prop '(important-return-value pure side-effect-free)) + (unless (assq prop defun-declarations-alist) + (push (list prop #'ignore) defun-declarations-alist))))) (defgroup dash () "Customize group for Dash, a modern list library." @@ -60,12 +68,12 @@ This is the anaphoric counterpart to `-each'." (let ((l (make-symbol "list")) (i (make-symbol "i"))) `(let ((,l ,list) - (,i 0) - it it-index) - (ignore it it-index) + (,i 0)) (while ,l - (setq it (pop ,l) it-index ,i ,i (1+ ,i)) - ,@body)))) + (let ((it (pop ,l)) (it-index ,i)) + (ignore it it-index) + ,@body) + (setq ,i (1+ ,i)))))) (defun -each (list fn) "Call FN on each element of LIST. @@ -102,11 +110,16 @@ This is the anaphoric counterpart to `-each-while'." (elt (make-symbol "elt"))) `(let ((,l ,list) (,i 0) - ,elt it it-index) - (ignore it it-index) - (while (and ,l (setq ,elt (pop ,l) it ,elt it-index ,i) ,pred) - (setq it ,elt it-index ,i ,i (1+ ,i)) - ,@body)))) + ,elt) + (while (when ,l + (setq ,elt (car-safe ,l)) + (let ((it ,elt) (it-index ,i)) + (ignore it it-index) + ,pred)) + (let ((it ,elt) (it-index ,i)) + (ignore it it-index) + ,@body) + (setq ,i (1+ ,i) ,l (cdr ,l)))))) (defun -each-while (list pred fn) "Call FN on each ITEM in LIST, while (PRED ITEM) is non-nil. @@ -210,6 +223,7 @@ This function's anaphoric counterpart is `--dotimes'." "Apply FN to each item in LIST and return the list of results. This function's anaphoric counterpart is `--map'." + (declare (important-return-value t)) (mapcar fn list)) (defmacro --map (form list) @@ -245,6 +259,7 @@ etc. If LIST is empty, return INIT without calling FN. This function's anaphoric counterpart is `--reduce-from'. For other folds, see also `-reduce' and `-reduce-r'." + (declare (important-return-value t)) (--reduce-from (funcall fn acc it) init list)) (defmacro --reduce (form list) @@ -276,6 +291,7 @@ arguments. This function's anaphoric counterpart is `--reduce'. For other folds, see also `-reduce-from' and `-reduce-r'." + (declare (important-return-value t)) (if list (-reduce-from fn (car list) (cdr list)) (funcall fn))) @@ -307,6 +323,7 @@ its last link with INIT, and evaluating the resulting expression. This function's anaphoric counterpart is `--reduce-r-from'. For other folds, see also `-reduce-r' and `-reduce'." + (declare (important-return-value t)) (--reduce-r-from (funcall fn it acc) init list)) (defmacro --reduce-r (form list) @@ -336,6 +353,7 @@ ignoring its last link, and evaluating the resulting expression. This function's anaphoric counterpart is `--reduce-r'. For other folds, see also `-reduce-r-from' and `-reduce'." + (declare (important-return-value t)) (if list (--reduce-r (funcall fn it acc) list) (funcall fn))) @@ -361,6 +379,7 @@ arguments. This function's anaphoric counterpart is `--reductions-from'. For other folds, see also `-reductions' and `-reductions-r'." + (declare (important-return-value t)) (--reductions-from (funcall fn acc it) init list)) (defmacro --reductions (form list) @@ -373,7 +392,9 @@ This is the anaphoric counterpart to `-reductions'." `(let ((,lv ,list)) (if ,lv (--reductions-from ,form (car ,lv) (cdr ,lv)) - (let (acc it) + ;; Explicit nil binding pacifies lexical "variable left uninitialized" + ;; warning. See issue #377 and upstream https://bugs.gnu.org/47080. + (let ((acc nil) (it nil)) (ignore acc it) (list ,form)))))) @@ -385,6 +406,7 @@ when `-reduce' (which see) is called with the same arguments. This function's anaphoric counterpart is `--reductions'. For other folds, see also `-reductions' and `-reductions-r'." + (declare (important-return-value t)) (if list (--reductions-from (funcall fn acc it) (car list) (cdr list)) (list (funcall fn)))) @@ -409,6 +431,7 @@ arguments. This function's anaphoric counterpart is `--reductions-r-from'. For other folds, see also `-reductions' and `-reductions-r'." + (declare (important-return-value t)) (--reductions-r-from (funcall fn it acc) init list)) (defmacro --reductions-r (form list) @@ -438,6 +461,7 @@ This function's anaphoric counterpart is `--reductions-r'. For other folds, see also `-reductions-r-from' and `-reductions'." + (declare (important-return-value t)) (if list (--reductions-r (funcall fn it acc) list) (list (funcall fn)))) @@ -462,6 +486,7 @@ Alias: `-select'. This function's anaphoric counterpart is `--filter'. For similar operations, see also `-keep' and `-remove'." + (declare (important-return-value t)) (--filter (funcall pred it) list)) (defalias '-select '-filter) @@ -484,6 +509,7 @@ Alias: `-reject'. This function's anaphoric counterpart is `--remove'. For similar operations, see also `-keep' and `-filter'." + (declare (important-return-value t)) (--remove (funcall pred it) list)) (defalias '-reject '-remove) @@ -519,9 +545,11 @@ Alias: `-reject-first'. This function's anaphoric counterpart is `--remove-first'. See also `-map-first', `-remove-item', and `-remove-last'." + (declare (important-return-value t)) (--remove-first (funcall pred it) list)) -(defalias '-reject-first '-remove-first) +;; TODO: #'-quoting the macro upsets Emacs 24. +(defalias '-reject-first #'-remove-first) (defalias '--reject-first '--remove-first) (defmacro --remove-last (form list) @@ -543,6 +571,7 @@ Alias: `-reject-last'. This function's anaphoric counterpart is `--remove-last'. See also `-map-last', `-remove-item', and `-remove-first'." + (declare (important-return-value t)) (--remove-last (funcall pred it) list)) (defalias '-reject-last '-remove-last) @@ -573,6 +602,7 @@ Like `-filter', but returns the non-nil results of FN instead of the corresponding elements of LIST. Its anaphoric counterpart is `--keep'." + (declare (important-return-value t)) (--keep (funcall fn it) list)) (defun -non-nil (list) @@ -602,6 +632,7 @@ current element within LIST, and the element itself. This function's anaphoric counterpart is `--map-indexed'. For a side-effecting variant, see also `-each-indexed'." + (declare (important-return-value t)) (--map-indexed (funcall fn it-index it) list)) (defmacro --map-when (pred rep list) @@ -613,22 +644,26 @@ For a side-effecting variant, see also `-each-indexed'." (nreverse ,r)))) (defun -map-when (pred rep list) - "Return a new list where the elements in LIST that do not match the PRED function -are unchanged, and where the elements in LIST that do match the PRED function are mapped -through the REP function. + "Use PRED to conditionally apply REP to each item in LIST. +Return a copy of LIST where the items for which PRED returns nil +are unchanged, and the rest are mapped through the REP function. Alias: `-replace-where' See also: `-update-at'" + (declare (important-return-value t)) (--map-when (funcall pred it) (funcall rep it) list)) (defalias '-replace-where '-map-when) (defalias '--replace-where '--map-when) (defun -map-first (pred rep list) - "Replace first item in LIST satisfying PRED with result of REP called on this item. + "Use PRED to determine the first item in LIST to call REP on. +Return a copy of LIST where the first item for which PRED returns +non-nil is replaced with the result of calling REP on that item. See also: `-map-when', `-replace-first'" + (declare (important-return-value t)) (let (front) (while (and list (not (funcall pred (car list)))) (push (car list) front) @@ -640,18 +675,25 @@ See also: `-map-when', `-replace-first'" (defmacro --map-first (pred rep list) "Anaphoric form of `-map-first'." (declare (debug (def-form def-form form))) - `(-map-first (lambda (it) ,pred) (lambda (it) (ignore it) ,rep) ,list)) + `(-map-first (lambda (it) (ignore it) ,pred) + (lambda (it) (ignore it) ,rep) + ,list)) (defun -map-last (pred rep list) - "Replace last item in LIST satisfying PRED with result of REP called on this item. + "Use PRED to determine the last item in LIST to call REP on. +Return a copy of LIST where the last item for which PRED returns +non-nil is replaced with the result of calling REP on that item. See also: `-map-when', `-replace-last'" + (declare (important-return-value t)) (nreverse (-map-first pred rep (reverse list)))) (defmacro --map-last (pred rep list) "Anaphoric form of `-map-last'." (declare (debug (def-form def-form form))) - `(-map-last (lambda (it) ,pred) (lambda (it) (ignore it) ,rep) ,list)) + `(-map-last (lambda (it) (ignore it) ,pred) + (lambda (it) (ignore it) ,rep) + ,list)) (defun -replace (old new list) "Replace all OLD items in LIST with NEW. @@ -683,11 +725,12 @@ See also: `-map-last'" (defmacro --mapcat (form list) "Anaphoric form of `-mapcat'." (declare (debug (form form))) - `(apply 'append (--map ,form ,list))) + `(apply #'append (--map ,form ,list))) (defun -mapcat (fn list) "Return the concatenation of the result of mapping FN over LIST. Thus function FN should return a list." + (declare (important-return-value t)) (--mapcat (funcall fn it) list)) (defmacro --iterate (form init n) @@ -711,12 +754,13 @@ This means a list of the form: (INIT (FUN INIT) (FUN (FUN INIT)) ...) N is the length of the returned list." + (declare (important-return-value t)) (--iterate (funcall fun it) init n)) (defun -flatten (l) "Take a nested list L and return its contents as a single, flat list. -Note that because `nil' represents a list of zero elements (an +Note that because nil represents a list of zero elements (an empty list), any mention of nil in L will disappear after flattening. If you need to preserve nils, consider `-flatten-n' or map them to some unique symbol and then map them back. @@ -739,49 +783,73 @@ See also: `-flatten'" (setq list (apply #'append (mapcar #'-list list)))) list) -(defun -concat (&rest lists) - "Return a new list with the concatenation of the elements in the supplied LISTS." - (declare (pure t) (side-effect-free t)) - (apply 'append lists)) +(defalias '-concat #'append + "Concatenate all the arguments and make the result a list. +The result is a list whose elements are the elements of all the arguments. +Each argument may be a list, vector or string. -(defalias '-copy 'copy-sequence +All arguments except the last argument are copied. The last argument +is just used as the tail of the new list. + +\(fn &rest SEQUENCES)") + +(defalias '-copy #'copy-sequence "Create a shallow copy of LIST. \(fn LIST)") +(defmacro --splice (pred form list) + "Splice lists generated by FORM in place of items satisfying PRED in LIST. + +Evaluate PRED for each element of LIST in turn bound to `it'. +Whenever the result of PRED is nil, leave that `it' is-is. +Otherwise, evaluate FORM with the same `it' binding still in +place. The result should be a (possibly empty) list of items to +splice in place of `it' in LIST. + +This can be useful as an alternative to the `,@' construct in a +`\\=`' structure, in case you need to splice several lists at +marked positions (for example with keywords). + +This is the anaphoric counterpart to `-splice'." + (declare (debug (form form form))) + (let ((r (make-symbol "result"))) + `(let (,r) + (--each ,list + (if ,pred + (--each ,form (push it ,r)) + (push it ,r))) + (nreverse ,r)))) + (defun -splice (pred fun list) - "Splice lists generated by FUN in place of elements matching PRED in LIST. + "Splice lists generated by FUN in place of items satisfying PRED in LIST. -FUN takes the element matching PRED as input. +Call PRED on each element of LIST. Whenever the result of PRED +is nil, leave that `it' as-is. Otherwise, call FUN on the same +`it' that satisfied PRED. The result should be a (possibly +empty) list of items to splice in place of `it' in LIST. -This function can be used as replacement for `,@' in case you -need to splice several lists at marked positions (for example -with keywords). +This can be useful as an alternative to the `,@' construct in a +`\\=`' structure, in case you need to splice several lists at +marked positions (for example with keywords). -See also: `-splice-list', `-insert-at'" - (let (r) - (--each list - (if (funcall pred it) - (let ((new (funcall fun it))) - (--each new (!cons it r))) - (!cons it r))) - (nreverse r))) +This function's anaphoric counterpart is `--splice'. -(defmacro --splice (pred form list) - "Anaphoric form of `-splice'." - (declare (debug (def-form def-form form))) - `(-splice (lambda (it) ,pred) (lambda (it) ,form) ,list)) +See also: `-splice-list', `-insert-at'." + (declare (important-return-value t)) + (--splice (funcall pred it) (funcall fun it) list)) (defun -splice-list (pred new-list list) "Splice NEW-LIST in place of elements matching PRED in LIST. See also: `-splice', `-insert-at'" + (declare (important-return-value t)) (-splice pred (lambda (_) new-list) list)) (defmacro --splice-list (pred new-list list) "Anaphoric form of `-splice-list'." (declare (debug (def-form form form))) - `(-splice-list (lambda (it) ,pred) ,new-list ,list)) + `(-splice-list (lambda (it) (ignore it) ,pred) ,new-list ,list)) (defun -cons* (&rest args) "Make a new list from the elements of ARGS. @@ -802,7 +870,8 @@ is a dotted list. With no ARGS, return nil." This is like `cons', but operates on the end of list. -If ELEMENTS is non nil, append these to the list as well." +If any ELEMENTS are given, append them to the list as well." + (declare (pure t) (side-effect-free t)) (-concat list (list elem) elements)) (defmacro --first (form list) @@ -821,14 +890,17 @@ This is the anaphoric counterpart to `-first'." (defun -first (pred list) "Return the first item in LIST for which PRED returns non-nil. Return nil if no such element is found. -To get the first item in the list no questions asked, use `car'. + +To get the first item in the list no questions asked, +use `-first-item'. Alias: `-find'. This function's anaphoric counterpart is `--first'." + (declare (important-return-value t)) (--first (funcall pred it) list)) -(defalias '-find '-first) +(defalias '-find #'-first) (defalias '--find '--first) (defmacro --some (form list) @@ -849,6 +921,7 @@ This is the anaphoric counterpart to `-some'." Alias: `-any'. This function's anaphoric counterpart is `--some'." + (declare (important-return-value t)) (--some (funcall pred it) list)) (defalias '-any '-some) @@ -882,6 +955,7 @@ This function is like `-every-p', but on success returns the last non-nil result of PRED instead of just t. This function's anaphoric counterpart is `--every'." + (declare (important-return-value t)) (--every (funcall pred it) list)) (defmacro --last (form list) @@ -895,12 +969,13 @@ This function's anaphoric counterpart is `--every'." (defun -last (pred list) "Return the last x in LIST where (PRED x) is non-nil, else nil." + (declare (important-return-value t)) (--last (funcall pred it) list)) -(defalias '-first-item 'car +(defalias '-first-item #'car "Return the first item of LIST, or nil on an empty list. -See also: `-second-item', `-last-item'. +See also: `-second-item', `-last-item', etc. \(fn LIST)") @@ -908,40 +983,56 @@ See also: `-second-item', `-last-item'. ;; just like `car'. (put '-first-item 'byte-opcode 'byte-car) (put '-first-item 'byte-compile 'byte-compile-one-arg) +(put '-first-item 'pure t) +(put '-first-item 'side-effect-free t) -(defalias '-second-item 'cadr +(defalias '-second-item #'cadr "Return the second item of LIST, or nil if LIST is too short. -See also: `-third-item'. +See also: `-first-item', `-third-item', etc. \(fn LIST)") +(put '-second-item 'pure t) +(put '-second-item 'side-effect-free t) + (defalias '-third-item (if (fboundp 'caddr) #'caddr (lambda (list) (car (cddr list)))) "Return the third item of LIST, or nil if LIST is too short. -See also: `-fourth-item'. +See also: `-second-item', `-fourth-item', etc. \(fn LIST)") -(defun -fourth-item (list) +(put '-third-item 'pure t) +(put '-third-item 'side-effect-free t) + +(defalias '-fourth-item + (if (fboundp 'cadddr) + #'cadddr + (lambda (list) (cadr (cddr list)))) "Return the fourth item of LIST, or nil if LIST is too short. -See also: `-fifth-item'." - (declare (pure t) (side-effect-free t)) - (car (cdr (cdr (cdr list))))) +See also: `-third-item', `-fifth-item', etc. + +\(fn LIST)") + +(put '-fourth-item 'pure t) +(put '-fourth-item 'side-effect-free t) (defun -fifth-item (list) "Return the fifth item of LIST, or nil if LIST is too short. -See also: `-last-item'." +See also: `-fourth-item', `-last-item', etc." (declare (pure t) (side-effect-free t)) - (car (cdr (cdr (cdr (cdr list)))))) + (car (cddr (cddr list)))) (defun -last-item (list) - "Return the last item of LIST, or nil on an empty list." + "Return the last item of LIST, or nil on an empty list. + +See also: `-first-item', etc." (declare (pure t) (side-effect-free t)) (car (last list))) @@ -969,11 +1060,12 @@ See also: `-last-item'." (defun -count (pred list) "Counts the number of items in LIST where (PRED item) is non-nil." + (declare (important-return-value t)) (--count (funcall pred it) list)) (defun ---truthy? (obj) "Return OBJ as a boolean value (t or nil)." - (declare (pure t) (side-effect-free t)) + (declare (pure t) (side-effect-free error-free)) (and obj t)) (defmacro --any? (form list) @@ -982,9 +1074,10 @@ See also: `-last-item'." `(and (--some ,form ,list) t)) (defun -any? (pred list) - "Return t if (PRED x) is non-nil for any x in LIST, else nil. + "Return t if (PRED X) is non-nil for any X in LIST, else nil. Alias: `-any-p', `-some?', `-some-p'" + (declare (important-return-value t)) (--any? (funcall pred it) list)) (defalias '-some? '-any?) @@ -1023,6 +1116,7 @@ success. Alias: `-all-p', `-every-p', `-every?'. This function's anaphoric counterpart is `--all?'." + (declare (important-return-value t)) (--all? (funcall pred it) list)) (defalias '-every? '-all?) @@ -1038,9 +1132,10 @@ This function's anaphoric counterpart is `--all?'." `(--all? (not ,form) ,list)) (defun -none? (pred list) - "Return t if (PRED x) is nil for all x in LIST, else nil. + "Return t if (PRED X) is nil for all X in LIST, else nil. Alias: `-none-p'" + (declare (important-return-value t)) (--none? (funcall pred it) list)) (defalias '-none-p '-none?) @@ -1057,10 +1152,13 @@ Alias: `-none-p'" (---truthy? (and ,y ,n))))) (defun -only-some? (pred list) - "Return `t` if at least one item of LIST matches PRED and at least one item of LIST does not match PRED. -Return `nil` both if all items match the predicate or if none of the items match the predicate. + "Return t if different LIST items both satisfy and do not satisfy PRED. +That is, if PRED returns both nil for at least one item, and +non-nil for at least one other item in LIST. Return nil if all +items satisfy the predicate or none of them do. Alias: `-only-some-p'" + (declare (important-return-value t)) (--only-some? (funcall pred it) list)) (defalias '-only-some-p '-only-some?) @@ -1115,6 +1213,7 @@ non-nil. This function's anaphoric counterpart is `--take-while'. For another variant, see also `-drop-while'." + (declare (important-return-value t)) (--take-while (funcall pred it) list)) (defmacro --drop-while (form list) @@ -1139,6 +1238,7 @@ nil. This function's anaphoric counterpart is `--drop-while'. For another variant, see also `-take-while'." + (declare (important-return-value t)) (--drop-while (funcall pred it) list)) (defun -take (n list) @@ -1217,40 +1317,58 @@ See also: `-replace'" (nconc (car split-list) (cons x (cdr (cadr split-list)))))) (defun -update-at (n func list) - "Return a list with element at Nth position in LIST replaced with `(func (nth n list))`. + "Use FUNC to update the Nth element of LIST. +Return a copy of LIST where the Nth element is replaced with the +result of calling FUNC on it. See also: `-map-when'" + (declare (important-return-value t)) (let ((split-list (-split-at n list))) - (nconc (car split-list) (cons (funcall func (car (cadr split-list))) (cdr (cadr split-list)))))) + (nconc (car split-list) + (cons (funcall func (car (cadr split-list))) + (cdr (cadr split-list)))))) (defmacro --update-at (n form list) "Anaphoric version of `-update-at'." (declare (debug (form def-form form))) - `(-update-at ,n (lambda (it) ,form) ,list)) + `(-update-at ,n (lambda (it) (ignore it) ,form) ,list)) (defun -remove-at (n list) - "Return a list with element at Nth position in LIST removed. + "Return LIST with its element at index N removed. +That is, remove any element selected as (nth N LIST) from LIST +and return the result. + +This is a non-destructive operation: parts of LIST (but not +necessarily all of it) are copied as needed to avoid +destructively modifying it. -See also: `-remove-at-indices', `-remove'" +See also: `-remove-at-indices', `-remove'." (declare (pure t) (side-effect-free t)) - (-remove-at-indices (list n) list)) + (if (zerop n) + (cdr list) + (--remove-first (= it-index n) list))) (defun -remove-at-indices (indices list) - "Return a list whose elements are elements from LIST without -elements selected as `(nth i list)` for all i -from INDICES. + "Return LIST with its elements at INDICES removed. +That is, for each index I in INDICES, remove any element selected +as (nth I LIST) from LIST. + +This is a non-destructive operation: parts of LIST (but not +necessarily all of it) are copied as needed to avoid +destructively modifying it. -See also: `-remove-at', `-remove'" +See also: `-remove-at', `-remove'." (declare (pure t) (side-effect-free t)) - (let* ((indices (-sort '< indices)) - (diffs (cons (car indices) (-map '1- (-zip-with '- (cdr indices) indices)))) - r) - (--each diffs - (let ((split (-split-at it list))) - (!cons (car split) r) - (setq list (cdr (cadr split))))) - (!cons list r) - (apply '-concat (nreverse r)))) + (setq indices (--drop-while (< it 0) (-sort #'< indices))) + (let ((i (pop indices)) res) + (--each-while list i + (pop list) + (if (/= it-index i) + (push it res) + (while (and indices (= (car indices) i)) + (pop indices)) + (setq i (pop indices)))) + (nconc (nreverse res) list))) (defmacro --split-with (pred list) "Anaphoric form of `-split-with'." @@ -1270,7 +1388,15 @@ See also: `-remove-at', `-remove'" (list (nreverse ,r) ,l)))) (defun -split-with (pred list) - "Return a list of ((-take-while PRED LIST) (-drop-while PRED LIST)), in no more than one pass through the list." + "Split LIST into a prefix satisfying PRED, and the rest. +The first sublist is the prefix of LIST with successive elements +satisfying PRED, and the second sublist is the remaining elements +that do not. The result is like performing + + ((-take-while PRED LIST) (-drop-while PRED LIST)) + +but in no more than a single pass through LIST." + (declare (important-return-value t)) (--split-with (funcall pred it) list)) (defmacro -split-on (item list) @@ -1288,7 +1414,7 @@ See also `-split-when'" (defmacro --split-when (form list) "Anaphoric version of `-split-when'." (declare (debug (def-form form))) - `(-split-when (lambda (it) ,form) ,list)) + `(-split-when (lambda (it) (ignore it) ,form) ,list)) (defun -split-when (fn list) "Split the LIST on each element where FN returns non-nil. @@ -1298,6 +1424,7 @@ the results. Empty lists are also removed from the result. This function can be thought of as a generalization of `split-string'." + (declare (important-return-value t)) (let (r s) (while list (if (not (funcall fn (car list))) @@ -1318,11 +1445,17 @@ This function can be thought of as a generalization of (list (nreverse ,y) (nreverse ,n))))) (defun -separate (pred list) - "Return a list of ((-filter PRED LIST) (-remove PRED LIST)), in one pass through the list." + "Split LIST into two sublists based on whether items satisfy PRED. +The result is like performing + + ((-filter PRED LIST) (-remove PRED LIST)) + +but in a single pass through LIST." + (declare (important-return-value t)) (--separate (funcall pred it) list)) (defun dash--partition-all-in-steps-reversed (n step list) - "Used by `-partition-all-in-steps' and `-partition-in-steps'." + "Like `-partition-all-in-steps', but the result is reversed." (when (< step 1) (signal 'wrong-type-argument `("Step size < 1 results in juicy infinite loops" ,step))) @@ -1333,19 +1466,20 @@ This function can be thought of as a generalization of result)) (defun -partition-all-in-steps (n step list) - "Return a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart. -The last groups may contain less than N items." + "Partition LIST into sublists of length N that are STEP items apart. +Adjacent groups may overlap if N exceeds the STEP stride. +Trailing groups may contain less than N items." (declare (pure t) (side-effect-free t)) (nreverse (dash--partition-all-in-steps-reversed n step list))) (defun -partition-in-steps (n step list) - "Return a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart. -If there are not enough items to make the last group N-sized, -those items are discarded." + "Partition LIST into sublists of length N that are STEP items apart. +Like `-partition-all-in-steps', but if there are not enough items +to make the last group N-sized, those items are discarded." (declare (pure t) (side-effect-free t)) (let ((result (dash--partition-all-in-steps-reversed n step list))) (while (and result (< (length (car result)) n)) - (!cdr result)) + (pop result)) (nreverse result))) (defun -partition-all (n list) @@ -1390,6 +1524,7 @@ those items are discarded." (defun -partition-by (fn list) "Apply FN to each item in LIST, splitting it each time FN returns a new value." + (declare (important-return-value t)) (--partition-by (funcall fn it) list)) (defmacro --partition-by-header (form list) @@ -1428,6 +1563,7 @@ those items are discarded." value. Apply FN to each item in LIST, splitting it each time FN returns the header value, but only after seeing at least one other value (the body)." + (declare (important-return-value t)) (--partition-by-header (funcall fn it) list)) (defmacro --partition-after-pred (form list) @@ -1454,20 +1590,24 @@ This is the anaphoric counterpart to `-partition-after-pred'." "Partition LIST after each element for which PRED returns non-nil. This function's anaphoric counterpart is `--partition-after-pred'." + (declare (important-return-value t)) (--partition-after-pred (funcall pred it) list)) (defun -partition-before-pred (pred list) "Partition directly before each time PRED is true on an element of LIST." + (declare (important-return-value t)) (nreverse (-map #'reverse (-partition-after-pred pred (reverse list))))) (defun -partition-after-item (item list) "Partition directly after each time ITEM appears in LIST." + (declare (pure t) (side-effect-free t)) (-partition-after-pred (lambda (ele) (equal ele item)) list)) (defun -partition-before-item (item list) "Partition directly before each time ITEM appears in LIST." + (declare (pure t) (side-effect-free t)) (-partition-before-pred (lambda (ele) (equal ele item)) list)) @@ -1496,6 +1636,7 @@ This function's anaphoric counterpart is `--partition-after-pred'." (defun -group-by (fn list) "Separate LIST into an alist whose keys are FN applied to the elements of LIST. Keys are compared by `equal'." + (declare (important-return-value t)) (--group-by (funcall fn it) list)) (defun -interpose (sep list) @@ -1521,103 +1662,194 @@ elements of LIST. Keys are compared by `equal'." (nreverse result)))) (defmacro --zip-with (form list1 list2) - "Anaphoric form of `-zip-with'. + "Zip LIST1 and LIST2 into a new list according to FORM. +That is, evaluate FORM for each item pair from the two lists, and +return the list of results. The result is as long as the shorter +list. -The elements in list1 are bound as symbol `it', the elements in list2 as symbol `other'." +Each element of LIST1 and each element of LIST2 in turn are bound +pairwise to `it' and `other', respectively, and their index +within the list to `it-index', before evaluating FORM. + +This is the anaphoric counterpart to `-zip-with'." (declare (debug (form form form))) (let ((r (make-symbol "result")) - (l1 (make-symbol "list1")) (l2 (make-symbol "list2"))) - `(let ((,r nil) - (,l1 ,list1) - (,l2 ,list2)) - (while (and ,l1 ,l2) - (let ((it (car ,l1)) - (other (car ,l2))) - (!cons ,form ,r) - (!cdr ,l1) - (!cdr ,l2))) + `(let ((,l2 ,list2) ,r) + (--each-while ,list1 ,l2 + (let ((other (pop ,l2))) + (ignore other) + (push ,form ,r))) (nreverse ,r)))) (defun -zip-with (fn list1 list2) - "Zip the two lists LIST1 and LIST2 using a function FN. This -function is applied pairwise taking as first argument element of -LIST1 and as second argument element of LIST2 at corresponding -position. + "Zip LIST1 and LIST2 into a new list using the function FN. +That is, apply FN pairwise taking as first argument the next +element of LIST1 and as second argument the next element of LIST2 +at the corresponding position. The result is as long as the +shorter list. + +This function's anaphoric counterpart is `--zip-with'. -The anaphoric form `--zip-with' binds the elements from LIST1 as symbol `it', -and the elements from LIST2 as symbol `other'." +For other zips, see also `-zip-lists' and `-zip-fill'." + (declare (important-return-value t)) (--zip-with (funcall fn it other) list1 list2)) (defun -zip-lists (&rest lists) - "Zip LISTS together. Group the head of each list, followed by the -second elements of each list, and so on. The lengths of the returned -groupings are equal to the length of the shortest input list. + "Zip LISTS together. -The return value is always list of lists, which is a difference -from `-zip-pair' which returns a cons-cell in case two input -lists are provided. +Group the head of each list, followed by the second element of +each list, and so on. The number of returned groupings is equal +to the length of the shortest input list, and the length of each +grouping is equal to the number of input LISTS. -See also: `-zip'" +The return value is always a list of proper lists, in contrast to +`-zip' which returns a list of dotted pairs when only two input +LISTS are provided. + +See also: `-zip-pair'." (declare (pure t) (side-effect-free t)) (when lists (let (results) - (while (-none? 'null lists) - (setq results (cons (mapcar 'car lists) results)) - (setq lists (mapcar 'cdr lists))) + (while (--every it lists) + (push (mapcar #'car lists) results) + (setq lists (mapcar #'cdr lists))) (nreverse results)))) -(defun -zip (&rest lists) - "Zip LISTS together. Group the head of each list, followed by the -second elements of each list, and so on. The lengths of the returned -groupings are equal to the length of the shortest input list. +(defun -zip-lists-fill (fill-value &rest lists) + "Zip LISTS together, padding shorter lists with FILL-VALUE. +This is like `-zip-lists' (which see), except it retains all +elements at positions beyond the end of the shortest list. The +number of returned groupings is equal to the length of the +longest input list, and the length of each grouping is equal to +the number of input LISTS." + (declare (pure t) (side-effect-free t)) + (when lists + (let (results) + (while (--some it lists) + (push (--map (if it (car it) fill-value) lists) results) + (setq lists (mapcar #'cdr lists))) + (nreverse results)))) -If two lists are provided as arguments, return the groupings as a list -of cons cells. Otherwise, return the groupings as a list of lists. +(defun -unzip-lists (lists) + "Unzip LISTS. -Use `-zip-lists' if you need the return value to always be a list -of lists. +This works just like `-zip-lists' (which see), but takes a list +of lists instead of a variable number of arguments, such that -Alias: `-zip-pair' + (-unzip-lists (-zip-lists ARGS...)) -See also: `-zip-lists'" +is identity (given that the lists comprising ARGS are of the same +length)." (declare (pure t) (side-effect-free t)) - (when lists - (let (results) - (while (-none? 'null lists) - (setq results (cons (mapcar 'car lists) results)) - (setq lists (mapcar 'cdr lists))) - (setq results (nreverse results)) - (if (= (length lists) 2) - ;; to support backward compatibility, return - ;; a cons cell if two lists were provided - (--map (cons (car it) (cadr it)) results) - results)))) + (apply #'-zip-lists lists)) + +(defalias 'dash--length= + (if (fboundp 'length=) + #'length= + (lambda (list length) + (cond ((< length 0) nil) + ((zerop length) (null list)) + ((let ((last (nthcdr (1- length) list))) + (and last (null (cdr last)))))))) + "Return non-nil if LIST is of LENGTH. +This is a compatibility shim for `length=' in Emacs 28. +\n(fn LIST LENGTH)") + +(defun dash--zip-lists-or-pair (_form &rest lists) + "Return a form equivalent to applying `-zip' to LISTS. +This `compiler-macro' warns about discouraged `-zip' usage and +delegates to `-zip-lists' or `-zip-pair' depending on the number +of LISTS." + (if (not (dash--length= lists 2)) + (cons #'-zip-lists lists) + (let ((pair (cons #'-zip-pair lists)) + (msg "Use -zip-pair instead of -zip to get a list of pairs")) + (if (fboundp 'macroexp-warn-and-return) + (macroexp-warn-and-return msg pair) + (message msg) + pair)))) + +(defun -zip (&rest lists) + "Zip LISTS together. + +Group the head of each list, followed by the second element of +each list, and so on. The number of returned groupings is equal +to the length of the shortest input list, and the number of items +in each grouping is equal to the number of input LISTS. + +If only two LISTS are provided as arguments, return the groupings +as a list of dotted pairs. Otherwise, return the groupings as a +list of proper lists. -(defalias '-zip-pair '-zip) +Since the return value changes form depending on the number of +arguments, it is generally recommended to use `-zip-lists' +instead, or `-zip-pair' if a list of dotted pairs is desired. + +See also: `-unzip'." + (declare (compiler-macro dash--zip-lists-or-pair) + (pure t) (side-effect-free t)) + ;; For backward compatibility, return a list of dotted pairs if two + ;; arguments were provided. + (apply (if (dash--length= lists 2) #'-zip-pair #'-zip-lists) lists)) + +(defun -zip-pair (&rest lists) + "Zip LIST1 and LIST2 together. + +Make a pair with the head of each list, followed by a pair with +the second element of each list, and so on. The number of pairs +returned is equal to the length of the shorter input list. + +See also: `-zip-lists'." + (declare (advertised-calling-convention (list1 list2) "2.20.0") + (pure t) (side-effect-free t)) + (if (dash--length= lists 2) + (--zip-with (cons it other) (car lists) (cadr lists)) + (apply #'-zip-lists lists))) (defun -zip-fill (fill-value &rest lists) - "Zip LISTS, with FILL-VALUE padded onto the shorter lists. The -lengths of the returned groupings are equal to the length of the -longest input list." + "Zip LISTS together, padding shorter lists with FILL-VALUE. +This is like `-zip' (which see), except it retains all elements +at positions beyond the end of the shortest list. The number of +returned groupings is equal to the length of the longest input +list, and the length of each grouping is equal to the number of +input LISTS. + +Since the return value changes form depending on the number of +arguments, it is generally recommended to use `-zip-lists-fill' +instead, unless a list of dotted pairs is explicitly desired." (declare (pure t) (side-effect-free t)) - (apply '-zip (apply '-pad (cons fill-value lists)))) + (cond ((null lists) ()) + ((dash--length= lists 2) + (let ((list1 (car lists)) + (list2 (cadr lists)) + results) + (while (or list1 list2) + (push (cons (if list1 (pop list1) fill-value) + (if list2 (pop list2) fill-value)) + results)) + (nreverse results))) + ((apply #'-zip-lists-fill fill-value lists)))) (defun -unzip (lists) "Unzip LISTS. -This works just like `-zip' but takes a list of lists instead of -a variable number of arguments, such that +This works just like `-zip' (which see), but takes a list of +lists instead of a variable number of arguments, such that (-unzip (-zip L1 L2 L3 ...)) -is identity (given that the lists are the same length). +is identity (given that the lists are of the same length, and +that `-zip' is not called with two arguments, because of the +caveat described in its docstring). -Note in particular that calling this on a list of two lists will -return a list of cons-cells such that the above identity works. +Note in particular that calling `-unzip' on a list of two lists +will return a list of dotted pairs. -See also: `-zip'" - (apply '-zip lists)) +Since the return value changes form depending on the number of +LISTS, it is generally recommended to use `-unzip-lists' instead." + (declare (pure t) (side-effect-free t)) + (apply #'-zip lists)) (defun -cycle (list) "Return an infinite circular copy of LIST. @@ -1629,21 +1861,37 @@ from the beginning." (nconc newlist newlist))) (defun -pad (fill-value &rest lists) - "Appends FILL-VALUE to the end of each list in LISTS such that they -will all have the same length." - (let* ((annotations (-annotate 'length lists)) - (n (-max (-map 'car annotations)))) - (--map (append (cdr it) (-repeat (- n (car it)) fill-value)) annotations))) + "Pad each of LISTS with FILL-VALUE until they all have equal lengths. -(defun -annotate (fn list) - "Return a list of cons cells where each cell is FN applied to each -element of LIST paired with the unmodified element of LIST." - (-zip (-map fn list) list)) +Ensure all LISTS are as long as the longest one by repeatedly +appending FILL-VALUE to the shorter lists, and return the +resulting LISTS." + (declare (pure t) (side-effect-free t)) + (let* ((lens (mapcar #'length lists)) + (maxlen (apply #'max 0 lens))) + (--map (append it (make-list (- maxlen (pop lens)) fill-value)) lists))) (defmacro --annotate (form list) - "Anaphoric version of `-annotate'." - (declare (debug (def-form form))) - `(-annotate (lambda (it) ,form) ,list)) + "Pair each item in LIST with the result of evaluating FORM. + +Return an alist of (RESULT . ITEM), where each ITEM is the +corresponding element of LIST, and RESULT is the value obtained +by evaluating FORM with ITEM bound to `it'. + +This is the anaphoric counterpart to `-annotate'." + (declare (debug (form form))) + `(--map (cons ,form it) ,list)) + +(defun -annotate (fn list) + "Pair each item in LIST with the result of passing it to FN. + +Return an alist of (RESULT . ITEM), where each ITEM is the +corresponding element of LIST, and RESULT is the value obtained +by calling FN on ITEM. + +This function's anaphoric counterpart is `--annotate'." + (declare (important-return-value t)) + (--annotate (funcall fn it) list)) (defun dash--table-carry (lists restore-lists &optional re) "Helper for `-table' and `-table-flat'. @@ -1671,6 +1919,7 @@ combinations created by taking one element from each list in order. The dimension of the result is (length lists). See also: `-table-flat'" + (declare (important-return-value t)) (let ((restore-lists (copy-sequence lists)) (last-list (last lists)) (re (make-list (length lists) nil))) @@ -1697,6 +1946,7 @@ of the result. This is equivalent to calling: but the implementation here is much more efficient. See also: `-flatten-n', `-table'" + (declare (important-return-value t)) (let ((restore-lists (copy-sequence lists)) (last-list (last lists)) re) @@ -1707,54 +1957,91 @@ See also: `-flatten-n', `-table'" (dash--table-carry lists restore-lists))) (nreverse re))) +(defmacro --find-index (form list) + "Return the first index in LIST for which FORM evals to non-nil. +Return nil if no such index is found. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating FORM. +This is the anaphoric counterpart to `-find-index'." + (declare (debug (form form))) + `(--some (and ,form it-index) ,list)) + +(defun -find-index (pred list) + "Return the index of the first item satisfying PRED in LIST. +Return nil if no such item is found. + +PRED is called with one argument, the current list element, until +it returns non-nil, at which point the search terminates. + +This function's anaphoric counterpart is `--find-index'. + +See also: `-first', `-find-last-index'." + (declare (important-return-value t)) + (--find-index (funcall pred it) list)) + (defun -elem-index (elem list) - "Return the index of the first element in the given LIST which -is equal to the query element ELEM, or nil if there is no -such element." - (declare (pure t) (side-effect-free t)) - (car (-elem-indices elem list))) + "Return the first index of ELEM in LIST. +That is, the index within LIST of the first element that is +`equal' to ELEM. Return nil if there is no such element. -(defun -elem-indices (elem list) - "Return the indices of all elements in LIST equal to the query -element ELEM, in ascending order." +See also: `-find-index'." (declare (pure t) (side-effect-free t)) - (-find-indices (-partial 'equal elem) list)) + (--find-index (equal elem it) list)) + +(defmacro --find-indices (form list) + "Return the list of indices in LIST for which FORM evals to non-nil. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating FORM. +This is the anaphoric counterpart to `-find-indices'." + (declare (debug (form form))) + `(--keep (and ,form it-index) ,list)) (defun -find-indices (pred list) - "Return the indices of all elements in LIST satisfying the -predicate PRED, in ascending order." - (apply 'append (--map-indexed (when (funcall pred it) (list it-index)) list))) + "Return the list of indices in LIST satisfying PRED. -(defmacro --find-indices (form list) - "Anaphoric version of `-find-indices'." - (declare (debug (def-form form))) - `(-find-indices (lambda (it) ,form) ,list)) +Each element of LIST in turn is passed to PRED. If the result is +non-nil, the index of that element in LIST is included in the +result. The returned indices are in ascending order, i.e., in +the same order as they appear in LIST. -(defun -find-index (pred list) - "Take a predicate PRED and a LIST and return the index of the -first element in the list satisfying the predicate, or nil if -there is no such element. +This function's anaphoric counterpart is `--find-indices'. -See also `-first'." - (car (-find-indices pred list))) +See also: `-find-index', `-elem-indices'." + (declare (important-return-value t)) + (--find-indices (funcall pred it) list)) -(defmacro --find-index (form list) - "Anaphoric version of `-find-index'." - (declare (debug (def-form form))) - `(-find-index (lambda (it) ,form) ,list)) +(defun -elem-indices (elem list) + "Return the list of indices at which ELEM appears in LIST. +That is, the indices of all elements of LIST `equal' to ELEM, in +the same ascending order as they appear in LIST." + (declare (pure t) (side-effect-free t)) + (--find-indices (equal elem it) list)) + +(defmacro --find-last-index (form list) + "Return the last index in LIST for which FORM evals to non-nil. +Return nil if no such index is found. +Each element of LIST in turn is bound to `it' and its index +within LIST to `it-index' before evaluating FORM. +This is the anaphoric counterpart to `-find-last-index'." + (declare (debug (form form))) + (let ((i (make-symbol "index"))) + `(let (,i) + (--each ,list + (when ,form (setq ,i it-index))) + ,i))) (defun -find-last-index (pred list) - "Take a predicate PRED and a LIST and return the index of the -last element in the list satisfying the predicate, or nil if -there is no such element. + "Return the index of the last item satisfying PRED in LIST. +Return nil if no such item is found. -See also `-last'." - (-last-item (-find-indices pred list))) +Predicate PRED is called with one argument each time, namely the +current list element. -(defmacro --find-last-index (form list) - "Anaphoric version of `-find-last-index'." - (declare (debug (def-form form))) - `(-find-last-index (lambda (it) ,form) ,list)) +This function's anaphoric counterpart is `--find-last-index'. + +See also: `-last', `-find-index'." + (declare (important-return-value t)) + (--find-last-index (funcall pred it) list)) (defun -select-by-indices (indices list) "Return a list whose elements are elements from LIST selected @@ -1899,6 +2186,7 @@ Note: `it' need not be used in each form." "Grade elements of LIST using COMPARATOR relation. This yields a permutation vector such that applying this permutation to LIST sorts it in ascending order." + (declare (important-return-value t)) (->> (--map-indexed (cons it it-index) list) (-sort (lambda (it other) (funcall comparator (car it) (car other)))) (mapcar #'cdr))) @@ -1907,6 +2195,7 @@ permutation to LIST sorts it in ascending order." "Grade elements of LIST using COMPARATOR relation. This yields a permutation vector such that applying this permutation to LIST sorts it in descending order." + (declare (important-return-value t)) (->> (--map-indexed (cons it it-index) list) (-sort (lambda (it other) (funcall comparator (car other) (car it)))) (mapcar #'cdr))) @@ -1991,7 +2280,7 @@ MATCH-FORM is either a symbol, which gets bound to the respective value in source or another match form which gets destructured recursively. -If the cdr of last cons cell in the list is `nil', matching stops +If the cdr of last cons cell in the list is nil, matching stops there. SOURCE is a proper or improper list." @@ -2084,7 +2373,7 @@ This method normalizes PATTERN to the format expected by (let ((normalized (list (car pattern))) (skip nil) (fill-placeholder (make-symbol "--dash-fill-placeholder--"))) - (-each (apply '-zip (-pad fill-placeholder (cdr pattern) (cddr pattern))) + (-each (-zip-fill fill-placeholder (cdr pattern) (cddr pattern)) (lambda (pair) (let ((current (car pair)) (next (cdr pair))) @@ -2193,7 +2482,9 @@ matchers based on the type of the expression. Key-value stores are disambiguated by placing a token &plist, &alist or &hash as a first item in the MATCH-FORM." (cond - ((symbolp match-form) + ((and (symbolp match-form) + ;; Don't bind things like &keys as if they were vars (#395). + (not (functionp (dash--get-expand-function match-form)))) (dash--match-symbol match-form source)) ((consp match-form) (cond @@ -2348,7 +2639,7 @@ patterns be optionally left out and derived from the key name in the following fashion: - a key :foo is converted into `foo' pattern, -- a key 'bar is converted into `bar' pattern, +- a key \\='bar is converted into `bar' pattern, - a key \"baz\" is converted into `baz' pattern. That is, the entire value under the key is bound to the derived @@ -2362,10 +2653,10 @@ invalid spec fails with an error. Thus the patterns are normalized as follows: ;; derive all the missing patterns - (&plist :foo 'bar \"baz\") => (&plist :foo foo 'bar bar \"baz\" baz) + (&plist :foo \\='bar \"baz\") => (&plist :foo foo \\='bar bar \"baz\" baz) ;; we can specify some but not others - (&plist :foo 'bar explicit-bar) => (&plist :foo foo 'bar explicit-bar) + (&plist :foo \\='bar explicit-bar) => (&plist :foo foo \\='bar explicit-bar) ;; nothing happens, we store :foo in x (&plist :foo x) => (&plist :foo x) @@ -2421,7 +2712,8 @@ because we need to support improper list binding." ,@body) (let* ((varlist (dash--normalize-let-varlist varlist)) (inputs (--map-indexed (list (make-symbol (format "input%d" it-index)) (cadr it)) varlist)) - (new-varlist (--map (list (caar it) (cadr it)) (-zip varlist inputs)))) + (new-varlist (--zip-with (list (car it) (car other)) + varlist inputs))) `(let ,inputs (-let* ,new-varlist ,@body))))) @@ -2579,86 +2871,322 @@ execute body." (indent 1)) `(--if-let ,val (progn ,@body))) +;; TODO: Get rid of this dynamic variable, passing it as an argument +;; instead? (defvar -compare-fn nil - "Tests for equality use this function or `equal' if this is nil. -It should only be set using dynamic scope with a let, like: - - (let ((-compare-fn #\\='=)) (-union numbers1 numbers2 numbers3)") + "Tests for equality use this function, or `equal' if this is nil. + +As a dynamic variable, this should be temporarily bound around +the relevant operation, rather than permanently modified. For +example: + + (let ((-compare-fn #\\='=)) + (-union \\='(1 2 3) \\='(2 3 4)))") + +(defun dash--member-fn () + "Return the flavor of `member' that goes best with `-compare-fn'." + (declare (side-effect-free error-free)) + (let ((cmp -compare-fn)) + (cond ((memq cmp '(nil equal)) #'member) + ((eq cmp #'eq) #'memq) + ((eq cmp #'eql) #'memql) + ((lambda (elt list) + (while (and list (not (funcall cmp elt (car list)))) + (pop list)) + list))))) + +(defun dash--assoc-fn () + "Return the flavor of `assoc' that goes best with `-compare-fn'." + (declare (side-effect-free error-free)) + (let ((cmp -compare-fn)) + (cond ((memq cmp '(nil equal)) #'assoc) + ((eq cmp #'eq) #'assq) + ;; Since Emacs 26, `assoc' accepts a custom `testfn'. + ;; Version testing would be simpler here, but feature + ;; testing gets more brownie points, I guess. + ((condition-case nil + (with-no-warnings (assoc nil () #'eql)) + (wrong-number-of-arguments t)) + (lambda (key alist) + (--first (and (consp it) (funcall cmp (car it) key)) alist))) + ((with-no-warnings + (lambda (key alist) + (assoc key alist cmp))))))) + +(defun dash--hash-test-fn () + "Return the hash table test function corresponding to `-compare-fn'. +Return nil if `-compare-fn' is not a known test function." + (declare (side-effect-free error-free)) + ;; In theory this could also recognize values that are custom + ;; `hash-table-test's, but too often the :test name is different + ;; from the equality function, so it doesn't seem worthwile. + (car (memq (or -compare-fn #'equal) '(equal eq eql)))) + +(defvar dash--short-list-length 32 + "Maximum list length considered short, for optimizations. +For example, the speedup afforded by hash table lookup may start +to outweigh its runtime and memory overhead for problem sizes +greater than this value. See also the discussion in PR #305.") (defun -distinct (list) - "Return a new list with all duplicates removed. -The test for equality is done with `equal', -or with `-compare-fn' if that's non-nil. - -Alias: `-uniq'" - ;; Implementation note: The speedup gained from hash table lookup - ;; starts to outweigh its overhead for lists of length greater than - ;; 32. See discussion in PR #305. - (let* ((len (length list)) - (lut (and (> len 32) - ;; Check that `-compare-fn' is a valid hash-table - ;; lookup function or `nil'. - (memq -compare-fn '(nil equal eq eql)) - (make-hash-table :test (or -compare-fn #'equal) - :size len)))) - (if lut - (--filter (unless (gethash it lut) - (puthash it t lut)) - list) - (--each list (unless (-contains? lut it) (!cons it lut))) - (nreverse lut)))) - -(defalias '-uniq '-distinct) - -(defun -union (list list2) - "Return a new list containing the elements of LIST and elements of LIST2 that are not in LIST. -The test for equality is done with `equal', -or with `-compare-fn' if that's non-nil." - ;; We fall back to iteration implementation if the comparison - ;; function isn't one of `eq', `eql' or `equal'. - (let* ((result (reverse list)) - ;; TODO: get rid of this dynamic variable, pass it as an - ;; argument instead. - (-compare-fn (if (bound-and-true-p -compare-fn) - -compare-fn - 'equal))) - (if (memq -compare-fn '(eq eql equal)) - (let ((ht (make-hash-table :test -compare-fn))) - (--each list (puthash it t ht)) - (--each list2 (unless (gethash it ht) (!cons it result)))) - (--each list2 (unless (-contains? result it) (!cons it result)))) - (nreverse result))) + "Return a copy of LIST with all duplicate elements removed. -(defun -intersection (list list2) - "Return a new list containing only the elements that are members of both LIST and LIST2. -The test for equality is done with `equal', -or with `-compare-fn' if that's non-nil." - (--filter (-contains? list2 it) list)) +The test for equality is done with `equal', or with `-compare-fn' +if that is non-nil. + +Alias: `-uniq'." + (declare (important-return-value t)) + (let (test len) + (cond ((null list) ()) + ;; Use a hash table if `-compare-fn' is a known hash table + ;; test function and the list is long enough. + ((and (setq test (dash--hash-test-fn)) + (> (setq len (length list)) dash--short-list-length)) + (let ((ht (make-hash-table :test test :size len))) + (--filter (unless (gethash it ht) (puthash it t ht)) list))) + ((let ((member (dash--member-fn)) uniq) + (--each list (unless (funcall member it uniq) (push it uniq))) + (nreverse uniq)))))) + +(defalias '-uniq #'-distinct) + +(defun dash--size+ (size1 size2) + "Return the sum of nonnegative fixnums SIZE1 and SIZE2. +Return `most-positive-fixnum' on overflow. This ensures the +result is a valid size, particularly for allocating hash tables, +even in the presence of bignum support." + (declare (side-effect-free t)) + (if (< size1 (- most-positive-fixnum size2)) + (+ size1 size2) + most-positive-fixnum)) + +(defun -union (list1 list2) + "Return a new list of distinct elements appearing in either LIST1 or LIST2. -(defun -difference (list list2) - "Return a new list with only the members of LIST that are not in LIST2. -The test for equality is done with `equal', -or with `-compare-fn' if that's non-nil." - (--filter (not (-contains? list2 it)) list)) +The test for equality is done with `equal', or with `-compare-fn' +if that is non-nil." + (declare (important-return-value t)) + (let ((lists (list list1 list2)) test len union) + (cond ((null (or list1 list2))) + ;; Use a hash table if `-compare-fn' is a known hash table + ;; test function and the lists are long enough. + ((and (setq test (dash--hash-test-fn)) + (> (setq len (dash--size+ (length list1) (length list2))) + dash--short-list-length)) + (let ((ht (make-hash-table :test test :size len))) + (dolist (l lists) + (--each l (unless (gethash it ht) + (puthash it t ht) + (push it union)))))) + ((let ((member (dash--member-fn))) + (dolist (l lists) + (--each l (unless (funcall member it union) (push it union))))))) + (nreverse union))) + +(defun -intersection (list1 list2) + "Return a new list of distinct elements appearing in both LIST1 and LIST2. + +The test for equality is done with `equal', or with `-compare-fn' +if that is non-nil." + (declare (important-return-value t)) + (let (test len) + (cond ((null (and list1 list2)) ()) + ;; Use a hash table if `-compare-fn' is a known hash table + ;; test function and either list is long enough. + ((and (setq test (dash--hash-test-fn)) + (> (setq len (length list2)) dash--short-list-length)) + (let ((ht (make-hash-table :test test :size len))) + (--each list2 (puthash it t ht)) + ;; Remove visited elements to avoid duplicates. + (--filter (when (gethash it ht) (remhash it ht) t) list1))) + ((let ((member (dash--member-fn)) intersection) + (--each list1 (and (funcall member it list2) + (not (funcall member it intersection)) + (push it intersection))) + (nreverse intersection)))))) + +(defun -difference (list1 list2) + "Return a new list with the distinct members of LIST1 that are not in LIST2. + +The test for equality is done with `equal', or with `-compare-fn' +if that is non-nil." + (declare (important-return-value t)) + (let (test len1 len2) + (cond ((null list1) ()) + ((null list2) (-distinct list1)) + ;; Use a hash table if `-compare-fn' is a known hash table + ;; test function and the subtrahend is long enough. + ((and (setq test (dash--hash-test-fn)) + (setq len1 (length list1)) + (setq len2 (length list2)) + (> (max len1 len2) dash--short-list-length)) + (let ((ht1 (make-hash-table :test test :size len1)) + (ht2 (make-hash-table :test test :size len2))) + (--each list2 (puthash it t ht2)) + ;; Avoid duplicates by tracking visited items in `ht1'. + (--filter (unless (or (gethash it ht2) (gethash it ht1)) + (puthash it t ht1)) + list1))) + ((let ((member (dash--member-fn)) difference) + (--each list1 + (unless (or (funcall member it list2) + (funcall member it difference)) + (push it difference))) + (nreverse difference)))))) (defun -powerset (list) "Return the power set of LIST." - (if (null list) '(()) + (declare (pure t) (side-effect-free t)) + (if (null list) (list ()) (let ((last (-powerset (cdr list)))) - (append (mapcar (lambda (x) (cons (car list) x)) last) - last)))) + (nconc (mapcar (lambda (x) (cons (car list) x)) last) + last)))) + +(defun -frequencies (list) + "Count the occurrences of each distinct element of LIST. + +Return an alist of (ELEMENT . N), where each ELEMENT occurs N +times in LIST. + +The test for equality is done with `equal', or with `-compare-fn' +if that is non-nil. + +See also `-count' and `-group-by'." + (declare (important-return-value t)) + (let (test len freqs) + (cond ((null list)) + ((and (setq test (dash--hash-test-fn)) + (> (setq len (length list)) dash--short-list-length)) + (let ((ht (make-hash-table :test test :size len))) + ;; Share structure between hash table and returned list. + ;; This affords a single pass that preserves the input + ;; order, conses less garbage, and is faster than a + ;; second traversal (e.g., with `maphash'). + (--each list + (let ((freq (gethash it ht))) + (if freq + (setcdr freq (1+ (cdr freq))) + (push (puthash it (cons it 1) ht) freqs)))))) + ((let ((assoc (dash--assoc-fn))) + (--each list + (let ((freq (funcall assoc it freqs))) + (if freq + (setcdr freq (1+ (cdr freq))) + (push (cons it 1) freqs))))))) + (nreverse freqs))) + +(defun dash--numbers<= (nums) + "Return non-nil if NUMS is a list of non-decreasing numbers." + (declare (pure t) (side-effect-free t)) + (or (null nums) + (let ((prev (pop nums))) + (and (numberp prev) + (--every (and (numberp it) (<= prev (setq prev it))) nums))))) + +(defun dash--next-lex-perm (array n) + "Update ARRAY of N numbers with its next lexicographic permutation. +Return nil if there is no such successor. N should be nonzero. + +This implements the salient steps of Algorithm L (Lexicographic +permutation generation) as described in DE Knuth's The Art of +Computer Programming, Volume 4A / Combinatorial Algorithms, +Part I, Addison-Wesley, 2011, § 7.2.1.2, p. 319." + (setq n (1- n)) + (let* ((l n) + (j (1- n)) + (al (aref array n)) + (aj al)) + ;; L2. [Find j]. + ;; Decrement j until a[j] < a[j+1]. + (while (and (<= 0 j) + (<= aj (setq aj (aref array j)))) + (setq j (1- j))) + ;; Terminate algorithm if j not found. + (when (>= j 0) + ;; L3. [Increase a[j]]. + ;; Decrement l until a[j] < a[l]. + (while (>= aj al) + (setq l (1- l) al (aref array l))) + ;; Swap a[j] and a[l]. + (aset array j al) + (aset array l aj) + ;; L4. [Reverse a[j+1]...a[n]]. + (setq l n) + (while (< (setq j (1+ j)) l) + (setq aj (aref array j)) + (aset array j (aref array l)) + (aset array l aj) + (setq l (1- l))) + array))) + +(defun dash--lex-perms (vec &optional original) + "Return a list of permutations of VEC in lexicographic order. +Specifically, return only the successors of VEC in lexicographic +order. Each returned permutation is a list. VEC should comprise +one or more numbers, and may be destructively modified. + +If ORIGINAL is a vector, then VEC is interpreted as a set of +indices into ORIGINAL. In this case, the indices are permuted, +and the resulting index permutations are used to dereference +elements of ORIGINAL." + (let ((len (length vec)) perms) + (while vec + (push (if original + (--map (aref original it) vec) + (append vec ())) + perms) + (setq vec (dash--next-lex-perm vec len))) + (nreverse perms))) + +(defun dash--uniq-perms (list) + "Return a list of permutations of LIST. +LIST is treated as if all its elements are distinct." + (let* ((vec (vconcat list)) + (idxs (copy-sequence vec))) + ;; Just construct a vector of the list's indices and permute that. + (dotimes (i (length idxs)) + (aset idxs i i)) + (dash--lex-perms idxs vec))) + +(defun dash--multi-perms (list freqs) + "Return a list of permutations of the multiset LIST. +FREQS should be an alist describing the frequency of each element +in LIST, as returned by `-frequencies'." + (let (;; Distinct items in `list', aka the cars of `freqs'. + (uniq (make-vector (length freqs) nil)) + ;; Indices into `uniq'. + (idxs (make-vector (length list) nil)) + ;; Current index into `idxs'. + (i 0)) + (--each freqs + (aset uniq it-index (car it)) + ;; Populate `idxs' with as many copies of each `it-index' as + ;; there are corresponding duplicates. + (dotimes (_ (cdr it)) + (aset idxs i it-index) + (setq i (1+ i)))) + (dash--lex-perms idxs uniq))) (defun -permutations (list) - "Return the permutations of LIST." - (if (null list) '(()) - (apply #'append - (mapcar (lambda (x) - (mapcar (lambda (perm) (cons x perm)) - (-permutations (remove x list)))) - list)))) + "Return the distinct permutations of LIST. + +Duplicate elements of LIST are determined by `equal', or by +`-compare-fn' if that is non-nil." + (declare (important-return-value t)) + (cond ((null list) (list ())) + ;; Optimization: a traversal of `list' is faster than the + ;; round trip via `dash--uniq-perms' or `dash--multi-perms'. + ((dash--numbers<= list) + (dash--lex-perms (vconcat list))) + ((let ((freqs (-frequencies list))) + ;; Is each element distinct? + (unless (--every (= (cdr it) 1) freqs) + (dash--multi-perms list freqs)))) + ((dash--uniq-perms list)))) (defun -inits (list) "Return all prefixes of LIST." + (declare (pure t) (side-effect-free t)) (let ((res (list list))) (setq list (reverse list)) (while list @@ -2666,8 +3194,9 @@ or with `-compare-fn' if that's non-nil." res)) (defun -tails (list) - "Return all suffixes of LIST" - (-reductions-r-from 'cons nil list)) + "Return all suffixes of LIST." + (declare (pure t) (side-effect-free t)) + (-reductions-r-from #'cons nil list)) (defun -common-prefix (&rest lists) "Return the longest common prefix of LISTS." @@ -2677,43 +3206,58 @@ or with `-compare-fn' if that's non-nil." (defun -common-suffix (&rest lists) "Return the longest common suffix of LISTS." + (declare (pure t) (side-effect-free t)) (nreverse (apply #'-common-prefix (mapcar #'reverse lists)))) (defun -contains? (list element) "Return non-nil if LIST contains ELEMENT. The test for equality is done with `equal', or with `-compare-fn' -if that's non-nil. - -Alias: `-contains-p'" - (not - (null - (cond - ((null -compare-fn) (member element list)) - ((eq -compare-fn 'eq) (memq element list)) - ((eq -compare-fn 'eql) (memql element list)) - (t - (let ((lst list)) - (while (and lst - (not (funcall -compare-fn element (car lst)))) - (setq lst (cdr lst))) - lst)))))) - -(defalias '-contains-p '-contains?) - -(defun -same-items? (list list2) - "Return true if LIST and LIST2 has the same items. - -The order of the elements in the lists does not matter. - -Alias: `-same-items-p'" - (let ((length-a (length list)) - (length-b (length list2))) - (and - (= length-a length-b) - (= length-a (length (-intersection list list2)))))) - -(defalias '-same-items-p '-same-items?) +if that is non-nil. As with `member', the return value is +actually the tail of LIST whose car is ELEMENT. + +Alias: `-contains-p'." + (declare (important-return-value t)) + (funcall (dash--member-fn) element list)) + +(defalias '-contains-p #'-contains?) + +(defun -same-items? (list1 list2) + "Return non-nil if LIST1 and LIST2 have the same distinct elements. + +The order of the elements in the lists does not matter. The +lists may be of different lengths, i.e., contain duplicate +elements. The test for equality is done with `equal', or with +`-compare-fn' if that is non-nil. + +Alias: `-same-items-p'." + (declare (important-return-value t)) + (let (test len1 len2) + (cond ((null (or list1 list2))) + ((null (and list1 list2)) nil) + ;; Use a hash table if `-compare-fn' is a known hash table + ;; test function and either list is long enough. + ((and (setq test (dash--hash-test-fn)) + (setq len1 (length list1)) + (setq len2 (length list2)) + (> (max len1 len2) dash--short-list-length)) + (let ((ht1 (make-hash-table :test test :size len1)) + (ht2 (make-hash-table :test test :size len2))) + (--each list1 (puthash it t ht1)) + ;; Move visited elements from `ht1' to `ht2'. This way, + ;; if visiting all of `list2' leaves `ht1' empty, then + ;; all elements from both lists have been accounted for. + (and (--every (cond ((gethash it ht1) + (remhash it ht1) + (puthash it t ht2)) + ((gethash it ht2))) + list2) + (zerop (hash-table-count ht1))))) + ((let ((member (dash--member-fn))) + (and (--all? (funcall member it list2) list1) + (--all? (funcall member it list1) list2))))))) + +(defalias '-same-items-p #'-same-items?) (defun -is-prefix? (prefix list) "Return non-nil if PREFIX is a prefix of LIST. @@ -2753,12 +3297,13 @@ Alias: `-is-infix-p'" Return the sorted list. LIST is NOT modified by side effects. COMPARATOR is called with two elements of LIST, and should return non-nil if the first element should sort before the second." + (declare (important-return-value t)) (sort (copy-sequence list) comparator)) (defmacro --sort (form list) "Anaphoric form of `-sort'." (declare (debug (def-form form))) - `(-sort (lambda (it other) ,form) ,list)) + `(-sort (lambda (it other) (ignore it other) ,form) ,list)) (defun -list (&optional arg &rest args) "Ensure ARG is a list. @@ -2770,19 +3315,19 @@ In this case, if ARG is not a list, a new list with all of ARGS as elements is returned. This use is supported for backward compatibility and is otherwise deprecated." (declare (advertised-calling-convention (arg) "2.18.0") - (pure t) (side-effect-free t)) + (pure t) (side-effect-free error-free)) (if (listp arg) arg (cons arg args))) (defun -repeat (n x) "Return a new list of length N with each element being X. Return nil if N is less than 1." (declare (pure t) (side-effect-free t)) - (and (natnump n) (make-list n x))) + (and (>= n 0) (make-list n x))) (defun -sum (list) "Return the sum of LIST." (declare (pure t) (side-effect-free t)) - (apply '+ list)) + (apply #'+ list)) (defun -running-sum (list) "Return a list with running sums of items in LIST. @@ -2794,7 +3339,7 @@ LIST must be non-empty." (defun -product (list) "Return the product of LIST." (declare (pure t) (side-effect-free t)) - (apply '* list)) + (apply #'* list)) (defun -running-product (list) "Return a list with running products of items in LIST. @@ -2806,12 +3351,12 @@ LIST must be non-empty." (defun -max (list) "Return the largest value from LIST of numbers or markers." (declare (pure t) (side-effect-free t)) - (apply 'max list)) + (apply #'max list)) (defun -min (list) "Return the smallest value from LIST of numbers or markers." (declare (pure t) (side-effect-free t)) - (apply 'min list)) + (apply #'min list)) (defun -max-by (comparator list) "Take a comparison function COMPARATOR and a LIST and return @@ -2819,6 +3364,7 @@ the greatest element of the list by the comparison function. See also combinator `-on' which can transform the values before comparing them." + (declare (important-return-value t)) (--reduce (if (funcall comparator it acc) it acc) list)) (defun -min-by (comparator list) @@ -2827,6 +3373,7 @@ the least element of the list by the comparison function. See also combinator `-on' which can transform the values before comparing them." + (declare (important-return-value t)) (--reduce (if (funcall comparator it acc) acc it) list)) (defmacro --max-by (form list) @@ -2834,14 +3381,14 @@ comparing them." The items for the comparator form are exposed as \"it\" and \"other\"." (declare (debug (def-form form))) - `(-max-by (lambda (it other) ,form) ,list)) + `(-max-by (lambda (it other) (ignore it other) ,form) ,list)) (defmacro --min-by (form list) "Anaphoric version of `-min-by'. The items for the comparator form are exposed as \"it\" and \"other\"." (declare (debug (def-form form))) - `(-min-by (lambda (it other) ,form) ,list)) + `(-min-by (lambda (it other) (ignore it other) ,form) ,list)) (defun -iota (count &optional start step) "Return a list containing COUNT numbers. @@ -2862,6 +3409,7 @@ the APL language." "Compute the (least) fixpoint of FN with initial input LIST. FN is called at least once, results are compared with `equal'." + (declare (important-return-value t)) (let ((re (funcall fn list))) (while (not (equal list re)) (setq list re) @@ -2871,7 +3419,7 @@ FN is called at least once, results are compared with `equal'." (defmacro --fix (form list) "Anaphoric form of `-fix'." (declare (debug (def-form form))) - `(-fix (lambda (it) ,form) ,list)) + `(-fix (lambda (it) (ignore it) ,form) ,list)) (defun -unfold (fun seed) "Build a list from SEED using FUN. @@ -2880,9 +3428,10 @@ This is \"dual\" operation to `-reduce-r': while -reduce-r consumes a list to produce a single value, `-unfold' takes a seed value and builds a (potentially infinite!) list. -FUN should return `nil' to stop the generating process, or a +FUN should return nil to stop the generating process, or a cons (A . B), where A will be prepended to the result and B is the new seed." + (declare (important-return-value t)) (let ((last (funcall fun seed)) r) (while last (push (car last) r) @@ -2892,14 +3441,14 @@ the new seed." (defmacro --unfold (form seed) "Anaphoric version of `-unfold'." (declare (debug (def-form form))) - `(-unfold (lambda (it) ,form) ,seed)) + `(-unfold (lambda (it) (ignore it) ,form) ,seed)) (defun -cons-pair? (obj) "Return non-nil if OBJ is a true cons pair. That is, a cons (A . B) where B is not a list. Alias: `-cons-pair-p'." - (declare (pure t) (side-effect-free t)) + (declare (pure t) (side-effect-free error-free)) (nlistp (cdr-safe obj))) (defalias '-cons-pair-p '-cons-pair?) @@ -2917,9 +3466,7 @@ and `cdr' of the pair respectively. If the value is anything else, wrap it in a list." (declare (pure t) (side-effect-free t)) - (cond - ((-cons-pair? val) (-cons-to-list val)) - (t (list val)))) + (if (-cons-pair? val) (-cons-to-list val) (list val))) (defun -tree-mapreduce-from (fn folder init-value tree) "Apply FN to each element of TREE, and make a list of the results. @@ -2931,17 +3478,23 @@ INIT-VALUE. See `-reduce-r-from'. This is the same as calling `-tree-reduce-from' after `-tree-map' but is twice as fast as it only traverse the structure once." + (declare (important-return-value t)) (cond - ((not tree) nil) + ((null tree) ()) ((-cons-pair? tree) (funcall fn tree)) - ((listp tree) - (-reduce-r-from folder init-value (mapcar (lambda (x) (-tree-mapreduce-from fn folder init-value x)) tree))) - (t (funcall fn tree)))) + ((consp tree) + (-reduce-r-from + folder init-value + (mapcar (lambda (x) (-tree-mapreduce-from fn folder init-value x)) tree))) + ((funcall fn tree)))) (defmacro --tree-mapreduce-from (form folder init-value tree) "Anaphoric form of `-tree-mapreduce-from'." (declare (debug (def-form def-form form form))) - `(-tree-mapreduce-from (lambda (it) ,form) (lambda (it acc) ,folder) ,init-value ,tree)) + `(-tree-mapreduce-from (lambda (it) (ignore it) ,form) + (lambda (it acc) (ignore it acc) ,folder) + ,init-value + ,tree)) (defun -tree-mapreduce (fn folder tree) "Apply FN to each element of TREE, and make a list of the results. @@ -2953,31 +3506,35 @@ INIT-VALUE. See `-reduce-r-from'. This is the same as calling `-tree-reduce' after `-tree-map' but is twice as fast as it only traverse the structure once." + (declare (important-return-value t)) (cond - ((not tree) nil) + ((null tree) ()) ((-cons-pair? tree) (funcall fn tree)) - ((listp tree) + ((consp tree) (-reduce-r folder (mapcar (lambda (x) (-tree-mapreduce fn folder x)) tree))) - (t (funcall fn tree)))) + ((funcall fn tree)))) (defmacro --tree-mapreduce (form folder tree) "Anaphoric form of `-tree-mapreduce'." (declare (debug (def-form def-form form))) - `(-tree-mapreduce (lambda (it) ,form) (lambda (it acc) ,folder) ,tree)) + `(-tree-mapreduce (lambda (it) (ignore it) ,form) + (lambda (it acc) (ignore it acc) ,folder) + ,tree)) (defun -tree-map (fn tree) "Apply FN to each element of TREE while preserving the tree structure." + (declare (important-return-value t)) (cond - ((not tree) nil) + ((null tree) ()) ((-cons-pair? tree) (funcall fn tree)) - ((listp tree) + ((consp tree) (mapcar (lambda (x) (-tree-map fn x)) tree)) - (t (funcall fn tree)))) + ((funcall fn tree)))) (defmacro --tree-map (form tree) "Anaphoric form of `-tree-map'." (declare (debug (def-form form))) - `(-tree-map (lambda (it) ,form) ,tree)) + `(-tree-map (lambda (it) (ignore it) ,form) ,tree)) (defun -tree-reduce-from (fn init-value tree) "Use FN to reduce elements of list TREE. @@ -2988,17 +3545,21 @@ then on this result and second element from the list etc. The initial value is ignored on cons pairs as they always contain two elements." + (declare (important-return-value t)) (cond - ((not tree) nil) + ((null tree) ()) ((-cons-pair? tree) tree) - ((listp tree) - (-reduce-r-from fn init-value (mapcar (lambda (x) (-tree-reduce-from fn init-value x)) tree))) - (t tree))) + ((consp tree) + (-reduce-r-from + fn init-value + (mapcar (lambda (x) (-tree-reduce-from fn init-value x)) tree))) + (tree))) (defmacro --tree-reduce-from (form init-value tree) "Anaphoric form of `-tree-reduce-from'." (declare (debug (def-form form form))) - `(-tree-reduce-from (lambda (it acc) ,form) ,init-value ,tree)) + `(-tree-reduce-from (lambda (it acc) (ignore it acc) ,form) + ,init-value ,tree)) (defun -tree-reduce (fn tree) "Use FN to reduce elements of list TREE. @@ -3008,17 +3569,18 @@ FN is first applied to first element of the list and second element, then on this result and third element from the list etc. See `-reduce-r' for how exactly are lists of zero or one element handled." + (declare (important-return-value t)) (cond - ((not tree) nil) + ((null tree) ()) ((-cons-pair? tree) tree) - ((listp tree) + ((consp tree) (-reduce-r fn (mapcar (lambda (x) (-tree-reduce fn x)) tree))) - (t tree))) + (tree))) (defmacro --tree-reduce (form tree) "Anaphoric form of `-tree-reduce'." (declare (debug (def-form form))) - `(-tree-reduce (lambda (it acc) ,form) ,tree)) + `(-tree-reduce (lambda (it acc) (ignore it acc) ,form) ,tree)) (defun -tree-map-nodes (pred fun tree) "Call FUN on each node of TREE that satisfies PRED. @@ -3026,17 +3588,17 @@ See `-reduce-r' for how exactly are lists of zero or one element handled." If PRED returns nil, continue descending down this node. If PRED returns non-nil, apply FUN to this node and do not descend further." - (if (funcall pred tree) - (funcall fun tree) - (if (and (listp tree) - (not (-cons-pair? tree))) - (-map (lambda (x) (-tree-map-nodes pred fun x)) tree) - tree))) + (cond ((funcall pred tree) (funcall fun tree)) + ((and (listp tree) (listp (cdr tree))) + (-map (lambda (x) (-tree-map-nodes pred fun x)) tree)) + (tree))) (defmacro --tree-map-nodes (pred form tree) "Anaphoric form of `-tree-map-nodes'." (declare (debug (def-form def-form form))) - `(-tree-map-nodes (lambda (it) ,pred) (lambda (it) ,form) ,tree)) + `(-tree-map-nodes (lambda (it) (ignore it) ,pred) + (lambda (it) (ignore it) ,form) + ,tree)) (defun -tree-seq (branch children tree) "Return a sequence of the nodes in TREE, in depth-first search order. @@ -3048,15 +3610,18 @@ CHILDREN is a function of one argument that returns the children of the passed branch node. Non-branch nodes are simply copied." + (declare (important-return-value t)) (cons tree - (when (funcall branch tree) - (-mapcat (lambda (x) (-tree-seq branch children x)) - (funcall children tree))))) + (and (funcall branch tree) + (-mapcat (lambda (x) (-tree-seq branch children x)) + (funcall children tree))))) (defmacro --tree-seq (branch children tree) "Anaphoric form of `-tree-seq'." (declare (debug (def-form def-form form))) - `(-tree-seq (lambda (it) ,branch) (lambda (it) ,children) ,tree)) + `(-tree-seq (lambda (it) (ignore it) ,branch) + (lambda (it) (ignore it) ,children) + ,tree)) (defun -clone (list) "Create a deep copy of LIST. @@ -3064,7 +3629,7 @@ The new list has the same elements and structure but all cons are replaced with new ones. This is useful when you need to clone a structure such as plist or alist." (declare (pure t) (side-effect-free t)) - (-tree-map 'identity list)) + (-tree-map #'identity list)) ;;; Combinators @@ -3077,14 +3642,14 @@ is a new function which does the same as FN, except that the last N arguments are fixed at the values with which this function was called. This is like `-partial', except the arguments are fixed starting from the right rather than the left." - (declare (pure t) (side-effect-free t)) + (declare (pure t) (side-effect-free error-free)) (lambda (&rest args-before) (apply fn (append args-before args)))) (defun -juxt (&rest fns) "Return a function that is the juxtaposition of FNS. The returned function takes a variable number of ARGS, applies each of FNS in turn to ARGS, and returns the list of results." - (declare (pure t) (side-effect-free t)) + (declare (pure t) (side-effect-free error-free)) (lambda (&rest args) (mapcar (lambda (x) (apply x args)) fns))) (defun -compose (&rest fns) @@ -3094,7 +3659,7 @@ the last function in FNS to ARGS, and returns the result of calling each remaining function on the result of the previous function, right-to-left. If no FNS are given, return a variadic `identity' function." - (declare (pure t) (side-effect-free t)) + (declare (pure t) (side-effect-free error-free)) (let* ((fns (nreverse fns)) (head (car fns)) (tail (cdr fns))) @@ -3108,7 +3673,7 @@ function, right-to-left. If no FNS are given, return a variadic "Return a function that applies FN to a single list of args. This changes the arity of FN from taking N distinct arguments to taking 1 argument which is a list of N arguments." - (declare (pure t) (side-effect-free t)) + (declare (pure t) (side-effect-free error-free)) (lambda (args) (apply fn args))) (defun -on (op trans) @@ -3122,7 +3687,7 @@ equivalent: (funcall (-on #\\='+ #\\='1+) 1 2 3) = (+ (1+ 1) (1+ 2) (1+ 3)) (funcall (-on #\\='+ #\\='1+)) = (+)" - (declare (pure t) (side-effect-free t)) + (declare (pure t) (side-effect-free error-free)) (lambda (&rest args) ;; This unrolling seems to be a relatively cheap way to keep the ;; overhead of `mapcar' + `apply' in check. @@ -3144,7 +3709,7 @@ equivalent: (funcall (-flip #\\='-) 1 2) = (- 2 1) See also: `-rotate-args'." - (declare (pure t) (side-effect-free t)) + (declare (pure t) (side-effect-free error-free)) (lambda (&rest args) ;; Open-code for speed. (cond ((cddr args) (apply fn (nreverse args))) ((cdr args) (funcall fn (cadr args) (car args))) @@ -3177,7 +3742,7 @@ See also: `-flip'." "Return a function that returns C ignoring any additional arguments. In types: a -> b -> a" - (declare (pure t) (side-effect-free t)) + (declare (pure t) (side-effect-free error-free)) (lambda (&rest _) c)) (defmacro -cut (&rest params) @@ -3203,7 +3768,7 @@ The returned predicate passes its arguments to PRED. If PRED returns nil, the result is non-nil; otherwise the result is nil. See also: `-andfn' and `-orfn'." - (declare (pure t) (side-effect-free t)) + (declare (pure t) (side-effect-free error-free)) (lambda (&rest args) (not (apply pred args)))) (defun -orfn (&rest preds) @@ -3215,7 +3780,7 @@ the remaining PREDS. If all PREDS return nil, or if no PREDS are given, the returned predicate returns nil. See also: `-andfn' and `-not'." - (declare (pure t) (side-effect-free t)) + (declare (pure t) (side-effect-free error-free)) ;; Open-code for speed. (cond ((cdr preds) (lambda (&rest args) (--some (apply it args) preds))) (preds (car preds)) @@ -3230,7 +3795,7 @@ remaining PREDS. If all PREDS return non-nil, P returns the last such value. If no PREDS are given, P always returns non-nil. See also: `-orfn' and `-not'." - (declare (pure t) (side-effect-free t)) + (declare (pure t) (side-effect-free error-free)) ;; Open-code for speed. (cond ((cdr preds) (lambda (&rest args) (--every (apply it args) preds))) (preds (car preds)) @@ -3253,6 +3818,7 @@ In types: (a -> a) -> Int -> a -> a. This function satisfies the following law: (funcall (-iteratefn fn n) init) = (-last-item (-iterate fn init (1+ n)))." + (declare (pure t) (side-effect-free error-free)) (lambda (x) (--dotimes n (setq x (funcall fn x))) x)) (defun -counter (&optional beg end inc) @@ -3264,6 +3830,7 @@ defaults to 0, INC defaults to 1, and if END is nil, the counter will increment indefinitely. The closure accepts any number of arguments, which are discarded." + (declare (pure t) (side-effect-free error-free)) (let ((inc (or inc 1)) (n (or beg 0))) (lambda (&rest _) @@ -3301,6 +3868,7 @@ iteration halted before converging, a cons with car `halted' and cdr the final output from HALT-TEST. In types: (a -> a) -> a -> a." + (declare (important-return-value t)) (let ((eqfn (or equal-test 'equal)) (haltfn (or halt-test (-not @@ -3316,19 +3884,38 @@ In types: (a -> a) -> a -> a." re))))) (defun -prodfn (&rest fns) - "Take a list of n functions and return a function that takes a -list of length n, applying i-th function to i-th element of the -input list. Returns a list of length n. + "Return a function that applies each of FNS to each of a list of arguments. -In types (for n=2): ((a -> b), (c -> d)) -> (a, c) -> (b, d) +Takes a list of N functions and returns a function that takes a +list of length N, applying Ith function to Ith element of the +input list. Returns a list of length N. + +In types (for N=2): ((a -> b), (c -> d)) -> (a, c) -> (b, d) This function satisfies the following laws: - (-compose (-prodfn f g ...) (-prodfn f\\=' g\\=' ...)) = (-prodfn (-compose f f\\=') (-compose g g\\=') ...) - (-prodfn f g ...) = (-juxt (-compose f (-partial \\='nth 0)) (-compose g (-partial \\='nth 1)) ...) - (-compose (-prodfn f g ...) (-juxt f\\=' g\\=' ...)) = (-juxt (-compose f f\\=') (-compose g g\\=') ...) - (-compose (-partial \\='nth n) (-prod f1 f2 ...)) = (-compose fn (-partial \\='nth n))" - (lambda (x) (-zip-with 'funcall fns x))) + (-compose (-prodfn f g ...) + (-prodfn f\\=' g\\=' ...)) + = (-prodfn (-compose f f\\=') + (-compose g g\\=') + ...) + + (-prodfn f g ...) + = (-juxt (-compose f (-partial #\\='nth 0)) + (-compose g (-partial #\\='nth 1)) + ...) + + (-compose (-prodfn f g ...) + (-juxt f\\=' g\\=' ...)) + = (-juxt (-compose f f\\=') + (-compose g g\\=') + ...) + + (-compose (-partial #\\='nth n) + (-prod f1 f2 ...)) + = (-compose fn (-partial #\\='nth n))" + (declare (pure t) (side-effect-free t)) + (lambda (x) (--zip-with (funcall it other) fns x))) ;;; Font lock @@ -3350,18 +3937,26 @@ This function satisfies the following laws: (let ((macs '("!cdr" "!cons" "-->" + "--all-p" "--all?" "--annotate" + "--any" + "--any-p" "--any?" "--count" "--dotimes" "--doto" "--drop-while" "--each" + "--each-indexed" "--each-r" "--each-r-while" "--each-while" + "--every" + "--every-p" + "--every?" "--filter" + "--find" "--find-index" "--find-indices" "--find-last-index" @@ -3380,8 +3975,11 @@ This function satisfies the following laws: "--mapcat" "--max-by" "--min-by" + "--none-p" "--none?" + "--only-some-p" "--only-some?" + "--partition-after-pred" "--partition-by" "--partition-by-header" "--reduce" @@ -3392,11 +3990,18 @@ This function satisfies the following laws: "--reductions-from" "--reductions-r" "--reductions-r-from" + "--reject" + "--reject-first" + "--reject-last" "--remove" "--remove-first" "--remove-last" + "--replace-where" + "--select" "--separate" "--some" + "--some-p" + "--some?" "--sort" "--splice" "--splice-list" @@ -3417,6 +4022,7 @@ This function satisfies the following laws: "->" "->>" "-as->" + "-cut" "-doto" "-if-let" "-if-let*" @@ -3439,7 +4045,6 @@ Either a string to display in the mode line when `dash-fontify-mode' is on, or nil to display nothing (the default)." :package-version '(dash . "2.18.0") - :group 'dash :type '(choice (string :tag "Lighter" :value " Dash") (const :tag "Nothing" nil))) @@ -3456,7 +4061,7 @@ additionally fontifies Dash macro calls. See also `dash-fontify-mode-lighter' and `global-dash-fontify-mode'." - :group 'dash :lighter dash-fontify-mode-lighter + :lighter dash-fontify-mode-lighter (if dash-fontify-mode (font-lock-add-keywords nil dash--keywords t) (font-lock-remove-keywords nil dash--keywords)) @@ -3477,12 +4082,10 @@ See also `dash-fontify-mode-lighter' and ;;;###autoload (define-globalized-minor-mode global-dash-fontify-mode - dash-fontify-mode dash--turn-on-fontify-mode - :group 'dash) + dash-fontify-mode dash--turn-on-fontify-mode) (defcustom dash-enable-fontlock nil "If non-nil, fontify Dash macro calls and special variables." - :group 'dash :set (lambda (sym val) (set-default sym val) (global-dash-fontify-mode (if val 1 0))) diff --git a/elpa/dash-20210826.1149/dash.info b/elpa/dash-20230502.1324/dash.info similarity index 85% rename from elpa/dash-20210826.1149/dash.info rename to elpa/dash-20230502.1324/dash.info index a6a2dc60..a99d3237 100644 --- a/elpa/dash-20210826.1149/dash.info +++ b/elpa/dash-20230502.1324/dash.info @@ -2,7 +2,7 @@ This is dash.info, produced by makeinfo version 6.7 from dash.texi. This manual is for Dash version 2.19.1. - Copyright © 2012–2021 Free Software Foundation, Inc. + Copyright © 2012–2023 Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, @@ -24,7 +24,7 @@ Dash This manual is for Dash version 2.19.1. - Copyright © 2012–2021 Free Software Foundation, Inc. + Copyright © 2012–2023 Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, @@ -224,9 +224,9 @@ The results are collected in order and returned as a new list. ⇒ (1 4 9 16) -- Function: -map-when (pred rep list) - Return a new list where the elements in LIST that do not match the - PRED function are unchanged, and where the elements in LIST that do - match the PRED function are mapped through the REP function. + Use PRED to conditionally apply REP to each item in LIST. Return a + copy of LIST where the items for which PRED returns ‘nil’ are + unchanged, and the rest are mapped through the REP function. Alias: ‘-replace-where’ @@ -240,8 +240,9 @@ The results are collected in order and returned as a new list. ⇒ (1 17 3 4) -- Function: -map-first (pred rep list) - Replace first item in LIST satisfying PRED with result of REP - called on this item. + Use PRED to determine the first item in LIST to call REP on. + Return a copy of LIST where the first item for which PRED returns + non-‘nil’ is replaced with the result of calling REP on that item. See also: ‘-map-when’ (*note -map-when::), ‘-replace-first’ (*note -replace-first::) @@ -254,8 +255,9 @@ The results are collected in order and returned as a new list. ⇒ (1 17 3 2) -- Function: -map-last (pred rep list) - Replace last item in LIST satisfying PRED with result of REP called - on this item. + Use PRED to determine the last item in LIST to call REP on. Return + a copy of LIST where the last item for which PRED returns non-‘nil’ + is replaced with the result of calling REP on that item. See also: ‘-map-when’ (*note -map-when::), ‘-replace-last’ (*note -replace-last::) @@ -286,35 +288,45 @@ The results are collected in order and returned as a new list. ⇒ (0 2 6 12) -- Function: -annotate (fn list) - Return a list of cons cells where each cell is FN applied to each - element of LIST paired with the unmodified element of LIST. + Pair each item in LIST with the result of passing it to FN. - (-annotate '1+ '(1 2 3)) + Return an alist of (RESULT . ITEM), where each ITEM is the + corresponding element of LIST, and RESULT is the value obtained by + calling FN on ITEM. + + This function’s anaphoric counterpart is ‘--annotate’. + + (-annotate #'1+ '(1 2 3)) ⇒ ((2 . 1) (3 . 2) (4 . 3)) - (-annotate 'length '(("h" "e" "l" "l" "o") ("hello" "world"))) - ⇒ ((5 "h" "e" "l" "l" "o") (2 "hello" "world")) - (--annotate (< 1 it) '(0 1 2 3)) + (-annotate #'length '((f o o) (bar baz))) + ⇒ ((3 f o o) (2 bar baz)) + (--annotate (> it 1) '(0 1 2 3)) ⇒ ((nil . 0) (nil . 1) (t . 2) (t . 3)) -- Function: -splice (pred fun list) - Splice lists generated by FUN in place of elements matching PRED in + Splice lists generated by FUN in place of items satisfying PRED in LIST. - FUN takes the element matching PRED as input. + Call PRED on each element of LIST. Whenever the result of PRED is + ‘nil’, leave that ‘it’ as-is. Otherwise, call FUN on the same ‘it’ + that satisfied PRED. The result should be a (possibly empty) list + of items to splice in place of ‘it’ in LIST. + + This can be useful as an alternative to the ‘,@’ construct in a ‘`’ + structure, in case you need to splice several lists at marked + positions (for example with keywords). - This function can be used as replacement for ‘,@’ in case you need - to splice several lists at marked positions (for example with - keywords). + This function’s anaphoric counterpart is ‘--splice’. See also: ‘-splice-list’ (*note -splice-list::), ‘-insert-at’ - (*note -insert-at::) + (*note -insert-at::). - (-splice 'even? (lambda (x) (list x x)) '(1 2 3 4)) - ⇒ (1 2 2 3 4 4) - (--splice 't (list it it) '(1 2 3 4)) + (-splice #'numberp (lambda (n) (list n n)) '(a 1 b 2)) + ⇒ (a 1 1 b 2 2) + (--splice t (list it it) '(1 2 3 4)) ⇒ (1 1 2 2 3 3 4 4) - (--splice (equal it :magic) '((list of) (magical) (code)) '((foo) (bar) :magic (baz))) - ⇒ ((foo) (bar) (list of) (magical) (code) (baz)) + (--splice (eq it :magic) '((magical) (code)) '((foo) :magic (bar))) + ⇒ ((foo) (magical) (code) (bar)) -- Function: -splice-list (pred new-list list) Splice NEW-LIST in place of elements matching PRED in LIST. @@ -358,7 +370,7 @@ Functions returning a sublist of the original list. -- Function: -filter (pred list) Return a new list of the items in LIST for which PRED returns - non-nil. + non-‘nil’. Alias: ‘-select’. @@ -375,7 +387,8 @@ Functions returning a sublist of the original list. ⇒ (2 4) -- Function: -remove (pred list) - Return a new list of the items in LIST for which PRED returns nil. + Return a new list of the items in LIST for which PRED returns + ‘nil’. Alias: ‘-reject’. @@ -392,7 +405,7 @@ Functions returning a sublist of the original list. ⇒ (1 3) -- Function: -remove-first (pred list) - Remove the first item from LIST for which PRED returns non-nil. + Remove the first item from LIST for which PRED returns non-‘nil’. This is a non-destructive operation, but only the front of LIST leading up to the removed item is a copy; the rest is LIST’s original tail. If no item is removed, then the result is a @@ -413,8 +426,8 @@ Functions returning a sublist of the original list. ⇒ (1 2 3 5 6) -- Function: -remove-last (pred list) - Remove the last item from LIST for which PRED returns non-nil. The - result is a copy of LIST regardless of whether an element is + Remove the last item from LIST for which PRED returns non-‘nil’. + The result is a copy of LIST regardless of whether an element is removed. Alias: ‘-reject-last’. @@ -443,7 +456,7 @@ Functions returning a sublist of the original list. ⇒ ("alice" "eve") -- Function: -non-nil (list) - Return a copy of LIST with all nil items removed. + Return a copy of LIST with all ‘nil’ items removed. (-non-nil '(nil 1 nil 2 nil nil 3 4 nil 5 nil)) ⇒ (1 2 3 4 5) @@ -470,7 +483,8 @@ Functions returning a sublist of the original list. -- Function: -take (n list) Return a copy of the first N items in LIST. Return a copy of LIST - if it contains N items or fewer. Return nil if N is zero or less. + if it contains N items or fewer. Return ‘nil’ if N is zero or + less. See also: ‘-take-last’ (*note -take-last::). @@ -483,7 +497,7 @@ Functions returning a sublist of the original list. -- Function: -take-last (n list) Return a copy of the last N items of LIST in order. Return a copy - of LIST if it contains N items or fewer. Return nil if N is zero + of LIST if it contains N items or fewer. Return ‘nil’ if N is zero or less. See also: ‘-take’ (*note -take::). @@ -497,8 +511,8 @@ Functions returning a sublist of the original list. -- Function: -drop (n list) Return the tail (not a copy) of LIST without the first N items. - Return nil if LIST contains N items or fewer. Return LIST if N is - zero or less. + Return ‘nil’ if LIST contains N items or fewer. Return LIST if N + is zero or less. For another variant, see also ‘-drop-last’ (*note -drop-last::). @@ -511,8 +525,8 @@ Functions returning a sublist of the original list. -- Function: -drop-last (n list) Return a copy of LIST without its last N items. Return a copy of - LIST if N is zero or less. Return nil if LIST contains N items or - fewer. + LIST if N is zero or less. Return ‘nil’ if LIST contains N items + or fewer. See also: ‘-drop’ (*note -drop::). @@ -524,10 +538,10 @@ Functions returning a sublist of the original list. ⇒ (1 2 3 4 5) -- Function: -take-while (pred list) - Take successive items from LIST for which PRED returns non-nil. + Take successive items from LIST for which PRED returns non-‘nil’. PRED is a function of one argument. Return a new list of the successive elements from the start of LIST for which PRED returns - non-nil. + non-‘nil’. This function’s anaphoric counterpart is ‘--take-while’. @@ -541,9 +555,10 @@ Functions returning a sublist of the original list. ⇒ (1 2 3) -- Function: -drop-while (pred list) - Drop successive items from LIST for which PRED returns non-nil. + Drop successive items from LIST for which PRED returns non-‘nil’. PRED is a function of one argument. Return the tail (not a copy) - of LIST starting from its first element for which PRED returns nil. + of LIST starting from its first element for which PRED returns + ‘nil’. This function’s anaphoric counterpart is ‘--drop-while’. @@ -609,9 +624,9 @@ File: dash.info, Node: List to list, Next: Reductions, Prev: Sublist selectio Functions returning a modified copy of the input list. -- Function: -keep (fn list) - Return a new list of the non-nil results of applying FN to each + Return a new list of the non-‘nil’ results of applying FN to each item in LIST. Like ‘-filter’ (*note -filter::), but returns the - non-nil results of FN instead of the corresponding elements of + non-‘nil’ results of FN instead of the corresponding elements of LIST. Its anaphoric counterpart is ‘--keep’. @@ -623,9 +638,13 @@ Functions returning a modified copy of the input list. (--keep (and (> it 3) (* 10 it)) '(1 2 3 4 5 6)) ⇒ (40 50 60) - -- Function: -concat (&rest lists) - Return a new list with the concatenation of the elements in the - supplied LISTS. + -- Function: -concat (&rest sequences) + Concatenate all the arguments and make the result a list. The + result is a list whose elements are the elements of all the + arguments. Each argument may be a list, vector or string. + + All arguments except the last argument are copied. The last + argument is just used as the tail of the new list. (-concat '(1)) ⇒ (1) @@ -639,7 +658,7 @@ Functions returning a modified copy of the input list. list. Note that because ‘nil’ represents a list of zero elements (an - empty list), any mention of nil in L will disappear after + empty list), any mention of ‘nil’ in L will disappear after flattening. If you need to preserve nils, consider ‘-flatten-n’ (*note -flatten-n::) or map them to some unique symbol and then map them back. @@ -734,8 +753,9 @@ Functions returning a modified copy of the input list. ⇒ (0 1 2 3 9 5) -- Function: -update-at (n func list) - Return a list with element at Nth position in LIST replaced with - ‘(func (nth n list))‘. + Use FUNC to update the Nth element of LIST. Return a copy of LIST + where the Nth element is replaced with the result of calling FUNC + on it. See also: ‘-map-when’ (*note -map-when::) @@ -747,31 +767,42 @@ Functions returning a modified copy of the input list. ⇒ ("foo" "bar" 3 "quux") -- Function: -remove-at (n list) - Return a list with element at Nth position in LIST removed. + Return LIST with its element at index N removed. That is, remove + any element selected as (nth N LIST) from LIST and return the + result. + + This is a non-destructive operation: parts of LIST (but not + necessarily all of it) are copied as needed to avoid destructively + modifying it. See also: ‘-remove-at-indices’ (*note -remove-at-indices::), - ‘-remove’ (*note -remove::) + ‘-remove’ (*note -remove::). - (-remove-at 0 '("0" "1" "2" "3" "4" "5")) - ⇒ ("1" "2" "3" "4" "5") - (-remove-at 1 '("0" "1" "2" "3" "4" "5")) - ⇒ ("0" "2" "3" "4" "5") - (-remove-at 2 '("0" "1" "2" "3" "4" "5")) - ⇒ ("0" "1" "3" "4" "5") + (-remove-at 0 '(a b c)) + ⇒ (b c) + (-remove-at 1 '(a b c)) + ⇒ (a c) + (-remove-at 2 '(a b c)) + ⇒ (a b) -- Function: -remove-at-indices (indices list) - Return a list whose elements are elements from LIST without - elements selected as ‘(nth i list)‘ for all i from INDICES. + Return LIST with its elements at INDICES removed. That is, for + each index I in INDICES, remove any element selected as (nth I + LIST) from LIST. + + This is a non-destructive operation: parts of LIST (but not + necessarily all of it) are copied as needed to avoid destructively + modifying it. See also: ‘-remove-at’ (*note -remove-at::), ‘-remove’ (*note - -remove::) + -remove::). - (-remove-at-indices '(0) '("0" "1" "2" "3" "4" "5")) - ⇒ ("1" "2" "3" "4" "5") - (-remove-at-indices '(0 2 4) '("0" "1" "2" "3" "4" "5")) - ⇒ ("1" "3" "5") - (-remove-at-indices '(0 5) '("0" "1" "2" "3" "4" "5")) - ⇒ ("1" "2" "3" "4") + (-remove-at-indices '(0) '(a b c d e)) + ⇒ (b c d e) + (-remove-at-indices '(1 3) '(a b c d e)) + ⇒ (a c e) + (-remove-at-indices '(4 0 2) '(a b c d e)) + ⇒ (b d)  File: dash.info, Node: Reductions, Next: Unfolding, Prev: List to list, Up: Functions @@ -946,7 +977,7 @@ Functions reducing lists to a single value (which may also be a list). ⇒ ("(FN 1 (FN 2 3))" "(FN 2 3)" 3) -- Function: -count (pred list) - Counts the number of items in LIST where (PRED item) is non-nil. + Counts the number of items in LIST where (PRED item) is non-‘nil’. (-count 'even? '(1 2 3 4 5)) ⇒ 2 @@ -1006,7 +1037,7 @@ Functions reducing lists to a single value (which may also be a list). ⇒ (nil (1)) -- Function: -tails (list) - Return all suffixes of LIST + Return all suffixes of LIST. (-tails '(1 2 3 4)) ⇒ ((1 2 3 4) (2 3 4) (3 4) (4) nil) @@ -1083,6 +1114,25 @@ Functions reducing lists to a single value (which may also be a list). (--max-by (> (length it) (length other)) '((1 2 3) (2) (3 2))) ⇒ (1 2 3) + -- Function: -frequencies (list) + Count the occurrences of each distinct element of LIST. + + Return an alist of (ELEMENT . N), where each ELEMENT occurs N + times in LIST. + + The test for equality is done with ‘equal’, or with ‘-compare-fn’ + if that is non-‘nil’. + + See also ‘-count’ (*note -count::) and ‘-group-by’ (*note + -group-by::). + + (-frequencies ()) + ⇒ () + (-frequencies '(1 2 3 1 2 1)) + ⇒ ((1 . 3) (2 . 2) (3 . 1)) + (let ((-compare-fn #'string=)) (-frequencies '(a "a"))) + ⇒ ((a . 2)) +  File: dash.info, Node: Unfolding, Next: Predicates, Prev: Reductions, Up: Functions @@ -1127,6 +1177,28 @@ than consuming a list to produce a single value. (--unfold (when it (cons it (butlast it))) '(1 2 3 4)) ⇒ ((1 2 3 4) (1 2 3) (1 2) (1)) + -- Function: -repeat (n x) + Return a new list of length N with each element being X. Return + ‘nil’ if N is less than 1. + + (-repeat 3 :a) + ⇒ (:a :a :a) + (-repeat 1 :a) + ⇒ (:a) + (-repeat 0 :a) + ⇒ () + + -- Function: -cycle (list) + Return an infinite circular copy of LIST. The returned list cycles + through the elements of LIST and repeats from the beginning. + + (-take 5 (-cycle '(1 2 3))) + ⇒ (1 2 3 1 2) + (-take 7 (-cycle '(1 "and" 3))) + ⇒ (1 "and" 3 1 "and" 3 1) + (-zip-lists (-cycle '(3)) '(1 2)) + ⇒ ((3 1) (3 2)) +  File: dash.info, Node: Predicates, Next: Partitioning, Prev: Unfolding, Up: Functions @@ -1136,8 +1208,8 @@ File: dash.info, Node: Predicates, Next: Partitioning, Prev: Unfolding, Up: Reductions of one or more lists to a boolean value. -- Function: -some (pred list) - Return (PRED x) for the first LIST item where (PRED x) is non-nil, - else nil. + Return (PRED x) for the first LIST item where (PRED x) is + non-‘nil’, else ‘nil’. Alias: ‘-any’. @@ -1151,13 +1223,13 @@ Reductions of one or more lists to a boolean value. ⇒ nil -- Function: -every (pred list) - Return non-nil if PRED returns non-nil for all items in LIST. If - so, return the last such result of PRED. Otherwise, once an item - is reached for which PRED returns nil, return nil without calling - PRED on any further LIST elements. + Return non-‘nil’ if PRED returns non-‘nil’ for all items in LIST. + If so, return the last such result of PRED. Otherwise, once an + item is reached for which PRED returns ‘nil’, return ‘nil’ without + calling PRED on any further LIST elements. This function is like ‘-every-p’, but on success returns the last - non-nil result of PRED instead of just t. + non-‘nil’ result of PRED instead of just ‘t’. This function’s anaphoric counterpart is ‘--every’. @@ -1169,7 +1241,7 @@ Reductions of one or more lists to a boolean value. ⇒ nil -- Function: -any? (pred list) - Return t if (PRED x) is non-nil for any x in LIST, else nil. + Return ‘t’ if (PRED X) is non-‘nil’ for any X in LIST, else ‘nil’. Alias: ‘-any-p’, ‘-some?’, ‘-some-p’ @@ -1181,13 +1253,13 @@ Reductions of one or more lists to a boolean value. ⇒ nil -- Function: -all? (pred list) - Return t if (PRED X) is non-nil for all X in LIST, else nil. In - the latter case, stop after the first X for which (PRED X) is nil, - without calling PRED on any subsequent elements of LIST. + Return ‘t’ if (PRED X) is non-‘nil’ for all X in LIST, else ‘nil’. + In the latter case, stop after the first X for which (PRED X) is + ‘nil’, without calling PRED on any subsequent elements of LIST. The similar function ‘-every’ (*note -every::) is more widely - useful, since it returns the last non-nil result of PRED instead of - just t on success. + useful, since it returns the last non-‘nil’ result of PRED instead + of just ‘t’ on success. Alias: ‘-all-p’, ‘-every-p’, ‘-every?’. @@ -1201,7 +1273,7 @@ Reductions of one or more lists to a boolean value. ⇒ t -- Function: -none? (pred list) - Return t if (PRED x) is nil for all x in LIST, else nil. + Return ‘t’ if (PRED X) is ‘nil’ for all X in LIST, else ‘nil’. Alias: ‘-none-p’ @@ -1213,10 +1285,10 @@ Reductions of one or more lists to a boolean value. ⇒ nil -- Function: -only-some? (pred list) - Return ‘t‘ if at least one item of LIST matches PRED and at least - one item of LIST does not match PRED. Return ‘nil‘ both if all - items match the predicate or if none of the items match the - predicate. + Return ‘t’ if different LIST items both satisfy and do not satisfy + PRED. That is, if PRED returns both ‘nil’ for at least one item, + and non-‘nil’ for at least one other item in LIST. Return ‘nil’ if + all items satisfy the predicate or none of them do. Alias: ‘-only-some-p’ @@ -1228,36 +1300,23 @@ Reductions of one or more lists to a boolean value. ⇒ nil -- Function: -contains? (list element) - Return non-nil if LIST contains ELEMENT. + Return non-‘nil’ if LIST contains ELEMENT. The test for equality is done with ‘equal’, or with ‘-compare-fn’ - if that’s non-nil. + if that is non-‘nil’. As with ‘member’, the return value is + actually the tail of LIST whose car is ELEMENT. - Alias: ‘-contains-p’ + Alias: ‘-contains-p’. (-contains? '(1 2 3) 1) - ⇒ t + ⇒ (1 2 3) (-contains? '(1 2 3) 2) - ⇒ t + ⇒ (2 3) (-contains? '(1 2 3) 4) - ⇒ nil - - -- Function: -same-items? (list list2) - Return true if LIST and LIST2 has the same items. - - The order of the elements in the lists does not matter. - - Alias: ‘-same-items-p’ - - (-same-items? '(1 2 3) '(1 2 3)) - ⇒ t - (-same-items? '(1 2 3) '(3 2 1)) - ⇒ t - (-same-items? '(1 2 3) '(1 2 3 4)) - ⇒ nil + ⇒ () -- Function: -is-prefix? (prefix list) - Return non-nil if PREFIX is a prefix of LIST. + Return non-‘nil’ if PREFIX is a prefix of LIST. Alias: ‘-is-prefix-p’. @@ -1269,7 +1328,7 @@ Reductions of one or more lists to a boolean value. ⇒ nil -- Function: -is-suffix? (suffix list) - Return non-nil if SUFFIX is a suffix of LIST. + Return non-‘nil’ if SUFFIX is a suffix of LIST. Alias: ‘-is-suffix-p’. @@ -1281,7 +1340,7 @@ Reductions of one or more lists to a boolean value. ⇒ nil -- Function: -is-infix? (infix list) - Return non-nil if INFIX is infix of LIST. + Return non-‘nil’ if INFIX is infix of LIST. This operation runs in O(n^2) time @@ -1295,7 +1354,7 @@ Reductions of one or more lists to a boolean value. ⇒ t -- Function: -cons-pair? (obj) - Return non-nil if OBJ is a true cons pair. That is, a cons (A . + Return non-‘nil’ if OBJ is a true cons pair. That is, a cons (A . B) where B is not a list. Alias: ‘-cons-pair-p’. @@ -1331,8 +1390,14 @@ Functions partitioning the input list into a list of lists. ⇒ (nil (1 2 3 4 5)) -- Function: -split-with (pred list) - Return a list of ((-take-while PRED LIST) (-drop-while PRED LIST)), - in no more than one pass through the list. + Split LIST into a prefix satisfying PRED, and the rest. The first + sublist is the prefix of LIST with successive elements satisfying + PRED, and the second sublist is the remaining elements that do not. + The result is like performing + + ((-take-while PRED LIST) (-drop-while PRED LIST)) + + but in no more than a single pass through LIST. (-split-with 'even? '(1 2 3 4)) ⇒ (nil (1 2 3 4)) @@ -1360,7 +1425,7 @@ Functions partitioning the input list into a list of lists. ⇒ (("a" "b") ("d" "e")) -- Function: -split-when (fn list) - Split the LIST on each element where FN returns non-nil. + Split the LIST on each element where FN returns non-‘nil’. Unlike ‘-partition-by’ (*note -partition-by::), the "matched" element is discarded from the results. Empty lists are also @@ -1377,8 +1442,12 @@ Functions partitioning the input list into a list of lists. ⇒ ((a b) (c d) (args)) -- Function: -separate (pred list) - Return a list of ((-filter PRED LIST) (-remove PRED LIST)), in one - pass through the list. + Split LIST into two sublists based on whether items satisfy PRED. + The result is like performing + + ((-filter PRED LIST) (-remove PRED LIST)) + + but in a single pass through LIST. (-separate (lambda (num) (= 0 (% num 2))) '(1 2 3 4 5 6 7)) ⇒ ((2 4 6) (1 3 5 7)) @@ -1411,9 +1480,10 @@ Functions partitioning the input list into a list of lists. ⇒ ((1 2 3) (4 5 6) (7)) -- Function: -partition-in-steps (n step list) - Return a new list with the items in LIST grouped into N-sized - sublists at offsets STEP apart. If there are not enough items to - make the last group N-sized, those items are discarded. + Partition LIST into sublists of length N that are STEP items apart. + Like ‘-partition-all-in-steps’ (*note -partition-all-in-steps::), + but if there are not enough items to make the last group N-sized, + those items are discarded. (-partition-in-steps 2 1 '(1 2 3 4)) ⇒ ((1 2) (2 3) (3 4)) @@ -1423,9 +1493,9 @@ Functions partitioning the input list into a list of lists. ⇒ ((1 2 3) (3 4 5)) -- Function: -partition-all-in-steps (n step list) - Return a new list with the items in LIST grouped into N-sized - sublists at offsets STEP apart. The last groups may contain less - than N items. + Partition LIST into sublists of length N that are STEP items apart. + Adjacent groups may overlap if N exceeds the STEP stride. Trailing + groups may contain less than N items. (-partition-all-in-steps 2 1 '(1 2 3 4)) ⇒ ((1 2) (2 3) (3 4) (4)) @@ -1459,7 +1529,7 @@ Functions partitioning the input list into a list of lists. ⇒ ((2 1 1 1) (4 1 3 5) (6 6 1)) -- Function: -partition-after-pred (pred list) - Partition LIST after each element for which PRED returns non-nil. + Partition LIST after each element for which PRED returns non-‘nil’. This function’s anaphoric counterpart is ‘--partition-after-pred’. @@ -1522,66 +1592,88 @@ Functions retrieving or sorting based on list indices and related predicates. -- Function: -elem-index (elem list) - Return the index of the first element in the given LIST which is - equal to the query element ELEM, or nil if there is no such - element. + Return the first index of ELEM in LIST. That is, the index within + LIST of the first element that is ‘equal’ to ELEM. Return ‘nil’ if + there is no such element. - (-elem-index 2 '(6 7 8 2 3 4)) - ⇒ 3 + See also: ‘-find-index’ (*note -find-index::). + + (-elem-index 2 '(6 7 8 3 4)) + ⇒ nil (-elem-index "bar" '("foo" "bar" "baz")) ⇒ 1 (-elem-index '(1 2) '((3) (5 6) (1 2) nil)) ⇒ 2 -- Function: -elem-indices (elem list) - Return the indices of all elements in LIST equal to the query - element ELEM, in ascending order. + Return the list of indices at which ELEM appears in LIST. That is, + the indices of all elements of LIST ‘equal’ to ELEM, in the same + ascending order as they appear in LIST. - (-elem-indices 2 '(6 7 8 2 3 4 2 1)) - ⇒ (3 6) + (-elem-indices 2 '(6 7 8 3 4 1)) + ⇒ () (-elem-indices "bar" '("foo" "bar" "baz")) ⇒ (1) (-elem-indices '(1 2) '((3) (1 2) (5 6) (1 2) nil)) ⇒ (1 3) -- Function: -find-index (pred list) - Take a predicate PRED and a LIST and return the index of the first - element in the list satisfying the predicate, or nil if there is no - such element. + Return the index of the first item satisfying PRED in LIST. Return + ‘nil’ if no such item is found. + + PRED is called with one argument, the current list element, until + it returns non-‘nil’, at which point the search terminates. - See also ‘-first’ (*note -first::). + This function’s anaphoric counterpart is ‘--find-index’. - (-find-index 'even? '(2 4 1 6 3 3 5 8)) + See also: ‘-first’ (*note -first::), ‘-find-last-index’ (*note + -find-last-index::). + + (-find-index #'numberp '(a b c)) + ⇒ nil + (-find-index #'natnump '(1 0 -1)) ⇒ 0 - (--find-index (< 5 it) '(2 4 1 6 3 3 5 8)) + (--find-index (> it 5) '(2 4 1 6 3 3 5 8)) ⇒ 3 - (-find-index (-partial 'string-lessp "baz") '("bar" "foo" "baz")) - ⇒ 1 -- Function: -find-last-index (pred list) - Take a predicate PRED and a LIST and return the index of the last - element in the list satisfying the predicate, or nil if there is no - such element. + Return the index of the last item satisfying PRED in LIST. Return + ‘nil’ if no such item is found. - See also ‘-last’ (*note -last::). + Predicate PRED is called with one argument each time, namely the + current list element. - (-find-last-index 'even? '(2 4 1 6 3 3 5 8)) - ⇒ 7 - (--find-last-index (< 5 it) '(2 7 1 6 3 8 5 2)) + This function’s anaphoric counterpart is ‘--find-last-index’. + + See also: ‘-last’ (*note -last::), ‘-find-index’ (*note + -find-index::). + + (-find-last-index #'numberp '(a b c)) + ⇒ nil + (--find-last-index (> it 5) '(2 7 1 6 3 8 5 2)) ⇒ 5 - (-find-last-index (-partial 'string-lessp "baz") '("q" "foo" "baz")) + (-find-last-index (-partial #'string< 'a) '(c b a)) ⇒ 1 -- Function: -find-indices (pred list) - Return the indices of all elements in LIST satisfying the predicate - PRED, in ascending order. + Return the list of indices in LIST satisfying PRED. + + Each element of LIST in turn is passed to PRED. If the result is + non-‘nil’, the index of that element in LIST is included in the + result. The returned indices are in ascending order, i.e., in the + same order as they appear in LIST. - (-find-indices 'even? '(2 4 1 6 3 3 5 8)) + This function’s anaphoric counterpart is ‘--find-indices’. + + See also: ‘-find-index’ (*note -find-index::), ‘-elem-indices’ + (*note -elem-indices::). + + (-find-indices #'numberp '(a b c)) + ⇒ () + (-find-indices #'numberp '(8 1 d 2 b c a 3)) ⇒ (0 1 3 7) - (--find-indices (< 5 it) '(2 4 1 6 3 3 5 8)) + (--find-indices (> it 5) '(2 4 1 6 3 3 5 8)) ⇒ (3 7) - (-find-indices (-partial 'string-lessp "baz") '("bar" "foo" "baz")) - ⇒ (1) -- Function: -grade-up (comparator list) Grade elements of LIST using COMPARATOR relation. This yields a @@ -1611,22 +1703,26 @@ File: dash.info, Node: Set operations, Next: Other list operations, Prev: Ind Operations pretending lists are sets. - -- Function: -union (list list2) - Return a new list containing the elements of LIST and elements of - LIST2 that are not in LIST. The test for equality is done with - ‘equal’, or with ‘-compare-fn’ if that’s non-nil. + -- Function: -union (list1 list2) + Return a new list of distinct elements appearing in either LIST1 or + LIST2. + + The test for equality is done with ‘equal’, or with ‘-compare-fn’ + if that is non-‘nil’. (-union '(1 2 3) '(3 4 5)) ⇒ (1 2 3 4 5) - (-union '(1 2 3 4) ()) - ⇒ (1 2 3 4) - (-union '(1 1 2 2) '(3 2 1)) - ⇒ (1 1 2 2 3) + (-union '(1 2 2 4) ()) + ⇒ (1 2 4) + (-union '(1 1 2 2) '(4 4 3 2 1)) + ⇒ (1 2 4 3) - -- Function: -difference (list list2) - Return a new list with only the members of LIST that are not in - LIST2. The test for equality is done with ‘equal’, or with - ‘-compare-fn’ if that’s non-nil. + -- Function: -difference (list1 list2) + Return a new list with the distinct members of LIST1 that are not + in LIST2. + + The test for equality is done with ‘equal’, or with ‘-compare-fn’ + if that is non-‘nil’. (-difference () ()) ⇒ () @@ -1635,50 +1731,76 @@ Operations pretending lists are sets. (-difference '(1 2 3 4) '(3 4 5 6)) ⇒ (1 2) - -- Function: -intersection (list list2) - Return a new list containing only the elements that are members of - both LIST and LIST2. The test for equality is done with ‘equal’, - or with ‘-compare-fn’ if that’s non-nil. + -- Function: -intersection (list1 list2) + Return a new list of distinct elements appearing in both LIST1 and + LIST2. + + The test for equality is done with ‘equal’, or with ‘-compare-fn’ + if that is non-‘nil’. (-intersection () ()) ⇒ () (-intersection '(1 2 3) '(4 5 6)) ⇒ () - (-intersection '(1 2 3 4) '(3 4 5 6)) - ⇒ (3 4) + (-intersection '(1 2 2 3) '(4 3 3 2)) + ⇒ (2 3) -- Function: -powerset (list) Return the power set of LIST. (-powerset ()) ⇒ (nil) + (-powerset '(x y)) + ⇒ ((x y) (x) (y) nil) (-powerset '(x y z)) ⇒ ((x y z) (x y) (x z) (x) (y z) (y) (z) nil) -- Function: -permutations (list) - Return the permutations of LIST. + Return the distinct permutations of LIST. + + Duplicate elements of LIST are determined by ‘equal’, or by + ‘-compare-fn’ if that is non-‘nil’. (-permutations ()) ⇒ (nil) - (-permutations '(1 2)) - ⇒ ((1 2) (2 1)) + (-permutations '(a a b)) + ⇒ ((a a b) (a b a) (b a a)) (-permutations '(a b c)) ⇒ ((a b c) (a c b) (b a c) (b c a) (c a b) (c b a)) -- Function: -distinct (list) - Return a new list with all duplicates removed. The test for - equality is done with ‘equal’, or with ‘-compare-fn’ if that’s - non-nil. + Return a copy of LIST with all duplicate elements removed. - Alias: ‘-uniq’ + The test for equality is done with ‘equal’, or with ‘-compare-fn’ + if that is non-‘nil’. + + Alias: ‘-uniq’. (-distinct ()) ⇒ () - (-distinct '(1 2 2 4)) - ⇒ (1 2 4) + (-distinct '(1 1 2 3 3)) + ⇒ (1 2 3) (-distinct '(t t t)) ⇒ (t) + -- Function: -same-items? (list1 list2) + Return non-‘nil’ if LIST1 and LIST2 have the same distinct + elements. + + The order of the elements in the lists does not matter. The lists + may be of different lengths, i.e., contain duplicate elements. The + test for equality is done with ‘equal’, or with ‘-compare-fn’ if + that is non-‘nil’. + + Alias: ‘-same-items-p’. + + (-same-items? '(1 2 3) '(1 2 3)) + ⇒ t + (-same-items? '(1 1 2 3) '(3 3 2 1)) + ⇒ t + (-same-items? '(1 2 3) '(1 2 3 4)) + ⇒ nil +  File: dash.info, Node: Other list operations, Next: Tree operations, Prev: Set operations, Up: Functions @@ -1698,22 +1820,11 @@ Other list functions not fit to be classified elsewhere. (-rotate 16 '(1 2 3 4 5 6 7)) ⇒ (6 7 1 2 3 4 5) - -- Function: -repeat (n x) - Return a new list of length N with each element being X. Return - nil if N is less than 1. - - (-repeat 3 :a) - ⇒ (:a :a :a) - (-repeat 1 :a) - ⇒ (:a) - (-repeat 0 :a) - ⇒ nil - -- Function: -cons* (&rest args) Make a new list from the elements of ARGS. The last 2 elements of ARGS are used as the final cons of the result, so if the final element of ARGS is not a list, the result is a dotted list. With - no ARGS, return nil. + no ARGS, return ‘nil’. (-cons* 1 2) ⇒ (1 . 2) @@ -1727,7 +1838,7 @@ Other list functions not fit to be classified elsewhere. This is like ‘cons’, but operates on the end of list. - If ELEMENTS is non nil, append these to the list as well. + If any ELEMENTS are given, append them to the list as well. (-snoc '(1 2 3) 4) ⇒ (1 2 3 4) @@ -1771,56 +1882,52 @@ Other list functions not fit to be classified elsewhere. error→ Wrong type argument: natnump, -1 -- Function: -zip-with (fn list1 list2) - Zip the two lists LIST1 and LIST2 using a function FN. This - function is applied pairwise taking as first argument element of - LIST1 and as second argument element of LIST2 at corresponding - position. - - The anaphoric form ‘--zip-with’ binds the elements from LIST1 as - symbol ‘it’, and the elements from LIST2 as symbol ‘other’. + Zip LIST1 and LIST2 into a new list using the function FN. That + is, apply FN pairwise taking as first argument the next element of + LIST1 and as second argument the next element of LIST2 at the + corresponding position. The result is as long as the shorter list. - (-zip-with '+ '(1 2 3) '(4 5 6)) - ⇒ (5 7 9) - (-zip-with 'cons '(1 2 3) '(4 5 6)) - ⇒ ((1 . 4) (2 . 5) (3 . 6)) - (--zip-with (concat it " and " other) '("Batman" "Jekyll") '("Robin" "Hyde")) - ⇒ ("Batman and Robin" "Jekyll and Hyde") + This function’s anaphoric counterpart is ‘--zip-with’. - -- Function: -zip (&rest lists) - Zip LISTS together. Group the head of each list, followed by the - second elements of each list, and so on. The lengths of the - returned groupings are equal to the length of the shortest input - list. + For other zips, see also ‘-zip-lists’ (*note -zip-lists::) and + ‘-zip-fill’ (*note -zip-fill::). - If two lists are provided as arguments, return the groupings as a - list of cons cells. Otherwise, return the groupings as a list of - lists. + (-zip-with #'+ '(1 2 3 4) '(5 6 7)) + ⇒ (6 8 10) + (-zip-with #'cons '(1 2 3) '(4 5 6 7)) + ⇒ ((1 . 4) (2 . 5) (3 . 6)) + (--zip-with (format "%s & %s" it other) '(Batman Jekyll) '(Robin Hyde)) + ⇒ ("Batman & Robin" "Jekyll & Hyde") - Use ‘-zip-lists’ (*note -zip-lists::) if you need the return value - to always be a list of lists. + -- Function: -zip-pair (list1 list2) + Zip LIST1 and LIST2 together. - Alias: ‘-zip-pair’ + Make a pair with the head of each list, followed by a pair with the + second element of each list, and so on. The number of pairs + returned is equal to the length of the shorter input list. - See also: ‘-zip-lists’ (*note -zip-lists::) + See also: ‘-zip-lists’ (*note -zip-lists::). - (-zip '(1 2 3) '(4 5 6)) - ⇒ ((1 . 4) (2 . 5) (3 . 6)) - (-zip '(1 2 3) '(4 5 6 7)) + (-zip-pair '(1 2 3 4) '(5 6 7)) + ⇒ ((1 . 5) (2 . 6) (3 . 7)) + (-zip-pair '(1 2 3) '(4 5 6)) ⇒ ((1 . 4) (2 . 5) (3 . 6)) - (-zip '(1 2) '(3 4 5) '(6)) - ⇒ ((1 3 6)) + (-zip-pair '(1 2) '(3)) + ⇒ ((1 . 3)) -- Function: -zip-lists (&rest lists) - Zip LISTS together. Group the head of each list, followed by the - second elements of each list, and so on. The lengths of the - returned groupings are equal to the length of the shortest input - list. + Zip LISTS together. + + Group the head of each list, followed by the second element of each + list, and so on. The number of returned groupings is equal to the + length of the shortest input list, and the length of each grouping + is equal to the number of input LISTS. - The return value is always list of lists, which is a difference - from ‘-zip-pair’ which returns a cons-cell in case two input lists - are provided. + The return value is always a list of proper lists, in contrast to + ‘-zip’ (*note -zip::) which returns a list of dotted pairs when + only two input LISTS are provided. - See also: ‘-zip’ (*note -zip::) + See also: ‘-zip-pair’ (*note -zip-pair::). (-zip-lists '(1 2 3) '(4 5 6)) ⇒ ((1 4) (2 5) (3 6)) @@ -1829,57 +1936,126 @@ Other list functions not fit to be classified elsewhere. (-zip-lists '(1 2) '(3 4 5) '(6)) ⇒ ((1 3 6)) + -- Function: -zip-lists-fill (fill-value &rest lists) + Zip LISTS together, padding shorter lists with FILL-VALUE. This is + like ‘-zip-lists’ (*note -zip-lists::) (which see), except it + retains all elements at positions beyond the end of the shortest + list. The number of returned groupings is equal to the length of + the longest input list, and the length of each grouping is equal to + the number of input LISTS. + + (-zip-lists-fill 0 '(1 2) '(3 4 5) '(6)) + ⇒ ((1 3 6) (2 4 0) (0 5 0)) + (-zip-lists-fill 0 '(1 2) '(3 4) '(5 6)) + ⇒ ((1 3 5) (2 4 6)) + (-zip-lists-fill 0 '(1 2 3) nil) + ⇒ ((1 0) (2 0) (3 0)) + + -- Function: -zip (&rest lists) + Zip LISTS together. + + Group the head of each list, followed by the second element of each + list, and so on. The number of returned groupings is equal to the + length of the shortest input list, and the number of items in each + grouping is equal to the number of input LISTS. + + If only two LISTS are provided as arguments, return the groupings + as a list of dotted pairs. Otherwise, return the groupings as a + list of proper lists. + + Since the return value changes form depending on the number of + arguments, it is generally recommended to use ‘-zip-lists’ (*note + -zip-lists::) instead, or ‘-zip-pair’ (*note -zip-pair::) if a list + of dotted pairs is desired. + + See also: ‘-unzip’ (*note -unzip::). + + (-zip '(1 2 3 4) '(5 6 7) '(8 9)) + ⇒ ((1 5 8) (2 6 9)) + (-zip '(1 2 3) '(4 5 6) '(7 8 9)) + ⇒ ((1 4 7) (2 5 8) (3 6 9)) + (-zip '(1 2 3)) + ⇒ ((1) (2) (3)) + -- Function: -zip-fill (fill-value &rest lists) - Zip LISTS, with FILL-VALUE padded onto the shorter lists. The - lengths of the returned groupings are equal to the length of the - longest input list. + Zip LISTS together, padding shorter lists with FILL-VALUE. This is + like ‘-zip’ (*note -zip::) (which see), except it retains all + elements at positions beyond the end of the shortest list. The + number of returned groupings is equal to the length of the longest + input list, and the length of each grouping is equal to the number + of input LISTS. + + Since the return value changes form depending on the number of + arguments, it is generally recommended to use ‘-zip-lists-fill’ + (*note -zip-lists-fill::) instead, unless a list of dotted pairs is + explicitly desired. + + (-zip-fill 0 '(1 2 3) '(4 5)) + ⇒ ((1 . 4) (2 . 5) (3 . 0)) + (-zip-fill 0 () '(1 2 3)) + ⇒ ((0 . 1) (0 . 2) (0 . 3)) + (-zip-fill 0 '(1 2) '(3 4) '(5 6)) + ⇒ ((1 3 5) (2 4 6)) + + -- Function: -unzip-lists (lists) + Unzip LISTS. + + This works just like ‘-zip-lists’ (*note -zip-lists::) (which see), + but takes a list of lists instead of a variable number of + arguments, such that + + (-unzip-lists (-zip-lists ARGS...)) - (-zip-fill 0 '(1 2 3 4 5) '(6 7 8 9)) - ⇒ ((1 . 6) (2 . 7) (3 . 8) (4 . 9) (5 . 0)) + is identity (given that the lists comprising ARGS are of the same + length). + + (-unzip-lists (-zip-lists '(1 2) '(3 4) '(5 6))) + ⇒ ((1 2) (3 4) (5 6)) + (-unzip-lists '((1 2 3) (4 5) (6 7) (8 9))) + ⇒ ((1 4 6 8) (2 5 7 9)) + (-unzip-lists '((1 2 3) (4 5 6))) + ⇒ ((1 4) (2 5) (3 6)) -- Function: -unzip (lists) Unzip LISTS. - This works just like ‘-zip’ (*note -zip::) but takes a list of - lists instead of a variable number of arguments, such that + This works just like ‘-zip’ (*note -zip::) (which see), but takes a + list of lists instead of a variable number of arguments, such that (-unzip (-zip L1 L2 L3 ...)) - is identity (given that the lists are the same length). + is identity (given that the lists are of the same length, and that + ‘-zip’ (*note -zip::) is not called with two arguments, because of + the caveat described in its docstring). - Note in particular that calling this on a list of two lists will - return a list of cons-cells such that the above identity works. + Note in particular that calling ‘-unzip’ (*note -unzip::) on a list + of two lists will return a list of dotted pairs. - See also: ‘-zip’ (*note -zip::) + Since the return value changes form depending on the number of + LISTS, it is generally recommended to use ‘-unzip-lists’ (*note + -unzip-lists::) instead. - (-unzip (-zip '(1 2 3) '(a b c) '("e" "f" "g"))) - ⇒ ((1 2 3) (a b c) ("e" "f" "g")) - (-unzip '((1 2) (3 4) (5 6) (7 8) (9 10))) - ⇒ ((1 3 5 7 9) (2 4 6 8 10)) - (-unzip '((1 2) (3 4))) - ⇒ ((1 . 3) (2 . 4)) - - -- Function: -cycle (list) - Return an infinite circular copy of LIST. The returned list cycles - through the elements of LIST and repeats from the beginning. - - (-take 5 (-cycle '(1 2 3))) - ⇒ (1 2 3 1 2) - (-take 7 (-cycle '(1 "and" 3))) - ⇒ (1 "and" 3 1 "and" 3 1) - (-zip (-cycle '(1 2 3)) '(1 2)) - ⇒ ((1 . 1) (2 . 2)) + (-unzip (-zip '(1 2) '(3 4) '(5 6))) + ⇒ ((1 . 2) (3 . 4) (5 . 6)) + (-unzip '((1 2 3) (4 5 6))) + ⇒ ((1 . 4) (2 . 5) (3 . 6)) + (-unzip '((1 2 3) (4 5) (6 7) (8 9))) + ⇒ ((1 4 6 8) (2 5 7 9)) -- Function: -pad (fill-value &rest lists) - Appends FILL-VALUE to the end of each list in LISTS such that they - will all have the same length. + Pad each of LISTS with FILL-VALUE until they all have equal + lengths. + + Ensure all LISTS are as long as the longest one by repeatedly + appending FILL-VALUE to the shorter lists, and return the resulting + LISTS. (-pad 0 ()) ⇒ (nil) - (-pad 0 '(1)) - ⇒ ((1)) - (-pad 0 '(1 2 3) '(4 5)) - ⇒ ((1 2 3) (4 5 0)) + (-pad 0 '(1 2) '(3 4)) + ⇒ ((1 2) (3 4)) + (-pad 0 '(1 2) '(3 4 5 6) '(7 8 9)) + ⇒ ((1 2 0 0) (3 4 5 6) (7 8 9 0)) -- Function: -table (fn &rest lists) Compute outer product of LISTS using function FN. @@ -1926,9 +2102,11 @@ Other list functions not fit to be classified elsewhere. ⇒ ((1 1 1) (2 1 1) (1 2 1) (2 2 1) (1 1 2) (2 1 2) (1 2 2) (2 2 2)) -- Function: -first (pred list) - Return the first item in LIST for which PRED returns non-nil. - Return nil if no such element is found. To get the first item in - the list no questions asked, use ‘car’. + Return the first item in LIST for which PRED returns non-‘nil’. + Return ‘nil’ if no such element is found. + + To get the first item in the list no questions asked, use + ‘-first-item’ (*note -first-item::). Alias: ‘-find’. @@ -1942,7 +2120,7 @@ Other list functions not fit to be classified elsewhere. ⇒ 3 -- Function: -last (pred list) - Return the last x in LIST where (PRED x) is non-nil, else nil. + Return the last x in LIST where (PRED x) is non-‘nil’, else ‘nil’. (-last 'even? '(1 2 3 4 5 6 3 3 3)) ⇒ 6 @@ -1952,65 +2130,79 @@ Other list functions not fit to be classified elsewhere. ⇒ "short" -- Function: -first-item (list) - Return the first item of LIST, or nil on an empty list. + Return the first item of LIST, or ‘nil’ on an empty list. See also: ‘-second-item’ (*note -second-item::), ‘-last-item’ - (*note -last-item::). + (*note -last-item::), etc. - (-first-item '(1 2 3)) + (-first-item ()) + ⇒ () + (-first-item '(1 2 3 4 5)) ⇒ 1 - (-first-item nil) - ⇒ nil (let ((list (list 1 2 3))) (setf (-first-item list) 5) list) ⇒ (5 2 3) -- Function: -second-item (list) - Return the second item of LIST, or nil if LIST is too short. + Return the second item of LIST, or ‘nil’ if LIST is too short. - See also: ‘-third-item’ (*note -third-item::). + See also: ‘-first-item’ (*note -first-item::), ‘-third-item’ (*note + -third-item::), etc. - (-second-item '(1 2 3)) + (-second-item ()) + ⇒ () + (-second-item '(1 2 3 4 5)) ⇒ 2 - (-second-item nil) - ⇒ nil + (let ((list (list 1 2))) (setf (-second-item list) 5) list) + ⇒ (1 5) -- Function: -third-item (list) - Return the third item of LIST, or nil if LIST is too short. + Return the third item of LIST, or ‘nil’ if LIST is too short. - See also: ‘-fourth-item’ (*note -fourth-item::). + See also: ‘-second-item’ (*note -second-item::), ‘-fourth-item’ + (*note -fourth-item::), etc. - (-third-item '(1 2 3)) + (-third-item ()) + ⇒ () + (-third-item '(1 2)) + ⇒ () + (-third-item '(1 2 3 4 5)) ⇒ 3 - (-third-item nil) - ⇒ nil -- Function: -fourth-item (list) - Return the fourth item of LIST, or nil if LIST is too short. + Return the fourth item of LIST, or ‘nil’ if LIST is too short. - See also: ‘-fifth-item’ (*note -fifth-item::). + See also: ‘-third-item’ (*note -third-item::), ‘-fifth-item’ (*note + -fifth-item::), etc. - (-fourth-item '(1 2 3 4)) + (-fourth-item ()) + ⇒ () + (-fourth-item '(1 2 3)) + ⇒ () + (-fourth-item '(1 2 3 4 5)) ⇒ 4 - (-fourth-item nil) - ⇒ nil -- Function: -fifth-item (list) - Return the fifth item of LIST, or nil if LIST is too short. + Return the fifth item of LIST, or ‘nil’ if LIST is too short. - See also: ‘-last-item’ (*note -last-item::). + See also: ‘-fourth-item’ (*note -fourth-item::), ‘-last-item’ + (*note -last-item::), etc. + (-fifth-item ()) + ⇒ () + (-fifth-item '(1 2 3 4)) + ⇒ () (-fifth-item '(1 2 3 4 5)) ⇒ 5 - (-fifth-item nil) - ⇒ nil -- Function: -last-item (list) - Return the last item of LIST, or nil on an empty list. + Return the last item of LIST, or ‘nil’ on an empty list. - (-last-item '(1 2 3)) - ⇒ 3 - (-last-item nil) - ⇒ nil + See also: ‘-first-item’ (*note -first-item::), etc. + + (-last-item ()) + ⇒ () + (-last-item '(1 2 3 4 5)) + ⇒ 5 (let ((list (list 1 2 3))) (setf (-last-item list) 5) list) ⇒ (1 2 5) @@ -2027,12 +2219,12 @@ Other list functions not fit to be classified elsewhere. -- Function: -sort (comparator list) Sort LIST, stably, comparing elements using COMPARATOR. Return the sorted list. LIST is NOT modified by side effects. COMPARATOR is - called with two elements of LIST, and should return non-nil if the - first element should sort before the second. + called with two elements of LIST, and should return non-‘nil’ if + the first element should sort before the second. - (-sort '< '(3 1 2)) + (-sort #'< '(3 1 2)) ⇒ (1 2 3) - (-sort '> '(3 1 2)) + (-sort #'> '(3 1 2)) ⇒ (3 2 1) (--sort (< it other) '(3 1 2)) ⇒ (1 2 3) @@ -2076,7 +2268,7 @@ Functions pretending lists are trees. Return a sequence of the nodes in TREE, in depth-first search order. - BRANCH is a predicate of one argument that returns non-nil if the + BRANCH is a predicate of one argument that returns non-‘nil’ if the passed argument is a branch, that is, a node that can have children. @@ -2106,8 +2298,9 @@ Functions pretending lists are trees. -- Function: -tree-map-nodes (pred fun tree) Call FUN on each node of TREE that satisfies PRED. - If PRED returns nil, continue descending down this node. If PRED - returns non-nil, apply FUN to this node and do not descend further. + If PRED returns ‘nil’, continue descending down this node. If PRED + returns non-‘nil’, apply FUN to this node and do not descend + further. (-tree-map-nodes 'vectorp (lambda (x) (-sum (append x nil))) '(1 [2 3] 4 (5 [6 7] 8))) ⇒ (1 5 4 (5 13 8)) @@ -2191,8 +2384,8 @@ Functions pretending lists are trees. structure but all cons are replaced with new ones. This is useful when you need to clone a structure such as plist or alist. - (let* ((a '(1 2 3)) (b (-clone a))) (nreverse a) b) - ⇒ (1 2 3) + (let* ((a (list (list 1))) (b (-clone a))) (setcar (car a) 2) b) + ⇒ ((1))  File: dash.info, Node: Threading macros, Next: Binding, Prev: Tree operations, Up: Functions @@ -2257,8 +2450,8 @@ readability. ⇒ 3 -- Macro: -some-> (x &optional form &rest more) - When expr is non-nil, thread it through the first form (via ‘->’ - (*note ->::)), and when that result is non-nil, through the next + When expr is non-‘nil’, thread it through the first form (via ‘->’ + (*note ->::)), and when that result is non-‘nil’, through the next form, etc. (-some-> '(2 3 5)) @@ -2269,8 +2462,8 @@ readability. ⇒ nil -- Macro: -some->> (x &optional form &rest more) - When expr is non-nil, thread it through the first form (via ‘->>’ - (*note ->>::)), and when that result is non-nil, through the next + When expr is non-‘nil’, thread it through the first form (via ‘->>’ + (*note ->>::)), and when that result is non-‘nil’, through the next form, etc. (-some->> '(1 2 3) (-map 'square)) @@ -2282,9 +2475,9 @@ readability. -- Macro: -some--> (expr &rest forms) Thread EXPR through FORMS via ‘-->’ (*note -->::), while the result - is non-nil. When EXPR evaluates to non-nil, thread the result - through the first of FORMS, and when that result is non-nil, thread - it through the next form, etc. + is non-‘nil’. When EXPR evaluates to non-‘nil’, thread the result + through the first of FORMS, and when that result is non-‘nil’, + thread it through the next form, etc. (-some--> "def" (concat "abc" it "ghi")) ⇒ "abcdefghi" @@ -2316,7 +2509,7 @@ Macros that combine ‘let’ and ‘let*’ with destructuring and flow control. -- Macro: -when-let ((var val) &rest body) - If VAL evaluates to non-nil, bind it to VAR and execute body. + If VAL evaluates to non-‘nil’, bind it to VAR and execute body. Note: binding is done according to ‘-let’ (*note -let::). @@ -2333,7 +2526,7 @@ control. Note: binding is done according to ‘-let*’ (*note -let*::). VALS are evaluated sequentially, and evaluation stops after the first - nil VAL is encountered. + ‘nil’ VAL is encountered. (-when-let* ((x 5) (y 3) (z (+ y 4))) (+ x y z)) ⇒ 15 @@ -2341,8 +2534,8 @@ control. ⇒ nil -- Macro: -if-let ((var val) then &rest else) - If VAL evaluates to non-nil, bind it to VAR and do THEN, otherwise - do ELSE. + If VAL evaluates to non-‘nil’, bind it to VAR and do THEN, + otherwise do ELSE. Note: binding is done according to ‘-let’ (*note -let::). @@ -2358,7 +2551,7 @@ control. Note: binding is done according to ‘-let*’ (*note -let*::). VALS are evaluated sequentially, and evaluation stops after the first - nil VAL is encountered. + ‘nil’ VAL is encountered. (-if-let* ((x 5) (y 3) (z 7)) (+ x y z) "foo") ⇒ 15 @@ -2434,15 +2627,15 @@ control. Key/value stores: (&plist key0 a0 ... keyN aN) - bind value mapped by keyK in the - SOURCE plist to aK. If the value is not found, aK is nil. Uses + SOURCE plist to aK. If the value is not found, aK is ‘nil’. Uses ‘plist-get’ to fetch values. (&alist key0 a0 ... keyN aN) - bind value mapped by keyK in the - SOURCE alist to aK. If the value is not found, aK is nil. Uses + SOURCE alist to aK. If the value is not found, aK is ‘nil’. Uses ‘assoc’ to fetch values. (&hash key0 a0 ... keyN aN) - bind value mapped by keyK in the - SOURCE hash table to aK. If the value is not found, aK is nil. + SOURCE hash table to aK. If the value is not found, aK is ‘nil’. Uses ‘gethash’ to fetch values. Further, special keyword &keys supports "inline" matching of @@ -2610,7 +2803,7 @@ File: dash.info, Node: Side effects, Next: Destructive operations, Prev: Bind Functions iterating over lists for side effect only. -- Function: -each (list fn) - Call FN on each element of LIST. Return nil; this function is + Call FN on each element of LIST. Return ‘nil’; this function is intended for side effects. Its anaphoric counterpart is ‘--each’. @@ -2626,9 +2819,9 @@ Functions iterating over lists for side effect only. ⇒ nil -- Function: -each-while (list pred fn) - Call FN on each ITEM in LIST, while (PRED ITEM) is non-nil. Once - an ITEM is reached for which PRED returns nil, FN is no longer - called. Return nil; this function is intended for side effects. + Call FN on each ITEM in LIST, while (PRED ITEM) is non-‘nil’. Once + an ITEM is reached for which PRED returns ‘nil’, FN is no longer + called. Return ‘nil’; this function is intended for side effects. Its anaphoric counterpart is ‘--each-while’. @@ -2641,7 +2834,7 @@ Functions iterating over lists for side effect only. -- Function: -each-indexed (list fn) Call FN on each index and element of LIST. For each ITEM at INDEX - in LIST, call (funcall FN INDEX ITEM). Return nil; this function + in LIST, call (funcall FN INDEX ITEM). Return ‘nil’; this function is intended for side effects. See also: ‘-map-indexed’ (*note -map-indexed::). @@ -2654,7 +2847,7 @@ Functions iterating over lists for side effect only. ⇒ () -- Function: -each-r (list fn) - Call FN on each element of LIST in reversed order. Return nil; + Call FN on each element of LIST in reversed order. Return ‘nil’; this function is intended for side effects. Its anaphoric counterpart is ‘--each-r’. @@ -2668,9 +2861,9 @@ Functions iterating over lists for side effect only. -- Function: -each-r-while (list pred fn) Call FN on each ITEM in reversed LIST, while (PRED ITEM) is - non-nil. Once an ITEM is reached for which PRED returns nil, FN is - no longer called. Return nil; this function is intended for side - effects. + non-‘nil’. Once an ITEM is reached for which PRED returns ‘nil’, + FN is no longer called. Return ‘nil’; this function is intended + for side effects. Its anaphoric counterpart is ‘--each-r-while’. @@ -2874,8 +3067,8 @@ Functions that manipulate and compose other functions. -- Function: -not (pred) Return a predicate that negates the result of PRED. The returned - predicate passes its arguments to PRED. If PRED returns nil, the - result is non-nil; otherwise the result is nil. + predicate passes its arguments to PRED. If PRED returns ‘nil’, the + result is non-‘nil’; otherwise the result is ‘nil’. See also: ‘-andfn’ (*note -andfn::) and ‘-orfn’ (*note -orfn::). @@ -2887,12 +3080,12 @@ Functions that manipulate and compose other functions. ⇒ (1 2 3 4) -- Function: -orfn (&rest preds) - Return a predicate that returns the first non-nil result of PREDS. - The returned predicate takes a variable number of arguments, passes - them to each predicate in PREDS in turn until one of them returns - non-nil, and returns that non-nil result without calling the - remaining PREDS. If all PREDS return nil, or if no PREDS are - given, the returned predicate returns nil. + Return a predicate that returns the first non-‘nil’ result of + PREDS. The returned predicate takes a variable number of + arguments, passes them to each predicate in PREDS in turn until one + of them returns non-‘nil’, and returns that non-‘nil’ result + without calling the remaining PREDS. If all PREDS return ‘nil’, or + if no PREDS are given, the returned predicate returns ‘nil’. See also: ‘-andfn’ (*note -andfn::) and ‘-not’ (*note -not::). @@ -2904,12 +3097,12 @@ Functions that manipulate and compose other functions. ⇒ t -- Function: -andfn (&rest preds) - Return a predicate that returns non-nil if all PREDS do so. The + Return a predicate that returns non-‘nil’ if all PREDS do so. The returned predicate P takes a variable number of arguments and passes them to each predicate in PREDS in turn. If any one of - PREDS returns nil, P also returns nil without calling the remaining - PREDS. If all PREDS return non-nil, P returns the last such value. - If no PREDS are given, P always returns non-nil. + PREDS returns ‘nil’, P also returns ‘nil’ without calling the + remaining PREDS. If all PREDS return non-‘nil’, P returns the last + such value. If no PREDS are given, P always returns non-‘nil’. See also: ‘-orfn’ (*note -orfn::) and ‘-not’ (*note -not::). @@ -2956,13 +3149,13 @@ Functions that manipulate and compose other functions. For functions over the floating point numbers, it may be necessary to provide an appropriate approximate comparison test. - 2. HALT-TEST returns a non-nil value. HALT-TEST defaults to a - simple counter that returns t after ‘-fixfn-max-iterations’, to + 2. HALT-TEST returns a non-‘nil’ value. HALT-TEST defaults to a + simple counter that returns ‘t’ after ‘-fixfn-max-iterations’, to guard against infinite iteration. Otherwise, HALT-TEST must be a function that accepts a single argument, the current value of X, - and returns non-nil as long as iteration should continue. In this - way, a more sophisticated convergence test may be supplied by the - caller. + and returns non-‘nil’ as long as iteration should continue. In + this way, a more sophisticated convergence test may be supplied by + the caller. The return value of the lambda is either the fixpoint or, if iteration halted before converging, a cons with car ‘halted’ and @@ -2978,27 +3171,35 @@ Functions that manipulate and compose other functions. ⇒ (halted . t) -- Function: -prodfn (&rest fns) - Take a list of n functions and return a function that takes a list - of length n, applying i-th function to i-th element of the input - list. Returns a list of length n. + Return a function that applies each of FNS to each of a list of + arguments. + + Takes a list of N functions and returns a function that takes a + list of length N, applying Ith function to Ith element of the input + list. Returns a list of length N. - In types (for n=2): ((a -> b), (c -> d)) -> (a, c) -> (b, d) + In types (for N=2): ((a -> b), (c -> d)) -> (a, c) -> (b, d) This function satisfies the following laws: (-compose (-prodfn f g ...) (-prodfn f’ g’ ...)) = (-prodfn - (-compose f f’) (-compose g g’) ...) (-prodfn f g ...) = (-juxt - (-compose f (-partial ’nth 0)) (-compose g (-partial ’nth 1)) ...) + (-compose f f’) (-compose g g’) ...) + + (-prodfn f g ...) = (-juxt (-compose f (-partial #’nth 0)) + (-compose g (-partial #’nth 1)) ...) + (-compose (-prodfn f g ...) (-juxt f’ g’ ...)) = (-juxt (-compose f - f’) (-compose g g’) ...) (-compose (-partial ’nth n) (-prod f1 f2 - ...)) = (-compose fn (-partial ’nth n)) + f’) (-compose g g’) ...) + + (-compose (-partial #’nth n) (-prod f1 f2 ...)) = (-compose fn + (-partial #’nth n)) - (funcall (-prodfn '1+ '1- 'number-to-string) '(1 2 3)) + (funcall (-prodfn #'1+ #'1- #'number-to-string) '(1 2 3)) ⇒ (2 1 "3") - (-map (-prodfn '1+ '1-) '((1 2) (3 4) (5 6) (7 8))) - ⇒ ((2 1) (4 3) (6 5) (8 7)) - (apply '+ (funcall (-prodfn 'length 'string-to-number) '((1 2 3) "15"))) - ⇒ 18 + (-map (-prodfn #'1- #'1+) '((1 2) (3 4) (5 6))) + ⇒ ((0 3) (2 5) (4 7)) + (apply #'+ (funcall (-prodfn #'length #'string-to-number) '((t) "5"))) + ⇒ 6  File: dash.info, Node: Development, Next: FDL, Prev: Functions, Up: Top @@ -4300,83 +4501,83 @@ Index * -all?: Predicates. (line 53) * -andfn: Function combinators. (line 184) -* -annotate: Maps. (line 84) +* -annotate: Maps. (line 86) * -any?: Predicates. (line 41) * -applify: Function combinators. (line 63) * -as->: Threading macros. (line 49) * -butlast: Other list operations. - (line 335) -* -clone: Tree operations. (line 122) + (line 405) +* -clone: Tree operations. (line 123) * -common-prefix: Reductions. (line 242) * -common-suffix: Reductions. (line 252) * -compose: Function combinators. (line 49) * -concat: List to list. (line 23) * -cons*: Other list operations. - (line 30) -* -cons-pair?: Predicates. (line 167) + (line 19) +* -cons-pair?: Predicates. (line 154) * -const: Function combinators. (line 128) * -contains?: Predicates. (line 100) -* -copy: Maps. (line 139) +* -copy: Maps. (line 151) * -count: Reductions. (line 172) * -cut: Function combinators. (line 140) -* -cycle: Other list operations. - (line 180) -* -difference: Set operations. (line 20) -* -distinct: Set operations. (line 62) +* -cycle: Unfolding. (line 55) +* -difference: Set operations. (line 22) +* -distinct: Set operations. (line 73) * -dotimes: Side effects. (line 80) * -doto: Threading macros. (line 99) -* -drop: Sublist selection. (line 147) -* -drop-last: Sublist selection. (line 161) -* -drop-while: Sublist selection. (line 192) +* -drop: Sublist selection. (line 149) +* -drop-last: Sublist selection. (line 163) +* -drop-while: Sublist selection. (line 194) * -each: Side effects. (line 8) * -each-indexed: Side effects. (line 38) * -each-r: Side effects. (line 52) * -each-r-while: Side effects. (line 65) * -each-while: Side effects. (line 24) * -elem-index: Indexing. (line 9) -* -elem-indices: Indexing. (line 21) +* -elem-indices: Indexing. (line 23) * -every: Predicates. (line 23) * -fifth-item: Other list operations. - (line 315) + (line 380) * -filter: Sublist selection. (line 8) -* -find-index: Indexing. (line 32) -* -find-indices: Indexing. (line 60) -* -find-last-index: Indexing. (line 46) +* -find-index: Indexing. (line 35) +* -find-indices: Indexing. (line 73) +* -find-last-index: Indexing. (line 54) * -first: Other list operations. - (line 246) + (line 300) * -first-item: Other list operations. - (line 272) + (line 328) * -fix: Other list operations. - (line 375) + (line 445) * -fixfn: Function combinators. (line 224) -* -flatten: List to list. (line 34) -* -flatten-n: List to list. (line 56) +* -flatten: List to list. (line 38) +* -flatten-n: List to list. (line 60) * -flip: Function combinators. (line 95) * -fourth-item: Other list operations. - (line 305) -* -grade-down: Indexing. (line 81) -* -grade-up: Indexing. (line 71) -* -group-by: Partitioning. (line 194) + (line 367) +* -frequencies: Reductions. (line 310) +* -grade-down: Indexing. (line 103) +* -grade-up: Indexing. (line 93) +* -group-by: Partitioning. (line 205) * -if-let: Binding. (line 34) * -if-let*: Binding. (line 45) * -inits: Reductions. (line 222) -* -insert-at: List to list. (line 110) +* -insert-at: List to list. (line 114) * -interleave: Other list operations. - (line 67) + (line 56) * -interpose: Other list operations. - (line 57) -* -intersection: Set operations. (line 32) + (line 46) +* -intersection: Set operations. (line 36) * -iota: Other list operations. - (line 78) -* -is-infix?: Predicates. (line 153) -* -is-prefix?: Predicates. (line 129) -* -is-suffix?: Predicates. (line 141) + (line 67) +* -is-infix?: Predicates. (line 140) +* -is-prefix?: Predicates. (line 116) +* -is-suffix?: Predicates. (line 128) * -iterate: Unfolding. (line 9) * -iteratefn: Function combinators. (line 201) @@ -4385,24 +4586,24 @@ Index * -keep: List to list. (line 8) * -lambda: Binding. (line 247) * -last: Other list operations. - (line 262) + (line 318) * -last-item: Other list operations. - (line 325) + (line 393) * -let: Binding. (line 61) * -let*: Binding. (line 227) * -list: Other list operations. - (line 358) + (line 428) * -map: Maps. (line 10) * -map-first: Maps. (line 38) -* -map-indexed: Maps. (line 66) -* -map-last: Maps. (line 52) +* -map-indexed: Maps. (line 68) +* -map-last: Maps. (line 53) * -map-when: Maps. (line 22) -* -mapcat: Maps. (line 128) +* -mapcat: Maps. (line 140) * -max: Reductions. (line 286) * -max-by: Reductions. (line 296) * -min: Reductions. (line 262) * -min-by: Reductions. (line 272) -* -non-nil: Sublist selection. (line 94) +* -non-nil: Sublist selection. (line 95) * -none?: Predicates. (line 73) * -not: Function combinators. (line 153) @@ -4412,21 +4613,21 @@ Index * -orfn: Function combinators. (line 167) * -pad: Other list operations. - (line 191) + (line 241) * -partial: Function combinators. (line 8) -* -partition: Partitioning. (line 80) -* -partition-after-item: Partitioning. (line 184) -* -partition-after-pred: Partitioning. (line 151) -* -partition-all: Partitioning. (line 92) -* -partition-all-in-steps: Partitioning. (line 115) -* -partition-before-item: Partitioning. (line 174) -* -partition-before-pred: Partitioning. (line 163) -* -partition-by: Partitioning. (line 127) -* -partition-by-header: Partitioning. (line 138) -* -partition-in-steps: Partitioning. (line 103) -* -permutations: Set operations. (line 52) -* -powerset: Set operations. (line 44) +* -partition: Partitioning. (line 90) +* -partition-after-item: Partitioning. (line 195) +* -partition-after-pred: Partitioning. (line 162) +* -partition-all: Partitioning. (line 102) +* -partition-all-in-steps: Partitioning. (line 126) +* -partition-before-item: Partitioning. (line 185) +* -partition-before-pred: Partitioning. (line 174) +* -partition-by: Partitioning. (line 138) +* -partition-by-header: Partitioning. (line 149) +* -partition-in-steps: Partitioning. (line 113) +* -permutations: Set operations. (line 60) +* -powerset: Set operations. (line 50) * -prodfn: Function combinators. (line 258) * -product: Reductions. (line 201) @@ -4439,17 +4640,16 @@ Index * -reductions-r: Reductions. (line 154) * -reductions-r-from: Reductions. (line 118) * -remove: Sublist selection. (line 26) -* -remove-at: List to list. (line 146) -* -remove-at-indices: List to list. (line 159) -* -remove-first: Sublist selection. (line 43) -* -remove-item: Sublist selection. (line 83) -* -remove-last: Sublist selection. (line 64) -* -repeat: Other list operations. - (line 19) -* -replace: List to list. (line 68) -* -replace-at: List to list. (line 121) -* -replace-first: List to list. (line 82) -* -replace-last: List to list. (line 96) +* -remove-at: List to list. (line 151) +* -remove-at-indices: List to list. (line 170) +* -remove-first: Sublist selection. (line 44) +* -remove-item: Sublist selection. (line 84) +* -remove-last: Sublist selection. (line 65) +* -repeat: Unfolding. (line 44) +* -replace: List to list. (line 72) +* -replace-at: List to list. (line 125) +* -replace-first: List to list. (line 86) +* -replace-last: List to list. (line 100) * -rotate: Other list operations. (line 8) * -rotate-args: Function combinators. @@ -4458,62 +4658,68 @@ Index (line 22) * -running-product: Reductions. (line 211) * -running-sum: Reductions. (line 190) -* -same-items?: Predicates. (line 115) +* -same-items?: Set operations. (line 88) * -second-item: Other list operations. - (line 285) -* -select-by-indices: Sublist selection. (line 208) -* -select-column: Sublist selection. (line 238) -* -select-columns: Sublist selection. (line 219) -* -separate: Partitioning. (line 69) + (line 341) +* -select-by-indices: Sublist selection. (line 211) +* -select-column: Sublist selection. (line 241) +* -select-columns: Sublist selection. (line 222) +* -separate: Partitioning. (line 75) * -setq: Binding. (line 270) -* -slice: Sublist selection. (line 104) +* -slice: Sublist selection. (line 105) * -snoc: Other list operations. - (line 43) + (line 32) * -some: Predicates. (line 8) * -some-->: Threading macros. (line 86) * -some->: Threading macros. (line 62) * -some->>: Threading macros. (line 74) * -sort: Other list operations. - (line 345) -* -splice: Maps. (line 95) -* -splice-list: Maps. (line 115) + (line 415) +* -splice: Maps. (line 102) +* -splice-list: Maps. (line 127) * -split-at: Partitioning. (line 8) -* -split-on: Partitioning. (line 34) -* -split-when: Partitioning. (line 52) +* -split-on: Partitioning. (line 40) +* -split-when: Partitioning. (line 58) * -split-with: Partitioning. (line 23) * -sum: Reductions. (line 180) * -table: Other list operations. - (line 202) + (line 256) * -table-flat: Other list operations. - (line 221) + (line 275) * -tails: Reductions. (line 232) -* -take: Sublist selection. (line 120) -* -take-last: Sublist selection. (line 133) -* -take-while: Sublist selection. (line 175) +* -take: Sublist selection. (line 121) +* -take-last: Sublist selection. (line 135) +* -take-while: Sublist selection. (line 177) * -third-item: Other list operations. - (line 295) + (line 354) * -tree-map: Tree operations. (line 28) * -tree-map-nodes: Tree operations. (line 39) -* -tree-mapreduce: Tree operations. (line 84) -* -tree-mapreduce-from: Tree operations. (line 103) -* -tree-reduce: Tree operations. (line 52) -* -tree-reduce-from: Tree operations. (line 69) +* -tree-mapreduce: Tree operations. (line 85) +* -tree-mapreduce-from: Tree operations. (line 104) +* -tree-reduce: Tree operations. (line 53) +* -tree-reduce-from: Tree operations. (line 70) * -tree-seq: Tree operations. (line 8) * -unfold: Unfolding. (line 25) * -union: Set operations. (line 8) * -unzip: Other list operations. - (line 158) -* -update-at: List to list. (line 133) + (line 215) +* -unzip-lists: Other list operations. + (line 196) +* -update-at: List to list. (line 137) * -when-let: Binding. (line 9) * -when-let*: Binding. (line 21) * -zip: Other list operations. - (line 107) -* -zip-fill: Other list operations. (line 150) +* -zip-fill: Other list operations. + (line 176) * -zip-lists: Other list operations. - (line 131) + (line 114) +* -zip-lists-fill: Other list operations. + (line 135) +* -zip-pair: Other list operations. + (line 98) * -zip-with: Other list operations. - (line 91) + (line 80) * dash-fontify-mode: Fontification of special variables. (line 6) * dash-register-info-lookup: Info symbol lookup. (line 6) @@ -4532,203 +4738,207 @@ Node: Functions4877 Node: Maps6361 Ref: -map6658 Ref: -map-when7031 -Ref: -map-first7606 -Ref: -map-last8081 -Ref: -map-indexed8551 -Ref: -annotate9237 -Ref: -splice9724 -Ref: -splice-list10502 -Ref: -mapcat10961 -Ref: -copy11334 -Node: Sublist selection11522 -Ref: -filter11715 -Ref: -remove12262 -Ref: -remove-first12800 -Ref: -remove-last13642 -Ref: -remove-item14367 -Ref: -non-nil14767 -Ref: -slice15043 -Ref: -take15572 -Ref: -take-last15979 -Ref: -drop16410 -Ref: -drop-last16851 -Ref: -take-while17277 -Ref: -drop-while17892 -Ref: -select-by-indices18508 -Ref: -select-columns19019 -Ref: -select-column19722 -Node: List to list20185 -Ref: -keep20377 -Ref: -concat20941 -Ref: -flatten21235 -Ref: -flatten-n21991 -Ref: -replace22375 -Ref: -replace-first22836 -Ref: -replace-last23331 -Ref: -insert-at23819 -Ref: -replace-at24144 -Ref: -update-at24531 -Ref: -remove-at25019 -Ref: -remove-at-indices25504 -Node: Reductions26083 -Ref: -reduce-from26279 -Ref: -reduce-r-from27003 -Ref: -reduce28266 -Ref: -reduce-r29017 -Ref: -reductions-from30295 -Ref: -reductions-r-from31101 -Ref: -reductions31931 -Ref: -reductions-r32642 -Ref: -count33387 -Ref: -sum33611 -Ref: -running-sum33799 -Ref: -product34120 -Ref: -running-product34328 -Ref: -inits34669 -Ref: -tails34914 -Ref: -common-prefix35158 -Ref: -common-suffix35452 -Ref: -min35746 -Ref: -min-by35972 -Ref: -max36493 -Ref: -max-by36718 -Node: Unfolding37244 -Ref: -iterate37485 -Ref: -unfold37932 -Node: Predicates38737 -Ref: -some38914 -Ref: -every39331 -Ref: -any?40010 -Ref: -all?40341 -Ref: -none?41048 -Ref: -only-some?41350 -Ref: -contains?41835 -Ref: -same-items?42224 -Ref: -is-prefix?42609 -Ref: -is-suffix?42935 -Ref: -is-infix?43261 -Ref: -cons-pair?43615 -Node: Partitioning43940 -Ref: -split-at44128 -Ref: -split-with44792 -Ref: -split-on45192 -Ref: -split-when45863 -Ref: -separate46500 -Ref: -partition46939 -Ref: -partition-all47388 -Ref: -partition-in-steps47813 -Ref: -partition-all-in-steps48307 -Ref: -partition-by48789 -Ref: -partition-by-header49167 -Ref: -partition-after-pred49768 -Ref: -partition-before-pred50215 -Ref: -partition-before-item50600 -Ref: -partition-after-item50907 -Ref: -group-by51209 -Node: Indexing51642 -Ref: -elem-index51844 -Ref: -elem-indices52239 -Ref: -find-index52619 -Ref: -find-last-index53108 -Ref: -find-indices53612 -Ref: -grade-up54017 -Ref: -grade-down54424 -Node: Set operations54838 -Ref: -union55021 -Ref: -difference55459 -Ref: -intersection55871 -Ref: -powerset56303 -Ref: -permutations56513 -Ref: -distinct56809 -Node: Other list operations57183 -Ref: -rotate57408 -Ref: -repeat57761 -Ref: -cons*58040 -Ref: -snoc58456 -Ref: -interpose58866 -Ref: -interleave59160 -Ref: -iota59526 -Ref: -zip-with60009 -Ref: -zip60723 -Ref: -zip-lists61552 -Ref: -zip-fill62250 -Ref: -unzip62572 -Ref: -cycle63314 -Ref: -pad63713 -Ref: -table64032 -Ref: -table-flat64818 -Ref: -first65823 -Ref: -last66309 -Ref: -first-item66643 -Ref: -second-item67042 -Ref: -third-item67306 -Ref: -fourth-item67568 -Ref: -fifth-item67834 -Ref: -last-item68096 -Ref: -butlast68387 -Ref: -sort68632 -Ref: -list69118 -Ref: -fix69687 -Node: Tree operations70176 -Ref: -tree-seq70372 -Ref: -tree-map71227 -Ref: -tree-map-nodes71667 -Ref: -tree-reduce72514 -Ref: -tree-reduce-from73396 -Ref: -tree-mapreduce73996 -Ref: -tree-mapreduce-from74855 -Ref: -clone76140 -Node: Threading macros76467 -Ref: ->76692 -Ref: ->>77180 -Ref: -->77683 -Ref: -as->78239 -Ref: -some->78693 -Ref: -some->>79066 -Ref: -some-->79501 -Ref: -doto80050 -Node: Binding80603 -Ref: -when-let80810 -Ref: -when-let*81265 -Ref: -if-let81788 -Ref: -if-let*82148 -Ref: -let82765 -Ref: -let*88837 -Ref: -lambda89774 -Ref: -setq90580 -Node: Side effects91381 -Ref: -each91575 -Ref: -each-while92096 -Ref: -each-indexed92698 -Ref: -each-r93284 -Ref: -each-r-while93720 -Ref: -dotimes94346 -Node: Destructive operations94899 -Ref: !cons95117 -Ref: !cdr95321 -Node: Function combinators95514 -Ref: -partial95718 -Ref: -rpartial96236 -Ref: -juxt96884 -Ref: -compose97336 -Ref: -applify97943 -Ref: -on98373 -Ref: -flip99145 -Ref: -rotate-args99669 -Ref: -const100298 -Ref: -cut100640 -Ref: -not101120 -Ref: -orfn101646 -Ref: -andfn102408 -Ref: -iteratefn103164 -Ref: -fixfn103866 -Ref: -prodfn105422 -Node: Development106480 -Node: Contribute106769 -Node: Contributors107781 -Node: FDL109874 -Node: GPL135194 -Node: Index172943 +Ref: -map-first7605 +Ref: -map-last8200 +Ref: -map-indexed8790 +Ref: -annotate9476 +Ref: -splice10080 +Ref: -splice-list11155 +Ref: -mapcat11614 +Ref: -copy11987 +Node: Sublist selection12175 +Ref: -filter12368 +Ref: -remove12921 +Ref: -remove-first13470 +Ref: -remove-last14318 +Ref: -remove-item15048 +Ref: -non-nil15448 +Ref: -slice15730 +Ref: -take16259 +Ref: -take-last16677 +Ref: -drop17114 +Ref: -drop-last17561 +Ref: -take-while17993 +Ref: -drop-while18620 +Ref: -select-by-indices19253 +Ref: -select-columns19764 +Ref: -select-column20467 +Node: List to list20930 +Ref: -keep21122 +Ref: -concat21698 +Ref: -flatten22226 +Ref: -flatten-n22988 +Ref: -replace23372 +Ref: -replace-first23833 +Ref: -replace-last24328 +Ref: -insert-at24816 +Ref: -replace-at25141 +Ref: -update-at25528 +Ref: -remove-at26069 +Ref: -remove-at-indices26696 +Node: Reductions27386 +Ref: -reduce-from27582 +Ref: -reduce-r-from28306 +Ref: -reduce29569 +Ref: -reduce-r30320 +Ref: -reductions-from31598 +Ref: -reductions-r-from32404 +Ref: -reductions33234 +Ref: -reductions-r33945 +Ref: -count34690 +Ref: -sum34920 +Ref: -running-sum35108 +Ref: -product35429 +Ref: -running-product35637 +Ref: -inits35978 +Ref: -tails36223 +Ref: -common-prefix36468 +Ref: -common-suffix36762 +Ref: -min37056 +Ref: -min-by37282 +Ref: -max37803 +Ref: -max-by38028 +Ref: -frequencies38554 +Node: Unfolding39169 +Ref: -iterate39410 +Ref: -unfold39857 +Ref: -repeat40662 +Ref: -cycle40946 +Node: Predicates41343 +Ref: -some41520 +Ref: -every41949 +Ref: -any?42663 +Ref: -all?43012 +Ref: -none?43754 +Ref: -only-some?44074 +Ref: -contains?44619 +Ref: -is-prefix?45125 +Ref: -is-suffix?45457 +Ref: -is-infix?45789 +Ref: -cons-pair?46149 +Node: Partitioning46480 +Ref: -split-at46668 +Ref: -split-with47332 +Ref: -split-on47972 +Ref: -split-when48643 +Ref: -separate49286 +Ref: -partition49820 +Ref: -partition-all50269 +Ref: -partition-in-steps50694 +Ref: -partition-all-in-steps51240 +Ref: -partition-by51754 +Ref: -partition-by-header52132 +Ref: -partition-after-pred52733 +Ref: -partition-before-pred53186 +Ref: -partition-before-item53571 +Ref: -partition-after-item53878 +Ref: -group-by54180 +Node: Indexing54613 +Ref: -elem-index54815 +Ref: -elem-indices55302 +Ref: -find-index55761 +Ref: -find-last-index56430 +Ref: -find-indices57081 +Ref: -grade-up57843 +Ref: -grade-down58250 +Node: Set operations58664 +Ref: -union58847 +Ref: -difference59277 +Ref: -intersection59705 +Ref: -powerset60134 +Ref: -permutations60411 +Ref: -distinct60849 +Ref: -same-items?61243 +Node: Other list operations61852 +Ref: -rotate62077 +Ref: -cons*62430 +Ref: -snoc62852 +Ref: -interpose63264 +Ref: -interleave63558 +Ref: -iota63924 +Ref: -zip-with64407 +Ref: -zip-pair65215 +Ref: -zip-lists65781 +Ref: -zip-lists-fill66579 +Ref: -zip67289 +Ref: -zip-fill68316 +Ref: -unzip-lists69230 +Ref: -unzip69853 +Ref: -pad70846 +Ref: -table71331 +Ref: -table-flat72117 +Ref: -first73122 +Ref: -last73655 +Ref: -first-item74001 +Ref: -second-item74413 +Ref: -third-item74830 +Ref: -fourth-item75205 +Ref: -fifth-item75583 +Ref: -last-item75958 +Ref: -butlast76319 +Ref: -sort76564 +Ref: -list77058 +Ref: -fix77627 +Node: Tree operations78116 +Ref: -tree-seq78312 +Ref: -tree-map79173 +Ref: -tree-map-nodes79613 +Ref: -tree-reduce80477 +Ref: -tree-reduce-from81359 +Ref: -tree-mapreduce81959 +Ref: -tree-mapreduce-from82818 +Ref: -clone84103 +Node: Threading macros84441 +Ref: ->84666 +Ref: ->>85154 +Ref: -->85657 +Ref: -as->86213 +Ref: -some->86667 +Ref: -some->>87052 +Ref: -some-->87499 +Ref: -doto88066 +Node: Binding88619 +Ref: -when-let88826 +Ref: -when-let*89287 +Ref: -if-let89816 +Ref: -if-let*90182 +Ref: -let90805 +Ref: -let*96895 +Ref: -lambda97832 +Ref: -setq98638 +Node: Side effects99439 +Ref: -each99633 +Ref: -each-while100160 +Ref: -each-indexed100780 +Ref: -each-r101372 +Ref: -each-r-while101814 +Ref: -dotimes102458 +Node: Destructive operations103011 +Ref: !cons103229 +Ref: !cdr103433 +Node: Function combinators103626 +Ref: -partial103830 +Ref: -rpartial104348 +Ref: -juxt104996 +Ref: -compose105448 +Ref: -applify106055 +Ref: -on106485 +Ref: -flip107257 +Ref: -rotate-args107781 +Ref: -const108410 +Ref: -cut108752 +Ref: -not109232 +Ref: -orfn109776 +Ref: -andfn110569 +Ref: -iteratefn111356 +Ref: -fixfn112058 +Ref: -prodfn113632 +Node: Development114783 +Node: Contribute115072 +Node: Contributors116084 +Node: FDL118177 +Node: GPL143497 +Node: Index181246  End Tag Table diff --git a/elpa/dash-20210826.1149/dir b/elpa/dash-20230502.1324/dir similarity index 100% rename from elpa/dash-20210826.1149/dir rename to elpa/dash-20230502.1324/dir diff --git a/elpa/f-20191110.1357/f-pkg.el b/elpa/f-20191110.1357/f-pkg.el deleted file mode 100644 index 984e0b0b..00000000 --- a/elpa/f-20191110.1357/f-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; -*- no-byte-compile: t -*- -(define-package "f" "20191110.1357" "Modern API for working with files and directories" '((s "1.7.0") (dash "2.2.0")) :commit "1814209e2ff43cf2e6d38c4cd476218915f550fb" :keywords '("files" "directories") :authors '(("Johan Andersson" . "johan.rejeep@gmail.com")) :maintainer '("Johan Andersson" . "johan.rejeep@gmail.com") :url "http://github.com/rejeep/f.el") diff --git a/elpa/f-20191110.1357/f-autoloads.el b/elpa/f-20230116.1032/f-autoloads.el similarity index 64% rename from elpa/f-20191110.1357/f-autoloads.el rename to elpa/f-20230116.1032/f-autoloads.el index 366a50c8..4dd17886 100644 --- a/elpa/f-20191110.1357/f-autoloads.el +++ b/elpa/f-20230116.1032/f-autoloads.el @@ -1,4 +1,4 @@ -;;; f-autoloads.el --- automatically extracted autoloads +;;; f-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- ;; ;;; Code: @@ -9,7 +9,11 @@ ;;;### (autoloads nil "f" "f.el" (0 0 0 0)) ;;; Generated autoloads from f.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "f" '("f-"))) +(register-definition-prefixes "f" '("f-")) + +;;;*** + +;;;### (autoloads nil nil ("f-pkg.el" "f-shortdoc.el") (0 0 0 0)) ;;;*** diff --git a/elpa/f-20230116.1032/f-pkg.el b/elpa/f-20230116.1032/f-pkg.el new file mode 100644 index 00000000..e2d3c604 --- /dev/null +++ b/elpa/f-20230116.1032/f-pkg.el @@ -0,0 +1,14 @@ +(define-package "f" "20230116.1032" "Modern API for working with files and directories" + '((emacs "24.1") + (s "1.7.0") + (dash "2.2.0")) + :commit "8a70ba3002197e3c6421181492b60b37d4d4af7b" :authors + '(("Johan Andersson" . "johan.rejeep@gmail.com")) + :maintainer + '("Lucien Cartier-Tilet" . "lucien@phundrak.com") + :keywords + '("files" "directories") + :url "http://github.com/rejeep/f.el") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/f-20230116.1032/f-shortdoc.el b/elpa/f-20230116.1032/f-shortdoc.el new file mode 100644 index 00000000..2278382c --- /dev/null +++ b/elpa/f-20230116.1032/f-shortdoc.el @@ -0,0 +1,439 @@ +;;; f-shortdoc.el --- Shortdoc for f.el -*- lexical-binding: t; no-byte-compile: t; -*- + +;; Author: Lucien Cartier-Tilet +;; Maintainer: Lucien Cartier-Tilet +;; Version: 0.1.0 +;; Package-Requires: ((emacs "28.1")) +;; Homepage: https://github.com/rejeep/f.el + +;; 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 . + + +;;; Commentary: + +;; Shortdoc implementation for f.el + +;;; Code: + +(when (version<= "28.1" emacs-version) + (when (< emacs-major-version 29) + (require 'shortdoc)) + + (define-short-documentation-group f + "Paths" + (f-join + :eval (f-join "path") + :eval (f-join "path" "to") + :eval (f-join "/" "path" "to" "heaven") + :eval (f-join "path" "/to" "file")) + + (f-split + :eval (f-split "path") + :eval (f-split "path/to") + :eval (f-split "/path/to/heaven") + :eval (f-split "~/back/to/earth")) + + (f-expand + :no-eval (f-expand "name") + :result-string "/default/directory/name" + :no-eval (f-expand "name" "other/directory") + :result-string "other/directory/name") + + (f-filename + :eval (f-filename "path/to/file.ext") + :eval (f-filename "path/to/directory")) + + (f-dirname + :eval (f-dirname "path/to/file.ext") + :eval (f-dirname "path/to/directory") + :eval (f-dirname "/")) + + (f-common-parent + :eval (f-common-parent '("foo/bar/baz" "foo/bar/qux" "foo/bar/mux")) + :eval (f-common-parent '("/foo/bar/baz" "/foo/bar/qux" "/foo/bax/mux")) + :eval (f-common-parent '("foo/bar/baz" "quack/bar/qux" "lack/bar/mux"))) + + (f-ext + :eval (f-ext "path/to/file") + :eval (f-ext "path/to/file.txt") + :eval (f-ext "path/to/file.txt.org")) + + (f-no-ext + :eval (f-no-ext "path/to/file") + :eval (f-no-ext "path/to/file.txt") + :eval (f-no-ext "path/to/file.txt.org")) + + (f-swap-ext + :eval (f-swap-ext "path/to/file.ext" "org")) + + (f-base + :eval (f-base "path/to/file.ext") + :eval (f-base "path/to/directory")) + + (f-relative + :eval (f-relative "/some/path/relative/to/my/file.txt" "/some/path/") + :eval (f-relative "/default/directory/my/file.txt")) + + (f-short + :no-eval (f-short "/Users/foo/Code/on/macOS") + :result-string "~/Code/on/macOS" + :no-eval (f-short "/home/foo/Code/on/linux") + :result-string "~/Code/on/linux" + :eval (f-short "/path/to/Code/bar")) + + (f-long + :eval (f-long "~/Code/bar") + :eval (f-long "/path/to/Code/bar")) + + (f-canonical + :eval (f-canonical "/path/to/real/file") + :no-eval (f-canonical "/link/to/file") + :result-string "/path/to/real/file") + + (f-slash + :no-eval (f-slash "/path/to/file") + :result-string "/path/to/file" + :no-eval (f-slash "/path/to/dir") + :result-string "/path/to/dir/" + :no-eval (f-slash "/path/to/dir/") + :result-string "/path/to/dir/") + + (f-full + :eval (f-full "~/path/to/file") + :eval (f-full "~/path/to/dir") + :eval (f-full "~/path/to/dir/")) + + (f-uniquify + :eval (f-uniquify '("/foo/bar" "/foo/baz" "/foo/quux")) + :eval (f-uniquify '("/foo/bar" "/www/bar" "/foo/quux")) + :eval (f-uniquify '("/foo/bar" "/www/bar" "/www/bar/quux")) + :eval (f-uniquify '("/foo/bar" "/foo/baz" "/home/www/bar" "/home/www/baz" "/var/foo" "/opt/foo/www/baz"))) + + (f-uniquify-alist + :eval (f-uniquify-alist '("/foo/bar" "/foo/baz" "/foo/quux")) + :eval (f-uniquify-alist '("/foo/bar" "/www/bar" "/foo/quux")) + :eval (f-uniquify-alist '("/foo/bar" "/www/bar" "/www/bar/quux")) + :eval (f-uniquify-alist '("/foo/bar" "/foo/baz" "/home/www/bar" "/home/www/baz" "/var/foo" "/opt/foo/www/baz"))) + + "I/O" + (f-read-bytes + :no-eval* (f-read-bytes "path/to/binary/data")) + + (f-write-bytes + :no-eval* (f-write-bytes (unibyte-string 72 101 108 108 111 32 119 111 114 108 100) "path/to/binary/data")) + + (f-append-bytes + :no-eval* (f-append-bytes "path/to/file" (unibyte-string 72 101 108 108 111 32 119 111 114 108 100))) + + (f-read-text + :no-eval* (f-read-text "path/to/file.txt" 'utf-8) + :no-eval* (f-read "path/to/file.txt" 'utf-8)) + + (f-write-text + :no-eval* (f-write-text "Hello world" 'utf-8 "path/to/file.txt") + :no-eval* (f-write "Hello world" 'utf-8 "path/to/file.txt")) + + (f-append-text + :no-eval* (f-append-text "Hello world" 'utf-8 "path/to/file.txt") + :no-eval* (f-append "Hello world" 'utf-8 "path/to/file.txt")) + + "Destructive" + (f-mkdir + :no-eval (f-mkdir "dir") + :result-string "creates /default/directory/dir" + :no-eval (f-mkdir "other" "dir") + :result-string "creates /default/directory/other/dir" + :no-eval (f-mkdir "/" "some" "path") + :result-string "creates /some/path" + :no-eval (f-mkdir "~" "yet" "another" "dir") + :result-string "creates ~/yet/another/dir") + + (f-mkdir-full-path + :no-eval (f-mkdir-full-path "dir") + :result-string "creates /default/directory/dir" + :no-eval (f-mkdir-full-path "other/dir") + :result-string "creates /default/directory/other/dir" + :no-eval (f-mkdir-full-path "/some/path") + :result-string "creates /some/path" + :no-eval (f-mkdir-full-path "~/yet/another/dir") + :result-string "creates ~/yet/another/dir") + + (f-delete + :no-eval* (f-delete "dir") + :no-eval* (f-delete "other/dir" t) + :no-eval* (f-delete "path/to/file.txt")) + + (f-symlink + :no-eval* (f-symlink "path/to/source" "path/to/link")) + + (f-move + :no-eval* (f-move "path/to/file.txt" "new-file.txt") + :no-eval* (f-move "path/to/file.txt" "other/path")) + + (f-copy + :no-eval* (f-copy "path/to/file.txt" "new-file.txt") + :no-eval* (f-copy "path/to/dir" "other/dir")) + + (f-copy-contents + :no-eval* (f-copy-contents "path/to/dir" "path/to/other/dir")) + + (f-touch + :no-eval* (f-touch "path/to/existing/file.txt") + :no-eval* (f-touch "path/to/non/existing/file.txt")) + + "Predicates" + (f-exists-p + :no-eval* (f-exists-p "path/to/file.txt") + :no-eval* (f-exists-p "path/to/dir")) + + (f-directory-p + :no-eval* (f-directory-p "path/to/file.txt") + :no-eval* (f-directory-p "path/to/dir")) + + (f-file-p + :no-eval* (f-file-p "path/to/file.txt") + :no-eval* (f-file-p "path/to/dir")) + + (f-symlink-p + :no-eval* (f-symlink-p "path/to/file.txt") + :no-eval* (f-symlink-p "path/to/dir") + :no-eval* (f-symlink-p "path/to/link")) + + (f-readable-p + :no-eval* (f-readable-p "path/to/file.txt") + :no-eval* (f-readable-p "path/to/dir")) + + (f-writable-p + :no-eval* (f-writable-p "path/to/file.txt") + :no-eval* (f-writable-p "path/to/dir")) + + (f-executable-p + :no-eval* (f-executable-p "path/to/file.txt") + :no-eval* (f-executable-p "path/to/dir")) + + (f-absolute-p + :eval (f-absolute-p "path/to/dir") + :eval (f-absolute-p "/full/path/to/dir")) + + (f-relative-p + :eval (f-relative-p "path/to/dir") + :eval (f-relative-p "/full/path/to/dir")) + + (f-root-p + :eval (f-root-p "/") + :eval (f-root-p "/not/root")) + + (f-ext-p + :eval (f-ext-p "path/to/file.el" "el") + :eval (f-ext-p "path/to/file.el" "txt") + :eval (f-ext-p "path/to/file.el") + :eval (f-ext-p "path/to/file")) + + (f-same-p + :eval (f-same-p "foo.txt" "foo.txt") + :eval (f-same-p "foo/bar/../baz" "foo/baz") + :eval (f-same-p "/path/to/foo.txt" "/path/to/bar.txt")) + + (f-parent-of-p + :no-eval (f-parent-of-p "/path/to" "/path/to/dir") + :result t + :no-eval (f-parent-of-p "/path/to/dir" "/path/to") + :result nil + :no-eval (f-parent-of-p "/path/to" "/path/to") + :result nil) + + (f-child-of-p + :no-eval (f-child-of-p "/path/to" "/path/to/dir") + :result nil + :no-eval (f-child-of-p "/path/to/dir" "/path/to") + :result t + :no-eval (f-child-of-p "/path/to" "/path/to") + :result nil) + + (f-ancestor-of-p + :no-eval (f-ancestor-of-p "/path/to" "/path/to/dir") + :result t + :no-eval (f-ancestor-of-p "/path" "/path/to/dir") + :result t + :no-eval (f-ancestor-of-p "/path/to/dir" "/path/to") + :result nil + :no-eval (f-ancestor-of-p "/path/to" "/path/to") + :result nil) + + (f-descendant-of-p + :no-eval (f-descendant-of-p "/path/to/dir" "/path/to") + :result t + :no-eval (f-descendant-of-p "/path/to/dir" "/path") + :result t + :no-eval (f-descendant-of-p "/path/to" "/path/to/dir") + :result nil + :no-eval (f-descendant-of-p "/path/to" "/path/to") + :result nil) + + (f-hidden-p + :eval (f-hidden-p "path/to/foo") + :eval (f-hidden-p ".path/to/foo") + :eval (f-hidden-p "path/.to/foo") + :eval (f-hidden-p "path/to/.foo") + :eval (f-hidden-p ".path/to/foo" 'any) + :eval (f-hidden-p "path/.to/foo" 'any) + :eval (f-hidden-p "path/to/.foo" 'any) + :eval (f-hidden-p ".path/to/foo" 'last) + :eval (f-hidden-p "path/.to/foo" 'last) + :eval (f-hidden-p "path/to/.foo" 'last)) + + (f-empty-p + :no-eval (f-empty-p "/path/to/empty-file") + :result t + :no-eval (f-empty-p "/path/to/file-with-contents") + :result nil + :no-eval (f-empty-p "/path/to/empty-dir/") + :result t + :no-eval (f-empty-p "/path/to/dir-with-contents/") + :result nil) + + (f-older-p + :noeval (f-older-p "older-file.txt" "newer-file.txt") + :result t + :noeval (f-older-p "newer-file.txt" "older-file.txt") + :result nil + :noeval (f-older-p "same-time1.txt" "same-time2.txt") + :result nil) + + (f-newer-p + :noeval (f-newer-p "newer-file.txt" "older-file.txt") + :result t + :noeval (f-newer-p "older-file.txt" "newer-file.txt") + :result nil + :noeval (f-newer-p "same-time1.txt" "same-time2.txt") + :result nil) + + (f-same-time-p + :noeval (f-same-time-p "same-time1.txt" "same-time2.txt") + :result t + :noeval (f-same-time-p "newer-file.txt" "older-file.txt") + :result nil + :noeval (f-same-time-p "older-file.txt" "newer-file.txt") + :result nil) + + "Stats" + (f-size + :no-eval* (f-size "path/to/file.txt") + :no-eval* (f-size "path/to/dir")) + + (f-depth + :eval (f-depth "/") + :eval (f-depth "/var/") + :eval (f-depth "/usr/local/bin")) + + (f-change-time + :no-eval (f-change-time "path/to/file.txt") + :result (25517 48756 26337 111000) + :no-eval (f-change-time "path/to/dir") + :result (25517 57887 344657 210000) + :no-eval (f-change-time "path/to/file.txt" t) + :result (1672330868026337111 . 1000000000) + :no-eval (f-change-time "path/to/dir" t) + :result (1672339999344657210 . 1000000000) + :no-eval (f-change-time "path/to/file.txt" 'seconds) + :result 1672330868 + :no-eval (f-change-time "path/to/dir" 'seconds) + :result 1672339999) + + (f-modification-time + :no-eval (f-modification-time "path/to/file.txt") + :result (25517 48756 26337 111000) + :no-eval (f-modification-time "path/to/dir") + :result (25517 57887 344657 210000) + :no-eval (f-modification-time "path/to/file.txt" t) + :result (1672330868026337111 . 1000000000) + :no-eval (f-modification-time "path/to/dir" t) + :result (1672339999344657210 . 1000000000) + :no-eval (f-modification-time "path/to/file.txt" 'seconds) + :result 1672330868 + :no-eval (f-modification-time "path/to/dir" 'seconds) + :result 1672339999) + + (f-access-time + :no-eval (f-access-time "path/to/file.txt") + :result (25517 48756 26337 111000) + :no-eval (f-access-time "path/to/dir") + :result (25517 57887 344657 210000) + :no-eval (f-access-time "path/to/file.txt" t) + :result (1672330868026337111 . 1000000000) + :no-eval (f-access-time "path/to/dir" t) + :result (1672339999344657210 . 1000000000) + :no-eval (f-access-time "path/to/file.txt" 'seconds) + :result 1672330868 + :no-eval (f-access-time "path/to/dir" 'seconds) + :result 1672339999) + + "Misc" + (f-this-file + :no-eval* (f-this-file)) + + (f-path-separator + :eval (f-path-separator)) + + (f-glob + :no-eval* (f-glob "path/to/*.el") + :no-eval* (f-glob "*.el" "path/to")) + + (f-entries + :no-eval* (f-entries "path/to/dir") + :no-eval* (f-entries "path/to/dir" (lambda (file) (s-matches? "test" file))) + :no-eval* (f-entries "path/to/dir" nil t) + :no-eval* (f--entries "path/to/dir" (s-matches? "test" it))) + + (f-directories + :no-eval* (f-directories "path/to/dir") + :no-eval* (f-directories "path/to/dir" (lambda (dir) (equal (f-filename dir) "test"))) + :no-eval* (f-directories "path/to/dir" nil t) + :no-eval* (f--directories "path/to/dir" (equal (f-filename it) "test"))) + + (f-files + :no-eval* (f-files "path/to/dir") + :no-eval* (f-files "path/to/dir" (lambda (file) (equal (f-ext file) "el"))) + :no-eval* (f-files "path/to/dir" nil t) + :no-eval* (f--files "path/to/dir" (equal (f-ext it) "el"))) + + (f-root + :eval (f-root)) + + (f-traverse-upwards + :no-eval* (f-traverse-upwards + (lambda (path) + (f-exists? (f-expand ".git" path))) + start-path) + + :no-eval* (f--traverse-upwards (f-exists? (f-expand ".git" it)) start-path)) + + (f-with-sandbox + :no-eval (f-with-sandbox foo-path + (f-touch (f-expand "foo" foo-path))) + :no-eval (f-with-sandbox (list foo-path bar-path) + (f-touch (f-expand "foo" foo-path)) + (f-touch (f-expand "bar" bar-path))) + :no-eval (f-with-sandbox foo-path + (f-touch (f-expand "bar" bar-path)))))) ;; "Destructive operation outside sandbox" + +(eval-when-compile + (when (version< emacs-version "28.1") + (warn "Emacs should not be compiling this file"))) + +(provide 'f-shortdoc) + +;;; f-shortdoc.el ends here diff --git a/elpa/f-20191110.1357/f.el b/elpa/f-20230116.1032/f.el similarity index 53% rename from elpa/f-20191110.1357/f.el rename to elpa/f-20230116.1032/f.el index 012727c3..ab51853a 100644 --- a/elpa/f-20191110.1357/f.el +++ b/elpa/f-20230116.1032/f.el @@ -3,12 +3,11 @@ ;; Copyright (C) 2013 Johan Andersson ;; Author: Johan Andersson -;; Maintainer: Johan Andersson +;; Maintainer: Lucien Cartier-Tilet ;; Version: 0.20.0 -;; Package-Version: 20191110.1357 +;; Package-Requires: ((emacs "24.1") (s "1.7.0") (dash "2.2.0")) ;; Keywords: files, directories -;; URL: http://github.com/rejeep/f.el -;; Package-Requires: ((s "1.7.0") (dash "2.2.0")) +;; Homepage: http://github.com/rejeep/f.el ;; This file is NOT part of GNU Emacs. @@ -29,12 +28,19 @@ ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. +;;; Commentary: +;; +;; Much inspired by magnar's excellent s.el and dash.el, f.el is a +;; modern API for working with files and directories in Emacs. + ;;; Code: (require 's) (require 'dash) +(when (version<= "28.1" emacs-version) + (require 'f-shortdoc)) (put 'f-guard-error 'error-conditions '(error f-guard-error)) (put 'f-guard-error 'error-message "Destructive operation outside sandbox") @@ -50,8 +56,8 @@ Do not modify this variable.") If PATH is not allowed to be modified, throw error." (declare (indent 1)) `(if f--guard-paths - (if (--any? (or (f-same? it ,path) - (f-ancestor-of? it ,path)) f--guard-paths) + (if (--any? (or (f-same-p it ,path) + (f-ancestor-of-p it ,path)) f--guard-paths) (progn ,@body) (signal 'f-guard-error (list ,path f--guard-paths))) ,@body)) @@ -60,18 +66,28 @@ If PATH is not allowed to be modified, throw error." ;;;; Paths (defun f-join (&rest args) - "Join ARGS to a single path." - (let (path (relative (f-relative? (car args)))) + "Join ARGS to a single path. + +Be aware if one of the arguments is an absolute path, `f-join' +will discard all the preceeding arguments and make this absolute +path the new root of the generated path." + (let (path + (relative (f-relative-p (car args)))) (-map (lambda (arg) - (setq path (f-expand arg path))) + (setq path (cond ((not path) arg) + ((f-absolute-p arg) + (progn + (setq relative nil) + arg)) + (t (f-expand arg path))))) args) (if relative (f-relative path) path))) (defun f-split (path) "Split PATH and return list containing parts." - (let ((parts (s-split (f-path-separator) path 'omit-nulls))) - (if (f-absolute? path) + (let ((parts (split-string path (f-path-separator) 'omit-nulls))) + (if (string= (s-left 1 path) (f-path-separator)) (push (f-path-separator) parts) parts))) @@ -89,12 +105,13 @@ ignored." (file-name-nondirectory (directory-file-name path))) (defalias 'f-parent 'f-dirname) + (defun f-dirname (path) "Return the parent directory to PATH." (let ((parent (file-name-directory (directory-file-name (f-expand path default-directory))))) - (unless (f-same? path parent) - (if (f-relative? path) + (unless (f-same-p path parent) + (if (f-relative-p path) (f-relative parent) (directory-file-name parent))))) @@ -113,26 +130,19 @@ ignored." (setq common (caar paths))) (cond ((null re) "") - ((and (= (length re) 1) (f-root? (car re))) + ((and (= (length re) 1) (f-root-p (car re))) (f-root)) (:otherwise (concat (apply 'f-join (nreverse re)) "/"))))))) -(defun f-ext (path) - "Return the file extension of PATH. - -The extension, in a file name, is the part that follows the last -'.', excluding version numbers and backup suffixes." - (file-name-extension path)) +(defalias 'f-ext 'file-name-extension) -(defun f-no-ext (path) - "Return everything but the file extension of PATH." - (file-name-sans-extension path)) +(defalias 'f-no-ext 'file-name-sans-extension) (defun f-swap-ext (path ext) "Return PATH but with EXT as the new extension. EXT must not be nil or empty." - (if (s-blank? ext) + (if (s-blank-p ext) (error "Extension cannot be empty or nil") (concat (f-no-ext path) "." ext))) @@ -140,29 +150,23 @@ EXT must not be nil or empty." "Return the name of PATH, excluding the extension of file." (f-no-ext (f-filename path))) -(defun f-relative (path &optional dir) - "Return PATH relative to DIR." - (file-relative-name path dir)) +(defalias 'f-relative 'file-relative-name) -(defalias 'f-abbrev 'f-short) -(defun f-short (path) - "Return abbrev of PATH. See `abbreviate-file-name'." - (abbreviate-file-name path)) +(defalias 'f-short 'abbreviate-file-name) +(defalias 'f-abbrev 'abbreviate-file-name) (defun f-long (path) "Return long version of PATH." (f-expand path)) -(defun f-canonical (path) - "Return the canonical name of PATH." - (file-truename path)) +(defalias 'f-canonical 'file-truename) (defun f-slash (path) "Append slash to PATH unless one already. Some functions, such as `call-process' requires there to be an ending slash." - (if (f-dir? path) + (if (f-dir-p path) (file-name-as-directory path) path)) @@ -181,7 +185,13 @@ ending slash." (--mapcat (let ((conf-files (cdr it))) (if (> (length conf-files) 1) - (--map (cons (car it) (concat (f-filename (s-chop-suffix (cdr it) (car it))) (f-path-separator) (cdr it))) conf-files) + (--map (cons + (car it) + (concat + (f-filename (s-chop-suffix (cdr it) + (car it))) + (f-path-separator) (cdr it))) + conf-files) conf-files)) uniq-filenames-next)))) uniq-filenames-next)) @@ -201,14 +211,16 @@ This function expects no duplicate paths." ;;;; I/O -(defun f-read-bytes (path) +(defun f-read-bytes (path &optional beg end) "Read binary data from PATH. -Return the binary data as unibyte string." +Return the binary data as unibyte string. The optional second +and third arguments BEG and END specify what portion of the file +to read." (with-temp-buffer (set-buffer-multibyte nil) (setq buffer-file-coding-system 'binary) - (insert-file-contents-literally path) + (insert-file-contents-literally path nil beg end) (buffer-substring-no-properties (point-min) (point-max)))) (defalias 'f-read 'f-read-text) @@ -267,21 +279,38 @@ If APPEND is non-nil, append the DATA to the existing contents." ;;;; Destructive (defun f-mkdir (&rest dirs) - "Create directories DIRS." + "Create directories DIRS. + +DIRS should be a successive list of directories forming together +a full path. The easiest way to call this function with a fully +formed path is using `f-split' alongside it: + + (apply #\\='f-mkdir (f-split \"path/to/file\")) + +Although it works sometimes, it is not recommended to use fully +formed paths in the function. In this case, it is recommended to +use `f-mkdir-full-path' instead." (let (path) (-each dirs (lambda (dir) (setq path (f-expand dir path)) - (unless (f-directory? path) + (unless (f-directory-p path) (f--destructive path (make-directory path))))))) +(defun f-mkdir-full-path (dir) + "Create DIR from a full path. + +This function is similar to `f-mkdir' except it can accept a full +path instead of requiring several successive directory names." + (apply #'f-mkdir (f-split dir))) + (defun f-delete (path &optional force) "Delete PATH, which can be file or directory. If FORCE is t, a directory will be deleted recursively." (f--destructive path - (if (or (f-file? path) (f-symlink? path)) + (if (or (f-file-p path) (f-symlink-p path)) (delete-file path) (delete-directory path force)))) @@ -299,7 +328,7 @@ If TO is a directory name, move FROM into TO." If FROM names a directory and TO is a directory name, copy FROM into TO as a subdirectory." (f--destructive to - (if (f-file? from) + (if (f-file-p from) (copy-file from to) ;; The behavior of `copy-directory' differs between Emacs 23 and ;; 24 in that in Emacs 23, the contents of `from' is copied to @@ -307,7 +336,7 @@ into TO as a subdirectory." ;; `to'. We want the Emacs 24 behavior. (if (> emacs-major-version 23) (copy-directory from to) - (if (f-dir? to) + (if (f-dir-p to) (progn (apply 'f-mkdir (f-split to)) (let ((new-to (f-expand (f-filename from) to))) @@ -316,9 +345,9 @@ into TO as a subdirectory." (defun f-copy-contents (from to) "Copy contents in directory FROM, to directory TO." - (unless (f-exists? to) + (unless (f-exists-p to) (error "Cannot copy contents to non existing directory %s" to)) - (unless (f-dir? from) + (unless (f-dir-p from) (error "Cannot copy contents as %s is a file" from)) (--each (f-entries from) (f-copy it (file-name-as-directory to)))) @@ -326,77 +355,56 @@ into TO as a subdirectory." (defun f-touch (path) "Update PATH last modification date or create if it does not exist." (f--destructive path - (if (f-file? path) + (if (f-file-p path) (set-file-times path) (f-write-bytes "" path)))) ;;;; Predicates -(defun f-exists? (path) - "Return t if PATH exists, false otherwise." - (file-exists-p path)) - -(defalias 'f-exists-p 'f-exists?) +(defalias 'f-exists-p 'file-exists-p) +(defalias 'f-exists? 'file-exists-p) -(defalias 'f-dir? 'f-directory?) -(defalias 'f-dir-p 'f-dir?) +(defalias 'f-directory-p 'file-directory-p) +(defalias 'f-directory? 'file-directory-p) +(defalias 'f-dir-p 'file-directory-p) +(defalias 'f-dir? 'file-directory-p) -(defun f-directory? (path) - "Return t if PATH is directory, false otherwise." - (file-directory-p path)) -(defalias 'f-directory-p 'f-directory?) +(defalias 'f-file-p 'file-regular-p) +(defalias 'f-file? 'file-regular-p) -(defun f-file? (path) - "Return t if PATH is file, false otherwise." - (file-regular-p path)) - -(defalias 'f-file-p 'f-file?) - -(defun f-symlink? (path) +(defun f-symlink-p (path) "Return t if PATH is symlink, false otherwise." (not (not (file-symlink-p path)))) -(defalias 'f-symlink-p 'f-symlink?) - -(defun f-readable? (path) - "Return t if PATH is readable, false otherwise." - (file-readable-p path)) - -(defalias 'f-readable-p 'f-readable?) - -(defun f-writable? (path) - "Return t if PATH is writable, false otherwise." - (file-writable-p path)) - -(defalias 'f-writable-p 'f-writable?) +(defalias 'f-symlink? 'f-symlink-p) -(defun f-executable? (path) - "Return t if PATH is executable, false otherwise." - (file-executable-p path)) +(defalias 'f-readable-p 'file-readable-p) +(defalias 'f-readable? 'file-readable-p) -(defalias 'f-executable-p 'f-executable?) +(defalias 'f-writable-p 'file-writable-p) +(defalias 'f-writable? 'file-writable-p) -(defun f-absolute? (path) - "Return t if PATH is absolute, false otherwise." - (file-name-absolute-p path)) +(defalias 'f-executable-p 'file-executable-p) +(defalias 'f-executable? 'file-executable-p) -(defalias 'f-absolute-p 'f-absolute?) +(defalias 'f-absolute-p 'file-name-absolute-p) +(defalias 'f-absolute? 'file-name-absolute-p) -(defun f-relative? (path) +(defun f-relative-p (path) "Return t if PATH is relative, false otherwise." - (not (f-absolute? path))) + (not (f-absolute-p path))) -(defalias 'f-relative-p 'f-relative?) +(defalias 'f-relative? 'f-relative-p) -(defun f-root? (path) +(defun f-root-p (path) "Return t if PATH is root directory, false otherwise." (not (f-parent path))) -(defalias 'f-root-p 'f-root?) +(defalias 'f-root? 'f-root-p) -(defun f-ext? (path &optional ext) +(defun f-ext-p (path &optional ext) "Return t if extension of PATH is EXT, false otherwise. If EXT is nil or omitted, return t if PATH has any extension, @@ -408,67 +416,91 @@ The extension, in a file name, is the part that follows the last (string= (f-ext path) ext) (not (eq (f-ext path) nil)))) -(defalias 'f-ext-p 'f-ext?) +(defalias 'f-ext? 'f-ext-p) -(defalias 'f-equal? 'f-same?) -(defalias 'f-equal-p 'f-equal?) +(defalias 'f-equal-p 'f-same-p) +(defalias 'f-equal? 'f-same-p) -(defun f-same? (path-a path-b) +(defun f-same-p (path-a path-b) "Return t if PATH-A and PATH-B are references to same file." - (when (and (f-exists? path-a) - (f-exists? path-b)) - (equal - (f-canonical (directory-file-name (f-expand path-a))) - (f-canonical (directory-file-name (f-expand path-b)))))) + (equal + (f-canonical (directory-file-name (f-expand path-a))) + (f-canonical (directory-file-name (f-expand path-b))))) -(defalias 'f-same-p 'f-same?) +(defalias 'f-same? 'f-same-p) -(defun f-parent-of? (path-a path-b) +(defun f-parent-of-p (path-a path-b) "Return t if PATH-A is parent of PATH-B." (--when-let (f-parent path-b) - (f-same? path-a it))) + (f-same-p path-a it))) -(defalias 'f-parent-of-p 'f-parent-of?) +(defalias 'f-parent-of? 'f-parent-of-p) -(defun f-child-of? (path-a path-b) +(defun f-child-of-p (path-a path-b) "Return t if PATH-A is child of PATH-B." (--when-let (f-parent path-a) - (f-same? it path-b))) + (f-same-p it path-b))) -(defalias 'f-child-of-p 'f-child-of?) +(defalias 'f-child-of? 'f-child-of-p) -(defun f-ancestor-of? (path-a path-b) +(defun f-ancestor-of-p (path-a path-b) "Return t if PATH-A is ancestor of PATH-B." - (unless (f-same? path-a path-b) - (s-starts-with? (f-full path-a) - (f-full path-b)))) + (unless (f-same-p path-a path-b) + (string-prefix-p (f-full path-a) + (f-full path-b)))) -(defalias 'f-ancestor-of-p 'f-ancestor-of?) +(defalias 'f-ancestor-of? 'f-ancestor-of-p) -(defun f-descendant-of? (path-a path-b) +(defun f-descendant-of-p (path-a path-b) "Return t if PATH-A is desendant of PATH-B." - (unless (f-same? path-a path-b) - (s-starts-with? (f-full path-b) - (f-full path-a)))) - -(defalias 'f-descendant-of-p 'f-descendant-of?) - -(defun f-hidden? (path) - "Return t if PATH is hidden, nil otherwise." - (unless (f-exists? path) - (error "Path does not exist: %s" path)) - (string= (substring path 0 1) ".")) - -(defalias 'f-hidden-p 'f-hidden?) - -(defun f-empty? (path) + (unless (f-same-p path-a path-b) + (string-prefix-p (f-full path-b) + (f-full path-a)))) + +(defalias 'f-descendant-of? 'f-descendant-of-p) + +(defun f-hidden-p (path &optional behavior) + "Return t if PATH is hidden, nil otherwise. + +BEHAVIOR controls when a path should be considered as hidden +depending on its value. Beware, if PATH begins with \"./\", the +current dir \".\" will not be considered as hidden. + +When BEHAVIOR is nil, it will only check if the path begins with +a dot, as in .a/b/c, and return t if there is one. This is the +old behavior of f.el left as default for backward-compatibility +purposes. + +When BEHAVIOR is ANY, return t if any of the elements of PATH is +hidden, nil otherwise. + +When BEHAVIOR is LAST, return t only if the last element of PATH +is hidden, nil otherwise. + +TODO: Hidden directories and files on Windows are marked +differently than on *NIX systems. This should be properly +implemented." + (let ((split-path (f-split path)) + (check-hidden (lambda (elt) + (and (string= (substring elt 0 1) ".") + (not (member elt '("." ".."))))))) + (pcase behavior + ('any (-any check-hidden split-path)) + ('last (apply check-hidden (last split-path))) + (otherwise (if (null otherwise) + (funcall check-hidden (car split-path)) + (error "Invalid value %S for argument BEHAVIOR" otherwise)))))) + +(defalias 'f-hidden? 'f-hidden-p) + +(defun f-empty-p (path) "If PATH is a file, return t if the file in PATH is empty, nil otherwise. If PATH is directory, return t if directory has no files, nil otherwise." - (if (f-directory? path) + (if (f-directory-p path) (equal (f-files path nil t) nil) (= (f-size path) 0))) -(defalias 'f-empty-p 'f-empty?) +(defalias 'f-empty? 'f-empty-p) ;;;; Stats @@ -478,7 +510,7 @@ If PATH is directory, return t if directory has no files, nil otherwise." If PATH is a file, return size of that file. If PATH is directory, return sum of all files in PATH." - (if (f-directory? path) + (if (f-directory-p path) (-sum (-map 'f-size (f-files path nil t))) (nth 7 (file-attributes path)))) @@ -490,6 +522,143 @@ detect the depth. '/' will be zero depth, '/usr' will be one depth. And so on." (- (length (f-split (f-expand path))) 1)) +;; For Emacs 28 and below, forward-declare ‘current-time-list’, which was +;; introduced in Emacs 29. +(defvar current-time-list) + +(defun f--get-time (path timestamp-p fn) + "Helper function, get time-related information for PATH. +Helper for `f-change-time', `f-modification-time', +`f-access-time'. It is meant to be called internally, avoid +calling it manually unless you have to. + +If TIMESTAMP-P is non-nil, return the date requested as a +timestamp. If the value is \\='seconds, return the timestamp as +a timestamp with a one-second precision. Otherwise, the +timestamp is returned in a (TICKS . HZ) format, see +`current-time' if using Emacs 29 or newer. + +Otherwise, if TIMESTAMP-P is nil, return the default style of +`current-time'. + +FN is the function specified by the caller function to retrieve +the correct data from PATH." + (let* ((current-time-list (not timestamp-p)) + (date (apply fn (list (file-attributes path)))) + (emacs29-or-newer-p (version<= "29" emacs-version))) + (cond + ((and (eq timestamp-p 'seconds) emacs29-or-newer-p) + (/ (car date) (cdr date))) + ((or (and (not (eq timestamp-p 'seconds)) emacs29-or-newer-p) + (and (not timestamp-p) (not emacs29-or-newer-p))) + date) + ((and (eq timestamp-p 'seconds) (not emacs29-or-newer-p)) + (+ (* (nth 0 date) (expt 2 16)) + (nth 1 date))) + ((and timestamp-p (not emacs29-or-newer-p)) + `(,(+ (* (nth 0 date) (expt 2 16) 1000) + (* (nth 1 date) 1000) + (nth 3 date)) + . 1000))))) + +(defun f-change-time (path &optional timestamp-p) + "Return the last status change time of PATH. + +The status change time (ctime) of PATH in the same format as +`current-time'. For details on TIMESTAMP-P and the format of the +returned value, see `f--get-time'." + (f--get-time path + timestamp-p + (if (fboundp 'file-attribute-status-change-time) + #'file-attribute-status-change-time + (lambda (f) (nth 6 f))))) + +(defun f-modification-time (path &optional timestamp-p) + "Return the last modification time of PATH. +The modification time (mtime) of PATH in the same format as +`current-time'. For details on TIMESTAMP-P and the format of the +returned value, see `f--get-time'." + (f--get-time path + timestamp-p + (if (fboundp 'file-attribute-modification-time) + #'file-attribute-modification-time + (lambda (f) (nth 5 f))))) + +(defun f-access-time (path &optional timestamp-p) + "Return the last access time of PATH. +The access time (atime) of PATH is in the same format as +`current-time'. For details on TIMESTAMP-P and the format of the +returned value, see `f--get-time'." + (f--get-time path + timestamp-p + (if (fboundp 'file-attribute-access-time) + #'file-attribute-access-time + (lambda (f) (nth 4 f))))) + +(defun f--three-way-compare (a b) + "Three way comparison. + +Return -1 if A < B. +Return 0 if A = B. +Return 1 if A > B." + (cond ((< a b) -1) + ((= a b) 0) + ((> a b) 1))) + +;; TODO: How to properly test this function? +(defun f--date-compare (file other method) + "Three-way comparison of the date of FILE and OTHER. + +This function can return three values: +* 1 means FILE is newer than OTHER +* 0 means FILE and NEWER share the same date +* -1 means FILE is older than OTHER + +The statistics used for the date comparison depends on METHOD. +When METHOD is null, compare their modification time. Otherwise, +compare their change time when METHOD is \\='change, or compare +their last access time when METHOD is \\='access." + (let* ((fn-method (cond + ((eq 'change method) #'f-change-time) + ((eq 'access method) #'f-access-time) + ((null method) #'f-modification-time) + (t (error "Unknown method %S" method)))) + (date-file (apply fn-method (list file))) + (date-other (apply fn-method (list other))) + (dates (-zip-pair date-file date-other))) + (message "[DEBUG]: file: %s\t\tother: %s" file other) + (message "[DEBUG]: dates: %S" dates) + (-reduce-from (lambda (acc elt) + (if (= acc 0) + (f--three-way-compare (car elt) (cdr elt)) + acc)) + 0 + dates))) + +(defun f-older-p (file other &optional method) + "Compare if FILE is older than OTHER. + +For more info on METHOD, see `f--date-compare'." + (< (f--date-compare file other method) 0)) + +(defalias 'f-older? #'f-older-p) + +(defun f-newer-p (file other &optional method) + "Compare if FILE is newer than OTHER. + +For more info on METHOD, see `f--date-compare'." + (> (f--date-compare file other method) 0)) + +(defalias 'f-newer? #'f-newer-p) + +(defun f-same-time-p (file other &optional method) + "Check if FILE and OTHER share the same access or modification time. + +For more info on METHOD, see `f--date-compare'." + (= (f--date-compare file other method) 0)) + +(defalias 'f-same-time? #'f-same-time-p) + ;;;; Misc @@ -519,18 +688,18 @@ detect the depth. (entries (-reject (lambda (file) - (or - (equal (f-filename file) ".") - (equal (f-filename file) ".."))) + (member (f-filename file) '("." ".."))) (directory-files path t)))) (cond (recursive (-map (lambda (entry) - (if (f-file? entry) + (if (f-file-p entry) (setq result (cons entry result)) - (when (f-directory? entry) + (when (f-directory-p entry) (setq result (cons entry result)) - (setq result (append result (f--collect-entries entry recursive)))))) + (if (f-readable-p entry) + (setq result (append result (f--collect-entries entry recursive))) + result)))) entries)) (t (setq result entries))) result)) @@ -564,7 +733,7 @@ RECURSIVE - Search for files and directories recursive." (defun f-directories (path &optional fn recursive) "Find all directories in PATH. See `f-entries'." - (let ((directories (-select 'f-directory? (f--collect-entries path recursive)))) + (let ((directories (-select 'f-directory-p (f--collect-entries path recursive)))) (if fn (-select fn directories) directories))) (defmacro f--files (path body &optional recursive) @@ -578,7 +747,7 @@ RECURSIVE - Search for files and directories recursive." (defun f-files (path &optional fn recursive) "Find all files in PATH. See `f-entries'." - (let ((files (-select 'f-file? (f--collect-entries path recursive)))) + (let ((files (-select 'f-file-p (f--collect-entries path recursive)))) (if fn (-select fn files) files))) (defmacro f--traverse-upwards (body &optional path) @@ -597,16 +766,16 @@ returned. If no function callback return a non-nil value, nil is returned." (unless path (setq path default-directory)) - (when (f-relative? path) + (when (f-relative-p path) (setq path (f-expand path))) (if (funcall fn path) path - (unless (f-root? path) + (unless (f-root-p path) (f-traverse-upwards fn (f-parent path))))) (defun f-root () "Return absolute root." - (f-traverse-upwards 'f-root?)) + (f-traverse-upwards 'f-root-p)) (defmacro f-with-sandbox (path-or-paths &rest body) "Only allow PATH-OR-PATHS and descendants to be modified in BODY." diff --git a/elpa/transient-20200125.1308/dir b/elpa/forge-20230505.926/dir similarity index 89% rename from elpa/transient-20200125.1308/dir rename to elpa/forge-20230505.926/dir index 4d6ad7f3..e9289b26 100644 --- a/elpa/transient-20200125.1308/dir +++ b/elpa/forge-20230505.926/dir @@ -15,4 +15,4 @@ File: dir, Node: Top This is the top of the INFO tree * Menu: Emacs -* Transient: (transient). Transient Commands. +* Forge: (forge). Access Git Forges from Magit. diff --git a/elpa/forge-20230505.926/forge-autoloads.el b/elpa/forge-20230505.926/forge-autoloads.el new file mode 100644 index 00000000..fb9bc561 --- /dev/null +++ b/elpa/forge-20230505.926/forge-autoloads.el @@ -0,0 +1,443 @@ +;;; forge-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "forge" "forge.el" (0 0 0 0)) +;;; Generated autoloads from forge.el + +(defvar forge-add-default-bindings t "\ +Whether to add Forge's bindings to various Magit keymaps. + +If you want to disable this, then you must set this to nil before +`magit' is loaded. If you do it before `forge' but after `magit' +is loaded, then `magit-mode-map' ends up being modified anyway. + +If this is nil, then `forge-toggle-display-in-status-buffer' can +no longer do its job. It might be better to set the global value +of `forge-display-in-status-buffer' to nil instead. That way you +can still display topics on demand in the status buffer.") + +(with-eval-after-load 'git-commit (when forge-add-default-bindings (define-key git-commit-mode-map (kbd "C-c C-v") #'forge-visit-topic))) + +(with-eval-after-load 'magit-mode (when forge-add-default-bindings (define-key magit-mode-map "'" #'forge-dispatch) (define-key magit-mode-map "N" #'forge-dispatch))) + +(register-definition-prefixes "forge" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-bitbucket" "forge-bitbucket.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from forge-bitbucket.el + +(register-definition-prefixes "forge-bitbucket" '("forge-bitbucket-repository")) + +;;;*** + +;;;### (autoloads nil "forge-commands" "forge-commands.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from forge-commands.el + (autoload 'forge-dispatch "forge-commands" nil t) + +(autoload 'forge-pull "forge-commands" "\ +Pull topics from the forge repository. + +With a prefix argument and if the repository has not been fetched +before, then read a date from the user and limit pulled topics to +those that have been updated since then. + +If pulling is too slow, then also consider setting the Git variable +`forge.omitExpensive' to `true'. + +\(fn &optional REPO UNTIL)" t nil) + +(autoload 'forge-pull-notifications "forge-commands" "\ +Fetch notifications for all repositories from the current forge." t nil) + +(autoload 'forge-pull-topic "forge-commands" "\ +Pull the API data for the current topic. +If there is no current topic or with a prefix argument read a +TOPIC to pull instead. + +\(fn TOPIC)" t nil) + +(autoload 'forge-browse-dwim "forge-commands" "\ +Visit a topic, branch or commit using a browser. +Prefer a topic over a branch and that over a commit." t nil) + +(autoload 'forge-browse-commit "forge-commands" "\ +Visit the url corresponding to REV using a browser. + +\(fn REV)" t nil) + +(autoload 'forge-copy-url-at-point-as-kill "forge-commands" "\ +Copy the url of the thing at point." t nil) + +(autoload 'forge-browse-branch "forge-commands" "\ +Visit the url corresponding BRANCH using a browser. + +\(fn BRANCH)" t nil) + +(autoload 'forge-browse-remote "forge-commands" "\ +Visit the url corresponding to REMOTE using a browser. + +\(fn REMOTE)" t nil) + +(autoload 'forge-browse-repository "forge-commands" "\ +View the current repository in a separate buffer. + +\(fn REPO)" t nil) + +(autoload 'forge-browse-topic "forge-commands" "\ +Visit the current topic using a browser." t nil) + +(autoload 'forge-browse-pullreqs "forge-commands" "\ +Visit the pull-requests of the current repository using a browser." t nil) + +(autoload 'forge-browse-pullreq "forge-commands" "\ +Visit the url corresponding to PULLREQ using a browser. + +\(fn PULLREQ)" t nil) + +(autoload 'forge-browse-issues "forge-commands" "\ +Visit the issues of the current repository using a browser." t nil) + +(autoload 'forge-browse-issue "forge-commands" "\ +Visit the current issue using a browser. +If there is no current issue or with a prefix argument +read an ISSUE to visit. + +\(fn ISSUE)" t nil) + +(autoload 'forge-browse-post "forge-commands" "\ +Visit the current post using a browser." t nil) + +(autoload 'forge-visit-topic "forge-commands" "\ +View the current topic in a separate buffer. +If there is no current topic or with a prefix argument +read a topic to visit instead. + +\(fn TOPIC)" t nil) + +(autoload 'forge-visit-pullreq "forge-commands" "\ +View the current pull-request in a separate buffer. +If there is no current pull-request or with a prefix argument +read a PULLREQ to visit instead. If point is looking at a pullreq +reference with Gitlab/Github notation try to visit the pullreq +with that number. + +\(fn PULLREQ)" t nil) + +(autoload 'forge-visit-issue "forge-commands" "\ +Visit the current issue in a separate buffer. +If there is no current issue or with a prefix argument read an +ISSUE to visit instead. If point is looking at an issue reference +with Gitlab/Github notation try to visit the issue with that +number. + +\(fn ISSUE)" t nil) + +(autoload 'forge-visit-repository "forge-commands" "\ +View the current repository in a separate buffer. + +\(fn REPO)" t nil) + +(autoload 'forge-branch-pullreq "forge-commands" "\ +Create and configure a new branch from a pull-request. +Please see the manual for more information. + +\(fn PULLREQ)" t nil) + +(autoload 'forge-checkout-pullreq "forge-commands" "\ +Create, configure and checkout a new branch from a pull-request. +Please see the manual for more information. + +\(fn PULLREQ)" t nil) + +(autoload 'forge-checkout-worktree "forge-commands" "\ +Create, configure and checkout a new worktree from a pull-request. +This is like `forge-checkout-pullreq', except that it also +creates a new worktree. Please see the manual for more +information. + +\(fn PATH PULLREQ)" t nil) + +(autoload 'forge-fork "forge-commands" "\ +Fork the current repository to FORK and add it as a REMOTE. +If the fork already exists, then that isn't an error; the remote +is added anyway. Currently this only supports Github and Gitlab. + +\(fn FORK REMOTE)" t nil) + +(autoload 'forge-list-notifications "forge-commands" "\ +List notifications." t nil) + +(autoload 'forge-add-pullreq-refspec "forge-commands" "\ +Configure Git to fetch all pull-requests. +This is done by adding \"+refs/pull/*/head:refs/pullreqs/*\" +to the value of `remote.REMOTE.fetch', where REMOTE is the +upstream remote. Also fetch from REMOTE." t nil) + +(autoload 'forge-add-repository "forge-commands" "\ +Add a repository to the database. +Offer to either pull topics (now and in the future) or to only +pull individual topics when the user invokes `forge-pull-topic'. + +\(fn URL)" t nil) + +(function-put 'forge-add-repository 'interactive-only 't) + +(autoload 'forge-add-user-repositories "forge-commands" "\ +Add all of USER's repositories from HOST to the database. +This may take a while. Only Github is supported at the moment. + +\(fn HOST USER)" t nil) + +(autoload 'forge-add-organization-repositories "forge-commands" "\ +Add all of ORGANIZATION's repositories from HOST to the database. +This may take a while. Only Github is supported at the moment. + +\(fn HOST ORGANIZATION)" t nil) + +(autoload 'forge-merge "forge-commands" "\ +Merge the current pull-request using METHOD using the forge's API. + +If there is no current pull-request or with a prefix argument, +then read pull-request PULLREQ to visit instead. + +Use of this command is discouraged. Unless the remote repository +is configured to disallow that, you should instead merge locally +and then push the target branch. Forges detect that you have +done that and respond by automatically marking the pull-request +as merged. + +\(fn PULLREQ METHOD)" t nil) + +(autoload 'forge-remove-repository "forge-commands" "\ +Remove a repository from the database. + +\(fn HOST OWNER NAME)" t nil) + +(autoload 'forge-remove-topic-locally "forge-commands" "\ +Remove a topic from the local database only. +Due to how the supported APIs work, it would be too expensive to +automatically remove topics from the local database that were +removed from the forge. The purpose of this command is to allow +you to manually clean up the local database. + +\(fn TOPIC)" t nil) + +(autoload 'forge-rename-default-branch "forge-commands" "\ +Rename the default branch to NEWNAME. +Change the name on the upstream remote and locally, and update +the upstream remotes of local branches accordingly." t nil) + +(autoload 'forge-reset-database "forge-commands" "\ +Move the current database file to the trash. +This is useful after the database scheme has changed, which will +happen a few times while the forge functionality is still under +heavy development." t nil) + +(register-definition-prefixes "forge-commands" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-core" "forge-core.el" (0 0 0 0)) +;;; Generated autoloads from forge-core.el + +(register-definition-prefixes "forge-core" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-db" "forge-db.el" (0 0 0 0)) +;;; Generated autoloads from forge-db.el + +(register-definition-prefixes "forge-db" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-gitea" "forge-gitea.el" (0 0 0 0)) +;;; Generated autoloads from forge-gitea.el + +(register-definition-prefixes "forge-gitea" '("forge-gitea-repository")) + +;;;*** + +;;;### (autoloads nil "forge-github" "forge-github.el" (0 0 0 0)) +;;; Generated autoloads from forge-github.el + +(register-definition-prefixes "forge-github" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-gitlab" "forge-gitlab.el" (0 0 0 0)) +;;; Generated autoloads from forge-gitlab.el + +(register-definition-prefixes "forge-gitlab" '("forge-gitlab-repository")) + +;;;*** + +;;;### (autoloads nil "forge-gogs" "forge-gogs.el" (0 0 0 0)) +;;; Generated autoloads from forge-gogs.el + +(register-definition-prefixes "forge-gogs" '("forge-gogs-repository")) + +;;;*** + +;;;### (autoloads nil "forge-issue" "forge-issue.el" (0 0 0 0)) +;;; Generated autoloads from forge-issue.el + +(register-definition-prefixes "forge-issue" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-list" "forge-list.el" (0 0 0 0)) +;;; Generated autoloads from forge-list.el + +(autoload 'forge-list-topics "forge-list" "\ +List topics of the current repository in a separate buffer. + +\(fn ID)" t nil) + +(autoload 'forge-list-issues "forge-list" "\ +List issues of the current repository in a separate buffer. + +\(fn ID)" t nil) + +(autoload 'forge-list-labeled-issues "forge-list" "\ +List issues of the current repository that have LABEL. +List them in a separate buffer. + +\(fn ID LABEL)" t nil) + +(autoload 'forge-list-assigned-issues "forge-list" "\ +List issues of the current repository that are assigned to you. +List them in a separate buffer. + +\(fn ID)" t nil) + +(autoload 'forge-list-owned-issues "forge-list" "\ +List open issues from all your Github repositories. +Options `forge-owned-accounts' and `forge-owned-ignored' +controls which repositories are considered to be owned by you. +Only Github is supported for now." t nil) + +(autoload 'forge-list-pullreqs "forge-list" "\ +List pull-requests of the current repository in a separate buffer. + +\(fn ID)" t nil) + +(autoload 'forge-list-labeled-pullreqs "forge-list" "\ +List pull-requests of the current repository that have LABEL. +List them in a separate buffer. + +\(fn ID LABEL)" t nil) + +(autoload 'forge-list-assigned-pullreqs "forge-list" "\ +List pull-requests of the current repository that are assigned to you. +List them in a separate buffer. + +\(fn ID)" t nil) + +(autoload 'forge-list-requested-reviews "forge-list" "\ +List pull-requests of the current repository that are awaiting your review. +List them in a separate buffer. + +\(fn ID)" t nil) + +(autoload 'forge-list-owned-pullreqs "forge-list" "\ +List open pull-requests from all your Github repositories. +Options `forge-owned-accounts' and `forge-owned-ignored' +controls which repositories are considered to be owned by you. +Only Github is supported for now." t nil) + +(autoload 'forge-list-authored-pullreqs "forge-list" "\ +List open pull-requests of the current repository that are authored by you. +List them in a separate buffer. + +\(fn ID)" t nil) + +(autoload 'forge-list-authored-issues "forge-list" "\ +List open issues from the current repository that are authored by you. +List them in a separate buffer. + +\(fn ID)" t nil) + +(autoload 'forge-list-repositories "forge-list" "\ +List known repositories in a separate buffer. +Here \"known\" means that an entry exists in the local database." t nil) + +(autoload 'forge-list-owned-repositories "forge-list" "\ +List your own known repositories in a separate buffer. +Here \"known\" means that an entry exists in the local database +and options `forge-owned-accounts' and `forge-owned-ignored' +controls which repositories are considered to be owned by you. +Only Github is supported for now." t nil) + +(register-definition-prefixes "forge-list" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-notify" "forge-notify.el" (0 0 0 0)) +;;; Generated autoloads from forge-notify.el + +(register-definition-prefixes "forge-notify" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-post" "forge-post.el" (0 0 0 0)) +;;; Generated autoloads from forge-post.el + +(register-definition-prefixes "forge-post" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-pullreq" "forge-pullreq.el" (0 0 0 0)) +;;; Generated autoloads from forge-pullreq.el + +(register-definition-prefixes "forge-pullreq" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-repo" "forge-repo.el" (0 0 0 0)) +;;; Generated autoloads from forge-repo.el + +(register-definition-prefixes "forge-repo" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-revnote" "forge-revnote.el" (0 0 0 0)) +;;; Generated autoloads from forge-revnote.el + +(register-definition-prefixes "forge-revnote" '("forge-revnote")) + +;;;*** + +;;;### (autoloads nil "forge-semi" "forge-semi.el" (0 0 0 0)) +;;; Generated autoloads from forge-semi.el + +(register-definition-prefixes "forge-semi" '("forge-")) + +;;;*** + +;;;### (autoloads nil "forge-topic" "forge-topic.el" (0 0 0 0)) +;;; Generated autoloads from forge-topic.el + +(register-definition-prefixes "forge-topic" '("forge-")) + +;;;*** + +;;;### (autoloads nil nil ("forge-pkg.el") (0 0 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; forge-autoloads.el ends here diff --git a/elpa/forge-20230505.926/forge-bitbucket.el b/elpa/forge-20230505.926/forge-bitbucket.el new file mode 100644 index 00000000..c677e036 --- /dev/null +++ b/elpa/forge-20230505.926/forge-bitbucket.el @@ -0,0 +1,46 @@ +;;; forge-bitbucket.el --- Bitbucket support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Code: + +(require 'buck) +(require 'forge) + +;;; Class + +(defclass forge-bitbucket-repository (forge-noapi-repository) + ((issues-url-format :initform "https://%h/%o/%n/issues") + (issue-url-format :initform "https://%h/%o/%n/issues/%i") + ;; The anchor for the issue itself is .../%i#issue-%i + (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#comment-%I") + (pullreqs-url-format :initform "https://%h/%o/%n/pull-requests") + (pullreq-url-format :initform "https://%h/%o/%n/pull-requests/%i") + (pullreq-post-url-format :initform "https://%h/%o/%n/pull-requests/%i#comment-%I") + (commit-url-format :initform "https://%h/%o/%n/commits/%r") + (branch-url-format :initform "https://%h/%o/%n/branch/%r") + (remote-url-format :initform "https://%h/%o/%n/src") + (create-issue-url-format :initform "https://%h/%o/%n/issues/new") + (create-pullreq-url-format :initform "https://%h/%o/%n/pull-requests/new"))) + +;;; _ +(provide 'forge-bitbucket) +;;; forge-bitbucket.el ends here diff --git a/elpa/forge-20230505.926/forge-commands.el b/elpa/forge-20230505.926/forge-commands.el new file mode 100644 index 00000000..859f3ce8 --- /dev/null +++ b/elpa/forge-20230505.926/forge-commands.el @@ -0,0 +1,1139 @@ +;;; forge-commands.el --- Commands -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Code: + +(require 'forge) + +;;; Options + +(defcustom forge-add-pullreq-refspec t + "Whether the pull-request refspec is added when setting up a repository. + +This controls whether running `forge-pull' for the first time in +a repository also adds a refspec that fetches all pull-requests. +In repositories with huge numbers of pull-requests you might want +to not do so, in which case you should set this option to `ask'. + +You can also set this to nil and later add the refspec explicitly +for a repository using the command `forge-add-pullreq-refspec'." + :package-version '(forge . "0.2.0") + :group 'forge + :type '(choice (const :tag "Always add refspec" t) + (const :tag "Ask every time" ask) + (const :tag "Never add refspec" nil))) + +(defcustom forge-checkout-worktree-read-directory-function + 'forge-checkout-worktree-default-read-directory-function + "Function used by `forge-checkout-worktree' to read worktree directory. +Takes the pull-request as only argument and must return a directory." + :package-version '(forge . "0.4.0") + :group 'forge + :type 'function) + +;;; Dispatch + +;;;###autoload (autoload 'forge-dispatch "forge-commands" nil t) +(transient-define-prefix forge-dispatch () + "Dispatch a forge command." + [["Fetch" + ("f f" "all topics" forge-pull) + ("f t" "one topic" forge-pull-topic) + ("f n" "notifications" forge-pull-notifications) + """Create" + ("c i" "issue" forge-create-issue) + ("c p" "pull-request" forge-create-pullreq) + ("c u" "pull-request from issue" forge-create-pullreq-from-issue + :if (lambda () (forge-github-repository-p (forge-get-repository nil)))) + ("c f" "fork or remote" forge-fork) + """Merge" + (7 "M " "merge using API" forge-merge)] + ["List" + ("l t" "topics" forge-list-topics) + ("l i" "issues" forge-list-issues) + ("l p" "pull-requests" forge-list-pullreqs) + ("l n" "notifications" forge-list-notifications) + ("l r" "repositories" forge-list-repositories) + (7 "l a" "awaiting review" forge-list-requested-reviews) + (7 "n i" "labeled issues" forge-list-labeled-issues) + (7 "n p" "labeled pull-requests" forge-list-labeled-pullreqs) + (7 "m i" "authored issues" forge-list-authored-issues) + (7 "m p" "authored pull-requests" forge-list-authored-pullreqs) + (7 "o i" "owned issues" forge-list-owned-issues) + (7 "o p" "owned pull-requests" forge-list-owned-pullreqs) + (7 "o r" "owned repositories" forge-list-owned-repositories)] + ["Visit" + ("v t" "topic" forge-visit-topic) + ("v i" "issue" forge-visit-issue) + ("v p" "pull-request" forge-visit-pullreq) + """Browse" + ("b I" "issues" forge-browse-issues) + ("b P" "pull-requests" forge-browse-pullreqs) + ("b t" "topic" forge-browse-topic) + ("b i" "issue" forge-browse-issue) + ("b p" "pull-request" forge-browse-pullreq) + ("b r" "remote" forge-browse-remote)]] + [["Configure" + ("a " "add repository to database" forge-add-repository) + ("r " "forge.remote" forge-forge.remote) + ("t l" "forge.graphqlItemLimit" forge-forge.graphqlItemLimit + :if (lambda () (forge-github-repository-p (forge-get-repository nil)))) + ("t t" forge-toggle-display-in-status-buffer) + ("t c" forge-toggle-closed-visibility)]]) + +;;; Pull + +;;;###autoload +(defun forge-pull (&optional repo until interactive) + "Pull topics from the forge repository. + +With a prefix argument and if the repository has not been fetched +before, then read a date from the user and limit pulled topics to +those that have been updated since then. + +If pulling is too slow, then also consider setting the Git variable +`forge.omitExpensive' to `true'. +\n(fn &optional REPO UNTIL)" + (interactive + (list nil + (and current-prefix-arg + (not (forge-get-repository 'full)) + (forge-read-date "Limit pulling to topics updates since: ")) + t)) + (let (create) + (unless repo + (setq repo (forge-get-repository 'full)) + (unless repo + (setq repo (forge-get-repository 'create)) + (setq create t))) + (when (or create interactive (magit-git-config-p "forge.autoPull" t)) + (forge--zap-repository-cache repo) + (when (and interactive + (oref repo selective-p) + (yes-or-no-p + (format "Always pull all of %s/%s's topics going forward?" + (oref repo owner) + (oref repo name)))) + (oset repo selective-p nil)) + (setq forge--mode-line-buffer (current-buffer)) + (when-let* ((remote (oref repo remote)) + (refspec (oref repo pullreq-refspec))) + (when (and create + (not (member refspec (magit-get-all "remote" remote "fetch"))) + (or (eq forge-add-pullreq-refspec t) + (and (eq forge-add-pullreq-refspec 'ask) + (y-or-n-p (format "Also add %S refspec? " refspec))))) + (magit-call-git "config" "--add" + (format "remote.%s.fetch" remote) + refspec))) + (forge--msg repo t nil "Pulling REPO") + (forge--pull repo until)))) + +(defun forge-read-date (prompt) + (cl-block nil + (while t + (let ((str (read-from-minibuffer prompt))) + (cond ((string-equal str "") + (cl-return nil)) + ((string-match-p + "\\`[0-9]\\{4\\}[-/][0-9]\\{2\\}[-/][0-9]\\{2\\}\\'" str) + (cl-return str)))) + (message "Please enter a date in the format YYYY-MM-DD.") + (sit-for 1)))) + +(cl-defmethod forge--pull ((repo forge-noapi-repository) _until) ; NOOP + (forge--msg repo t t "Pulling from REPO is not supported")) + +(cl-defmethod forge--pull ((repo forge-unusedapi-repository) _until) + (oset repo sparse-p nil) + (magit-git-fetch (oref repo remote) (magit-fetch-arguments))) + +(defun forge--git-fetch (buf dir repo) + (if (buffer-live-p buf) + (with-current-buffer buf + (magit-git-fetch (oref repo remote) (magit-fetch-arguments))) + (let ((default-directory dir)) + (magit-git-fetch (oref repo remote) (magit-fetch-arguments))))) + +;;;###autoload +(defun forge-pull-notifications () + "Fetch notifications for all repositories from the current forge." + (interactive) + (let* ((repo (forge-get-repository 'stub)) + (class (eieio-object-class repo))) + (if (eq class 'forge-github-repository) + (forge--pull-notifications class (oref repo githost)) + (user-error "Fetching notifications not supported for forge %S" + (oref repo forge))))) + +;;;###autoload +(defun forge-pull-topic (topic) + "Pull the API data for the current topic. +If there is no current topic or with a prefix argument read a +TOPIC to pull instead." + (interactive (list (forge-read-topic "Pull topic" nil t))) + (let ((repo (forge-get-repository t))) + (forge--zap-repository-cache repo) + (forge--pull-topic repo + (if (numberp topic) + (forge-issue :repository (oref repo id) + :number topic) + (forge-get-topic topic))))) + +(cl-defmethod forge--pull-topic ((repo forge-repository) _topic) + (error "Fetching an individual topic not implemented for %s" + (eieio-object-class repo))) + +(defun forge--zap-repository-cache (&optional repo) + (when-let ((r (if repo + (oref repo worktree) + (magit-repository-local-repository)))) + (magit-repository-local-delete (list 'forge-ls-recent-topics 'issue) r) + (magit-repository-local-delete (list 'forge-ls-recent-topics 'pullreq) r))) + +;;; Browse + +;;;###autoload +(defun forge-browse-dwim () + "Visit a topic, branch or commit using a browser. +Prefer a topic over a branch and that over a commit." + (interactive) + (if-let ((topic (forge-topic-at-point))) + (forge-browse topic) + (if-let ((branch (magit-branch-at-point))) + (forge-browse-branch branch) + (call-interactively #'forge-browse-commit)))) + +;;;###autoload +(defun forge-browse-commit (rev) + "Visit the url corresponding to REV using a browser." + (interactive + (list (or (magit-completing-read "Browse commit" + (magit-list-branch-names) + nil nil nil 'magit-revision-history + (magit-branch-or-commit-at-point)) + (user-error "Nothing selected")))) + (let ((repo (forge-get-repository 'stub))) + (unless (magit-list-containing-branches + rev "-r" (concat (oref repo remote) "/*")) + (if-let ((branch (car (magit-list-containing-branches rev "-r")))) + (setq repo (forge-get-repository + 'stub (cdr (magit-split-branch-name branch)))) + (message "%s does not appear to be available on any remote. %s" + rev "You might have to push it first."))) + (browse-url + (forge--format repo 'commit-url-format + `((?r . ,(magit-commit-p rev))))))) + +;;;###autoload +(defun forge-copy-url-at-point-as-kill () + "Copy the url of the thing at point." + (interactive) + (if-let ((url (forge-get-url (or (forge-post-at-point) + (forge-current-topic))))) + (progn + (kill-new url) + (message "Copied %S" url)) + (user-error "Nothing at point with a URL"))) + +;;;###autoload +(defun forge-browse-branch (branch) + "Visit the url corresponding BRANCH using a browser." + (interactive (list (magit-read-branch "Browse branch"))) + (let (remote) + (if (magit-remote-branch-p branch) + (let ((cons (magit-split-branch-name branch))) + (setq remote (car cons)) + (setq branch (cdr cons))) + (or (setq remote (or (magit-get-push-remote branch) + (magit-get-upstream-remote branch))) + (user-error "Cannot determine remote for %s" branch))) + (browse-url (forge--format remote 'branch-url-format + `((?r . ,branch)))))) + +;;;###autoload +(defun forge-browse-remote (remote) + "Visit the url corresponding to REMOTE using a browser." + (interactive (list (magit-read-remote "Browse remote"))) + (browse-url (forge--format remote 'remote-url-format))) + +;;;###autoload +(defun forge-browse-repository (repo) + "View the current repository in a separate buffer." + (interactive + (list (or (forge-current-repository) + (forge-get-repository + (forge-read-repository "Browse repository"))))) + (browse-url (forge--format repo 'remote-url-format))) + +;;;###autoload +(defun forge-browse-topic () + "Visit the current topic using a browser." + (interactive) + (if-let ((topic (forge-current-topic))) + (forge-browse topic) + (user-error "There is no current topic"))) + +;;;###autoload +(defun forge-browse-pullreqs () + "Visit the pull-requests of the current repository using a browser." + (interactive) + (browse-url (forge--format (forge-get-repository 'stub) + 'pullreqs-url-format))) + +;;;###autoload +(defun forge-browse-pullreq (pullreq) + "Visit the url corresponding to PULLREQ using a browser." + (interactive (list (forge-read-pullreq "Browse pull-request" t))) + (forge-browse (forge-get-pullreq pullreq))) + +;;;###autoload +(defun forge-browse-issues () + "Visit the issues of the current repository using a browser." + (interactive) + (browse-url (forge--format (forge-get-repository 'stub) + 'issues-url-format))) + +;;;###autoload +(defun forge-browse-issue (issue) + "Visit the current issue using a browser. +If there is no current issue or with a prefix argument +read an ISSUE to visit." + (interactive (list (forge-read-issue "Browse issue" t))) + (forge-browse (forge-get-issue issue))) + +;;;###autoload +(defun forge-browse-post () + "Visit the current post using a browser." + (interactive) + (if-let ((post (forge-post-at-point))) + (forge-browse post) + (user-error "There is no current post"))) + +;;; Visit + +;;;###autoload +(defun forge-visit-topic (topic) + "View the current topic in a separate buffer. +If there is no current topic or with a prefix argument +read a topic to visit instead." + (interactive (list (if-let ((topic (forge-current-topic))) + (oref topic id) + (forge-read-topic "View topic")))) + (forge-visit (forge-get-topic topic))) + +;;;###autoload +(defun forge-visit-pullreq (pullreq) + "View the current pull-request in a separate buffer. +If there is no current pull-request or with a prefix argument +read a PULLREQ to visit instead. If point is looking at a pullreq +reference with Gitlab/Github notation try to visit the pullreq +with that number." + (interactive (list (forge-read-pullreq "View pull-request" t))) + (forge-visit (forge-get-pullreq pullreq))) + +;;;###autoload +(defun forge-visit-issue (issue) + "Visit the current issue in a separate buffer. +If there is no current issue or with a prefix argument read an +ISSUE to visit instead. If point is looking at an issue reference +with Gitlab/Github notation try to visit the issue with that +number." + (interactive (list (forge-read-issue "View issue" t))) + (forge-visit (forge-get-issue issue))) + +;;;###autoload +(defun forge-visit-repository (repo) + "View the current repository in a separate buffer." + (interactive + (list (or (forge-current-repository) + (forge-get-repository + (forge-read-repository "Visit repository"))))) + (forge-visit repo)) + +;;; Create + +(defun forge-create-pullreq (source target) + "Create a new pull-request for the current repository." + (interactive (forge-create-pullreq--read-args)) + (let* ((repo (forge-get-repository t)) + (buf (forge--prepare-post-buffer + "new-pullreq" + (forge--format repo "Create new pull-request on %p") + source target))) + (with-current-buffer buf + (setq forge--buffer-base-branch target) + (setq forge--buffer-head-branch source) + (setq forge--buffer-post-object repo) + (setq forge--submit-post-function #'forge--submit-create-pullreq) + (run-hooks 'forge-create-pullreq-hook)) + (forge--display-post-buffer buf))) + +(defun forge-create-pullreq-from-issue (issue source target) + "Convert an existing ISSUE into a pull-request." + (interactive (cons (forge-read-issue "Convert issue") + (forge-create-pullreq--read-args))) + (setq issue (forge-get-issue issue)) + (forge--create-pullreq-from-issue (forge-get-repository issue) + issue source target)) + +(defun forge-create-pullreq--read-args () + (let* ((source (magit-completing-read + "Source branch" + (magit-list-remote-branch-names) + nil t nil 'magit-revision-history + (or (and-let* ((d (magit-branch-at-point))) + (if (magit-remote-branch-p d) + d + (magit-get-push-branch d t))) + (and-let* ((d (magit-get-current-branch))) + (if (magit-remote-branch-p d) + d + (magit-get-push-branch d t)))))) + (repo (forge-get-repository t)) + (remote (oref repo remote)) + (targets (delete source (magit-list-remote-branch-names remote))) + (target (magit-completing-read + "Target branch" targets nil t nil 'magit-revision-history + (let* ((d (cdr (magit-split-branch-name source))) + (d (and (magit-branch-p d) d)) + (d (and d (magit-get-upstream-branch d))) + (d (and d (if (magit-remote-branch-p d) + d + (magit-get-upstream-branch d)))) + (d (or d (concat remote "/" + (or (oref repo default-branch) + "master"))))) + (car (member d targets)))))) + (list source target))) + +(defun forge-create-issue () + "Create a new issue for the current repository." + (interactive) + (let* ((repo (forge-get-repository t)) + (buf (forge--prepare-post-buffer + "new-issue" + (forge--format repo "Create new issue on %p")))) + (when buf + (with-current-buffer buf + (setq forge--buffer-post-object repo) + (setq forge--submit-post-function #'forge--submit-create-issue)) + (forge--display-post-buffer buf)))) + +(defun forge-create-post (&optional quote) + "Create a new post on an existing topic. +If the region is active, then quote that part of the post. +Otherwise and with a prefix argument quote the post that +point is currently on." + (interactive (list current-prefix-arg)) + (unless (derived-mode-p 'forge-topic-mode) + (user-error "This command is only available from topic buffers")) + (let* ((topic forge-buffer-topic) + (buf (forge--prepare-post-buffer + (forge--format topic "%i;new-comment") + (forge--format topic "New comment on #%i of %p"))) + (quote (cond + ((not (magit-section-match 'post)) nil) + ((use-region-p) + (buffer-substring-no-properties (region-beginning) + (region-end))) + (quote + (let ((section (magit-current-section))) + (string-trim-right + (buffer-substring-no-properties (oref section content) + (oref section end)))))))) + (with-current-buffer buf + (setq forge--buffer-post-object topic) + (setq forge--submit-post-function #'forge--submit-create-post) + (when quote + (goto-char (point-max)) + (unless (bobp) + (insert "\n")) + (insert (replace-regexp-in-string "^" "> " quote) "\n\n"))) + (forge--display-post-buffer buf))) + +;;; Edit + +(defun forge-edit-post () + "Edit the current post." + (interactive) + (let* ((post (or (forge-post-at-point) + (user-error "There is no current post"))) + (buf (cl-typecase post + (forge-topic + (forge--prepare-post-buffer + (forge--format post "%i") + (forge--format post "Edit #%i of %p"))) + (forge-post + (forge--prepare-post-buffer + (forge--format post "%i;%I") + (forge--format post "Edit comment on #%i of %p")))))) + (with-current-buffer buf + (setq forge--buffer-post-object post) + (setq forge--submit-post-function #'forge--submit-edit-post) + (erase-buffer) + (when (cl-typep post 'forge-topic) + (insert "# " (oref post title) "\n\n")) + (insert (oref post body))) + (forge--display-post-buffer buf))) + +(defun forge-edit-topic-title (topic) + "Edit the title of the current topic. +If there is no current topic or with a prefix argument read a +TOPIC and modify that instead." + (interactive (list (forge-read-topic "Edit title of"))) + (let ((topic (forge-get-topic topic))) + (forge--set-topic-title + (forge-get-repository topic) topic + (read-string "Title: " (oref topic title))))) + +(defun forge-edit-topic-state (topic) + "Close or reopen the current topic. +If there is no current topic or with a prefix argument read a +TOPIC and modify that instead." + (interactive + (let* ((id (forge-read-topic "Close/reopen")) + (topic (forge-get-topic id))) + (if (magit-y-or-n-p + (format "%s %S" + (cl-ecase (oref topic state) + (merged (error "Merged pull-requests cannot be reopened")) + (closed "Reopen") + (open "Close")) + (car (forge--topic-format-choice topic)))) + (list id) + (user-error "Abort")))) + (let ((topic (forge-get-topic topic))) + (forge--set-topic-state (forge-get-repository topic) topic))) + +(defun forge-edit-topic-draft (pullreq) + "Toggle whether the current pull-request is a draft. +If there is no current topic or with a prefix argument read a +TOPIC and modify that instead." + (interactive (list (forge-read-pullreq "Toggle draft state of"))) + (let ((pullreq (forge-get-pullreq pullreq))) + (forge--set-topic-draft (forge-get-repository pullreq) + pullreq + (not (oref pullreq draft-p))))) + +(defun forge-edit-topic-milestone (topic) + (interactive (list (forge-read-topic "Edit milestone of"))) + (let* ((topic (forge-get-topic topic)) + (repo (forge-get-repository topic))) + (forge--set-topic-milestone + repo topic + (magit-completing-read + "Milestone" + (mapcar #'caddr (oref repo milestones)) + nil t (forge--get-topic-milestone topic))))) + +(defun forge-edit-topic-labels (topic) + "Edit the labels of the current topic. +If there is no current topic or with a prefix argument read a +TOPIC and modify that instead." + (interactive (list (forge-read-topic "Edit labels of"))) + (let* ((topic (forge-get-topic topic)) + (repo (forge-get-repository topic)) + (crm-separator ",")) + (forge--set-topic-labels + repo topic (magit-completing-read-multiple + "Labels: " + (mapcar #'cadr (oref repo labels)) + nil t + (mapconcat #'car (closql--iref topic 'labels) ","))))) + +(defun forge-edit-topic-marks (topic marks) + "Edit the marks of the current topic. +If there is no current topic or with a prefix argument read a +TOPIC and modify that instead." + (interactive + (let ((topic (forge-read-topic "Edit marks of"))) + (list topic (forge-read-marks "Marks: " (forge-get-topic topic))))) + (oset (forge-get-topic topic) marks marks) + (magit-refresh)) + +(defun forge-edit-topic-assignees (topic) + "Edit the assignees of the current topic. +If there is no current topic or with a prefix argument read a +TOPIC and modify that instead." + (interactive (list (forge-read-topic "Edit assignees of"))) + (let* ((topic (forge-get-topic topic)) + (repo (forge-get-repository topic)) + (value (closql--iref topic 'assignees)) + (choices (mapcar #'cadr (oref repo assignees))) + (crm-separator ",")) + (forge--set-topic-assignees + repo topic + (magit-completing-read-multiple + "Assignees: " choices nil + (if (forge--childp repo 'forge-gitlab-repository) + t ; Selecting something else would fail later on. + 'confirm) + (mapconcat #'car value ","))))) + +(defun forge-edit-topic-review-requests (pullreq) + "Edit the review-requests of the current pull-request. +If there is no current topic or with a prefix argument read a +PULLREQ and modify that instead." + (interactive (list (forge-read-pullreq "Request review for"))) + (let* ((topic (forge-get-pullreq pullreq)) + (repo (forge-get-repository topic)) + (value (closql--iref topic 'review-requests)) + (choices (mapcar #'cadr (oref repo assignees))) + (crm-separator ",")) + (forge--set-topic-review-requests + repo topic + (magit-completing-read-multiple + "Request review from: " choices nil + 'confirm + (mapconcat #'car value ","))))) + +(defun forge-edit-topic-note (topic) + "Edit your private note about the current topic. +If there is no current topic or with a prefix argument read a +TOPIC and modify that instead." + (interactive (list (forge-read-topic "Edit note about"))) + (let* ((topic (forge-get-topic topic)) + (buf (forge--prepare-post-buffer + (forge--format topic "%i;note") + (forge--format topic "New note on #%i of %p")))) + (with-current-buffer buf + (setq forge--buffer-post-object topic) + (setq forge--submit-post-function #'forge--save-note) + (erase-buffer) + (when-let ((note (oref topic note))) + (save-excursion (insert note ?\n)))) + (forge--display-post-buffer buf))) + +;;; Delete + +(defun forge-delete-comment (comment) + "Delete the comment at point." + (interactive (list (or (forge-comment-at-point) + (user-error "There is no comment at point")))) + (when (yes-or-no-p "Do you really want to delete the selected comment? ") + (forge--delete-comment (forge-get-repository t) comment))) + +;;; Branch + +;;;###autoload +(defun forge-branch-pullreq (pullreq) + "Create and configure a new branch from a pull-request. +Please see the manual for more information." + (interactive (list (forge-read-pullreq "Branch pull request" t))) + (let ((pullreq (forge-get-pullreq pullreq))) + (if-let ((branch (forge--pullreq-branch-active pullreq))) + (progn (message "Branch %S already exists and is configured" branch) + branch) + (forge--branch-pullreq (forge-get-repository pullreq) pullreq) + (magit-refresh)))) + +(cl-defmethod forge--branch-pullreq ((pullreq forge-pullreq)) + (forge--branch-pullreq (forge-get-repository pullreq) pullreq)) + +(cl-defmethod forge--branch-pullreq ((_repo forge-unusedapi-repository) pullreq) + ;; We don't know enough to do a good job. + (let* ((number (oref pullreq number)) + (branch (format "pr-%s" number))) + (when (magit-branch-p branch) + (user-error "Branch `%s' already exists" branch)) + (magit-git "branch" branch (forge--pullreq-ref pullreq)) + ;; More often than not this is the correct target branch. + (magit-call-git "branch" branch "--set-upstream-to=master") + (magit-set (number-to-string number) "branch" branch "pullRequest") + branch)) + +(cl-defmethod forge--branch-pullreq ((repo forge-repository) pullreq) + (let* ((number (oref pullreq number)) + (branch-n (format "pr-%s" number)) + (branch (or (forge--pullreq-branch-internal pullreq) branch-n)) + (pullreq-ref (format "refs/pullreqs/%s" number))) + (cond ((and-let* ((pr-branch (oref pullreq head-ref))) + (string-search ":" pr-branch)) + ;; Such a branch name would be invalid. If we encounter + ;; it anyway, then that means that the source branch and + ;; the merge-request ref are missing. Luckily Gitlab no + ;; longer does this, but we nevertheless have to deal + ;; with merge-requests that have been lost in time. + (error "Cannot check out this merge-request because %s" + "on old Gitlab version discarded the source branch")) + ((not (eq (oref pullreq state) 'open)) + (magit-git "branch" "--force" branch pullreq-ref)) + (t + (let ((upstream (oref repo remote)) + (pr-remote (oref pullreq head-user)) + (pr-branch (oref pullreq head-ref))) + (cond ((not (oref pullreq cross-repo-p)) + (let ((tracking (concat upstream "/" pr-branch))) + (unless (magit-branch-p tracking) + (magit-call-git "fetch" upstream)) + (forge--setup-pullreq-branch branch tracking) + (magit-branch-maybe-adjust-upstream branch tracking) + (magit-set upstream "branch" branch "pushRemote") + (magit-set upstream "branch" branch "pullRequestRemote"))) + ((not pr-branch) + ;; The pullreq branch (on Github) has been deleted. + (setq pr-remote nil) + (setq branch branch-n) + (forge--setup-pullreq-branch branch pullreq-ref) + (magit-set upstream "branch" branch "pushRemote")) + (t + ;; For prs within the upstream we are more permissive, + ;; but any request to merge a branch with a well known + ;; name from fork, is highly suspicious and likely the + ;; result of a contributor not bothering to name their + ;; feature branch. + (when (and (member branch magit-main-branch-names) + (magit-branch-p branch)) + (setq branch branch-n)) + (forge--setup-pullreq-remote pullreq) + (forge--setup-pullreq-branch + branch (concat pr-remote "/" pr-branch)) + (if (and (oref pullreq editable-p) + (equal branch pr-branch)) + (magit-set pr-remote "branch" branch "pushRemote") + (magit-set upstream "branch" branch "pushRemote")))) + (when pr-remote + (magit-set pr-remote "branch" branch "pullRequestRemote")) + (magit-set "true" "branch" branch "rebase") + (magit-git "branch" branch + (let ((base-ref (oref pullreq base-ref))) + (concat "--set-upstream-to=" + (if (or magit-branch-prefer-remote-upstream + (not (magit-branch-p base-ref))) + (concat upstream "/" base-ref) + base-ref))))))) + (magit-set (number-to-string number) "branch" branch "pullRequest") + (magit-set (oref pullreq title) "branch" branch "description") + branch)) + +(defun forge--setup-pullreq-branch (branch tracking) + (if (magit-branch-p branch) + (unless (magit-rev-equal branch tracking) + (message "Existing branch %s diverged from %s" branch tracking)) + (magit-git "branch" branch tracking))) + +(defun forge--setup-pullreq-remote (pullreq) + (let* ((pr-remote (oref pullreq head-user)) + (pr-branch (oref pullreq head-ref)) + (repo (forge-get-repository pullreq)) + (host (oref repo githost)) + (fork (oref pullreq head-repo))) + (if (magit-remote-p pr-remote) + (let ((url (magit-git-string "remote" "get-url" pr-remote)) + (fetch (magit-get-all "remote" pr-remote "fetch"))) + (unless (forge--url-equal url (format "git@%s:%s.git" host fork)) + (user-error "Remote `%s' already exists but does not point to %s" + pr-remote url)) + (unless (or (member (format "+refs/heads/*:refs/remotes/%s/*" + pr-remote) + fetch) + (member (format "+refs/heads/%s:refs/remotes/%s/%s" + pr-branch pr-remote pr-branch) + fetch)) + (magit-git "remote" "set-branches" "--add" pr-remote pr-branch) + (magit-git "fetch" pr-remote))) + (let ((url (magit-git-string "remote" "get-url" (oref repo remote)))) + (magit-git + "remote" "add" "-f" "--no-tags" + "-t" pr-branch pr-remote + (cond ((or (string-prefix-p "git@" url) + (string-prefix-p "ssh://git@" url)) + (format "git@%s:%s.git" host fork)) + ((string-prefix-p "https://" url) + (format "https://%s/%s.git" host fork)) + ((string-prefix-p "git://" url) + (format "git://%s/%s.git" host fork)) + ((string-prefix-p "http://" url) + (format "http://%s/%s.git" host fork)) + ((error "%s has an unexpected format" url)))))))) + +;;;###autoload +(defun forge-checkout-pullreq (pullreq) + "Create, configure and checkout a new branch from a pull-request. +Please see the manual for more information." + (interactive (list (forge-read-pullreq "Checkout pull request" t))) + (magit-checkout (forge--branch-pullreq (forge-get-pullreq pullreq)))) + +;;;###autoload +(defun forge-checkout-worktree (path pullreq) + "Create, configure and checkout a new worktree from a pull-request. +This is like `forge-checkout-pullreq', except that it also +creates a new worktree. Please see the manual for more +information." + (interactive + (let ((id (forge-read-pullreq "Checkout pull request" t))) + (list (funcall forge-checkout-worktree-read-directory-function + (forge-get-pullreq id)) + id))) + (when (and (file-exists-p path) + (not (and (file-directory-p path) + (length= (directory-files path) 2)))) + (user-error "%s already exists and isn't empty" path)) + (magit-worktree-checkout path + (forge--branch-pullreq (forge-get-pullreq pullreq)))) + +(defun forge-checkout-worktree-default-read-directory-function (pullreq) + (with-slots (number head-ref) pullreq + (let ((path (read-directory-name + (format "Checkout #%s in new worktree: " number) + (file-name-directory + (directory-file-name default-directory)) + nil nil + (let ((branch (forge--pullreq-branch-internal pullreq))) + (if (string-match-p "\\`pr-[0-9]+\\'" branch) + (number-to-string number) + (format "%s-%s" number + (string-replace "/" "-" head-ref))))))) + (when (equal path "") + (user-error "The empty string isn't a valid path")) + path))) + +;;; Marks + +(defun forge-create-mark (name face description) + "Define a new mark that topics can be marked with." + (interactive + (list (read-string "Name: ") + (magit-read-char-case "Set appearance using " nil + (?n "a face [n]ame" + (read-face-name "Face name: ")) + (?s "face [s]exp" + (read-from-minibuffer + "Face sexp: " + "(:background \"\" :foreground \"\" :box t)" + read-expression-map t))) + (let ((str (read-string "Description: "))) + (and (not (equal str "")) str)))) + (forge-sql [:insert-into mark :values $v1] + (vector nil (forge--uuid) name face description))) + +(defun forge-edit-mark (id name face description) + "Define a new mark that topics can be marked with." + (interactive + (pcase-let ((`(,id ,name ,face ,description) + (forge-read-mark "Edit mark"))) + (list id + (read-string "Name: " name) + (magit-read-char-case "Set appearance using " nil + (?n "a face [n]ame" + (read-face-name "Face name: " (and (symbolp face) face))) + (?s "face [s]exp" + (read-from-minibuffer + "Face sexp: " + (if (listp face) + (format "%S" face) + "(:background \"\" :foreground \"\" :box t)") + read-expression-map t))) + (let ((str (read-string "Description: " nil nil description))) + (and (not (equal str "")) str))))) + (forge-sql [:update mark + :set (= [name face description] $v1) + :where (= id $s2)] + (vector name face description) id)) + +(defun forge-read-mark (prompt) + "Read a topic. Return (ID NAME FACE DESCRIPTION)." + (let* ((marks (forge-sql [:select [id name face description] :from mark])) + (name (completing-read prompt (mapcar #'cadr marks) nil t))) + (--first (equal (cadr it) name) marks))) + +(defun forge-read-marks (prompt &optional topic) + "Read multiple mark names and return the respective ids." + (let ((marks (forge-sql [:select [name id] :from mark])) + (crm-separator ",")) + (--map (cadr (assoc it marks)) + (magit-completing-read-multiple + prompt (mapcar #'car marks) nil t + (and topic + (mapconcat #'car (closql--iref topic 'marks) ",")))))) + +(defun forge-toggle-mark (mark) + "Toggle MARK for the current topic." + (if-let ((topic (forge-current-topic))) + (let* ((value (mapcar #'car (closql--iref topic 'marks))) + (value (if (member mark value) + (delete mark value) + (cons mark value))) + (marks (forge-sql [:select [name id] :from mark]))) + (oset topic marks (--map (cadr (assoc it marks)) value)) + (magit-refresh)) + (user-error "There is no topic at point"))) + +;;; Fork + +;;;###autoload +(defun forge-fork (fork remote) + "Fork the current repository to FORK and add it as a REMOTE. +If the fork already exists, then that isn't an error; the remote +is added anyway. Currently this only supports Github and Gitlab." + (interactive + (let ((fork (magit-completing-read "Fork to" + (mapcar #'car forge-owned-accounts)))) + (list fork + (read-string "Remote name: " + (or (plist-get (cdr (assoc fork forge-owned-accounts)) + 'remote-name) + fork))))) + (let ((repo (forge-get-repository 'stub))) + (forge--fork-repository repo fork) + (magit-remote-add remote + (magit-clone--format-url (oref repo githost) fork + (oref repo name)) + (list "--fetch")))) + +;;; Misc + +(transient-define-infix forge-forge.remote () + "Change the local value of the `forge.remote' Git variable." + :class 'magit--git-variable:choices + :variable "forge.remote" + :choices #'magit-list-remotes + :default (lambda (_) (forge--get-remote t))) + +;;;###autoload +(defun forge-list-notifications () + "List notifications." + (interactive) + (forge-notifications-setup-buffer)) + +(transient-define-suffix forge-toggle-display-in-status-buffer () + "Toggle whether to display topics in the current status buffer." + :description (lambda () + (if forge-display-in-status-buffer + "hide all topics" + "display topics")) + (interactive) + (setq forge-display-in-status-buffer (not forge-display-in-status-buffer)) + (magit-refresh)) + +(transient-define-suffix forge-toggle-closed-visibility () + "Toggle whether to display recently closed topics. +This only affect the current status buffer." + :description (lambda () + (if (or (atom forge-topic-list-limit) + (> (cdr forge-topic-list-limit) 0)) + "hide closed topics" + "display recently closed topics")) + :inapt-if-not (lambda () forge-display-in-status-buffer) + (interactive) + (magit-repository-local-delete (list 'forge-ls-recent-topics 'issue)) + (magit-repository-local-delete (list 'forge-ls-recent-topics 'pullreq)) + (make-local-variable 'forge-topic-list-limit) + (if (atom forge-topic-list-limit) + (setq forge-topic-list-limit (cons forge-topic-list-limit 5)) + (setcdr forge-topic-list-limit (* -1 (cdr forge-topic-list-limit)))) + (magit-refresh)) + +(transient-define-infix forge-forge.graphqlItemLimit () + "Change the maximum number of GraphQL entities to pull at once." + :class 'magit--git-variable + :variable "forge.graphqlItemLimit" + :reader #'read-string + :default (lambda () (number-to-string ghub-graphql-items-per-request))) + +;;;###autoload +(defun forge-add-pullreq-refspec () + "Configure Git to fetch all pull-requests. +This is done by adding \"+refs/pull/*/head:refs/pullreqs/*\" +to the value of `remote.REMOTE.fetch', where REMOTE is the +upstream remote. Also fetch from REMOTE." + (interactive) + (let* ((repo (forge-get-repository 'stub)) + (remote (oref repo remote)) + (fetch (magit-get-all "remote" remote "fetch")) + (refspec (oref repo pullreq-refspec))) + (if (member refspec fetch) + (message "Pull-request refspec is already active") + (magit-call-git "config" "--add" + (format "remote.%s.fetch" remote) + refspec) + (magit-git-fetch remote (magit-fetch-arguments))))) + +;;;###autoload +(defun forge-add-repository (url) + "Add a repository to the database. +Offer to either pull topics (now and in the future) or to only +pull individual topics when the user invokes `forge-pull-topic'." + (declare (interactive-only t)) + (interactive + (let ((str (magit-read-string-ns + "Add repository to database (url or name)" + (and-let* ((repo (forge-get-repository 'stub)) + (remote (oref repo remote))) + (magit-git-string "remote" "get-url" remote))))) + (if (string-match-p "\\(://\\|@\\)" str) + (list str) + (list (magit-clone--name-to-url str))))) + (if (forge-get-repository url nil 'full) + (user-error "%s is already tracked in Forge database" url) + (let ((repo (forge-get-repository url nil 'create))) + (oset repo sparse-p nil) + (magit-read-char-case "Pull " nil + (?a "[a]ll topics" + (forge-pull repo)) + (?i "[i]ndividual topics (useful for casual contributors)" + (oset repo selective-p t) + (forge--pull repo nil)))))) + +;;;###autoload +(defun forge-add-user-repositories (host user) + "Add all of USER's repositories from HOST to the database. +This may take a while. Only Github is supported at the moment." + (interactive + (list (forge-read-host "Add repositories from Github host" + 'forge-github-repository) + (read-string "User: "))) + (forge--add-user-repos 'forge-github-repository host user)) + +;;;###autoload +(defun forge-add-organization-repositories (host organization) + "Add all of ORGANIZATION's repositories from HOST to the database. +This may take a while. Only Github is supported at the moment." + (interactive + (list (forge-read-host "Add repositories from Github host" + 'forge-github-repository) + (read-string "Organization: "))) + (forge--add-organization-repos 'forge-github-repository host organization)) + +;;;###autoload +(defun forge-merge (pullreq method) + "Merge the current pull-request using METHOD using the forge's API. + +If there is no current pull-request or with a prefix argument, +then read pull-request PULLREQ to visit instead. + +Use of this command is discouraged. Unless the remote repository +is configured to disallow that, you should instead merge locally +and then push the target branch. Forges detect that you have +done that and respond by automatically marking the pull-request +as merged." + (interactive + (list (forge-read-pullreq "Merge pull-request" t) + (if (forge--childp (forge-get-repository t) 'forge-gitlab-repository) + (magit-read-char-case "Merge method " t + (?m "[m]erge" 'merge) + (?s "[s]quash" 'squash)) + (magit-read-char-case "Merge method " t + (?m "[m]erge" 'merge) + (?s "[s]quash" 'squash) + (?r "[r]ebase" 'rebase))))) + (let ((pullreq (forge-get-pullreq pullreq))) + (forge--merge-pullreq (forge-get-repository pullreq) + pullreq + (magit-rev-hash + (forge--pullreq-branch-internal pullreq)) + method)) + (forge-pull)) + +;;;###autoload +(defun forge-remove-repository (host owner name) + "Remove a repository from the database." + (interactive + (pcase-let ((`(,githost ,owner ,name) + (forge-read-repository "Remove repository from db"))) + (if (yes-or-no-p + (format "Do you really want to remove \"%s/%s @%s\" from the db? " + owner name githost)) + (list githost owner name) + (user-error "Abort")))) + (closql-delete (forge-get-repository (list host owner name))) + (magit-refresh)) + +;;;###autoload +(defun forge-remove-topic-locally (topic) + "Remove a topic from the local database only. +Due to how the supported APIs work, it would be too expensive to +automatically remove topics from the local database that were +removed from the forge. The purpose of this command is to allow +you to manually clean up the local database." + (interactive (list (forge-read-topic "Delete topic LOCALLY only"))) + (setq topic (forge-get-topic topic)) + (closql-delete topic) + (if (and (derived-mode-p 'forge-topic-mode) + (eq (oref topic id) + (oref forge-buffer-topic id))) + (kill-buffer (current-buffer)) + (magit-refresh))) + +;;;###autoload +(defun forge-rename-default-branch () + "Rename the default branch to NEWNAME. +Change the name on the upstream remote and locally, and update +the upstream remotes of local branches accordingly." + (interactive) + (let* ((repo (forge-get-repository 'full)) + (_ (unless (forge-github-repository-p repo) + (user-error "Updating default branch not supported for forge `%s'" + (oref repo forge)))) + (remote (or (and (fboundp 'forge--get-remote) + (forge--get-remote)) + (magit-get-some-remote) + (user-error "No remote configured"))) + (symref (format "refs/remotes/%s/HEAD" remote)) + (oldhead (progn + (message "Determining old default branch...") + (magit-git "fetch" "--prune") + (magit-git "remote" "set-head" "--auto" remote) + (message "Determining old default branch...done") + (magit-git-string "symbolic-ref" "--short" symref))) + (oldname (if oldhead + (cdr (magit-split-branch-name oldhead)) + (error "Cannot determine old default branch"))) + (default (and (not (equal oldname "main")) "main")) + (newname (read-string + (format "Rename default branch `%s' to%s: " + oldname + (if default (format " (default: %s)" default) "")) + nil nil default))) + (message "Renaming default branch...") + (forge--set-default-branch repo newname oldname) + (magit-refresh) + (message "Renaming default branch...done"))) + +;;;###autoload +(defun forge-reset-database () + "Move the current database file to the trash. +This is useful after the database scheme has changed, which will +happen a few times while the forge functionality is still under +heavy development." + (interactive) + (when (and (file-exists-p forge-database-file) + (yes-or-no-p "Really trash Forge's database file? ")) + (when-let ((db (forge-db t))) + (emacsql-close db)) + (delete-file forge-database-file t) + (magit-refresh))) + +(defun forge-enable-sql-logging () + "Enable logging Forge's SQL queries." + (interactive) + (let ((db (forge-db))) + (emacsql-enable-debugging db) + (switch-to-buffer-other-window (emacsql-log-buffer (oref db connection))))) + +(magit-define-section-jumper forge-jump-to-pullreqs "Pull requests" pullreqs) +(magit-define-section-jumper forge-jump-to-issues "Issues" issues) + +;;; _ +(provide 'forge-commands) +;;; forge-commands.el ends here diff --git a/elpa/forge-20230505.926/forge-core.el b/elpa/forge-20230505.926/forge-core.el new file mode 100644 index 00000000..812c8391 --- /dev/null +++ b/elpa/forge-20230505.926/forge-core.el @@ -0,0 +1,370 @@ +;;; forge-core.el --- Core functionality -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Code: + +(require 'magit) + +(require 'cl-lib) +(require 'compat) +(require 'dash) +(require 'eieio) +(require 'subr-x) + +(require 'transient) + +(require 'forge-db) + +(eval-when-compile + (cl-pushnew 'id eieio--known-slot-names) + (cl-pushnew 'name eieio--known-slot-names) + (cl-pushnew 'owner eieio--known-slot-names) + (cl-pushnew 'number eieio--known-slot-names)) + +;;; Options + +(defgroup forge nil + "Options concerning Git forges." + :group 'magit) + +(defgroup forge-faces nil + "Faces concerning Git forges." + :group 'forge + :group 'magit-faces) + +(defcustom forge-alist + '(;; Forges + ("github.com" "api.github.com" + "github.com" forge-github-repository) + ("gitlab.com" "gitlab.com/api/v4" + "gitlab.com" forge-gitlab-repository) + ("salsa.debian.org" "salsa.debian.org/api/v4" + "salsa.debian.org" forge-gitlab-repository) + ("framagit.org" "framagit.org/api/v4" + "framagit.org" forge-gitlab-repository) + ("gitlab.gnome.org" "gitlab.gnome.org/api/v4" + "gitlab.gnome.org" forge-gitlab-repository) + ;; Forges (API unsupported) + ("codeberg.org" "codeberg.org/api/v1" + "codeberg.org" forge-gitea-repository) + ("code.orgmode.org" "code.orgmode.org/api/v1" + "code.orgmode.org" forge-gogs-repository) + ("bitbucket.org" "api.bitbucket.org/2.0" + "bitbucket.org" forge-bitbucket-repository) + ;; Semi-Forges + ("git.savannah.gnu.org" nil + "git.savannah.gnu.org" forge-cgit**-repository) + ("git.kernel.org" nil + "git.kernel.org" forge-cgit-repository) + ("repo.or.cz" nil + "repo.or.cz" forge-repoorcz-repository) + ("git.suckless.org" nil + "git.suckless.org" forge-stagit-repository) + ("git.sr.ht" nil + "git.sr.ht" forge-srht-repository)) + "List of Git forges. + +Each entry has the form (GITHOST APIHOST ID CLASS). + +GITHOST is matched against the host part of Git remote urls + using `forge--url-regexp' to identify the forge. +APIHOST is the api endpoint of the forge's api. +ID is used to identify the forge in the local database. +CLASS is the class to be used for repository from the forge. + +GITHOST and APIHOST can be changed, but ID and CLASS are final. +If you change ID, then the identity of every repository from +that forge changes. If you change CLASS, then things start +falling apart. + +There can be multiple elements that only differ in GITHOST. +Among those, the canonical element should come first. Any +elements that have the same APIHOST must also have the same +ID, and vice-versa. + +Complications: + +* When connecting to a Github Enterprise edition whose REST + API's end point is \"/v3\" and whose GraphQL API's + end point is \"/graphql\", then use \"/v3\" as + APIHOST. This is a historic accident. See issue #174. + +* This variable does not account for the possibility that the + git repository does not use the same address as the web + interface. That is another historic accident and if many + users are affected by it, we might have to fix it properly. + If you would like that, comment on issue #532. + + For now a workaround has to be used. Assuming the web + interface is available at \"example.com\" and the repository + is at \"ssh.example.com\", use \"example.com\" as GITHOST and + add something like this to \".gitconfig\": + + [url \"git@ssh.example.com\"] + insteadOf = git@example.com" + :package-version '(forge . "0.1.0") + :group 'forge + :type '(repeat (list (string :tag "Git host") + (choice (string :tag "API endpoint") + (const :tag "No API" nil)) + (string :tag "ID") + (symbol :tag "Repository class")))) + +(defcustom forge-pull-notifications nil + "Whether `forge-pull' also fetches notifications. +If this is nil, then `forge-pull-notifications' has to be used." + :package-version '(forge . "0.2.0") + :group 'forge + :type 'boolean) + +;;; Core + +(defclass forge-object (closql-object) () :abstract t) + +(cl-defgeneric forge-get-parent (object) + "Return the parent object of OBJECT. +The hierarchy is repository > topic > post. +For other objects return nil.") + +(cl-defgeneric forge-get-repository (demand) + "Return a forge repository object or nil, or signal an error. + +The DEMAND argument controls what to do when the object isn't +stored in the database yet, or if it is marked as sparse. The +valid values are: + +* `nil' If the repository is stored in the database then return + it, even if it is sparse. Otherwise return nil. + +* `t' If the repository isn't stored in the database or if the + object is sparse, then signal an error, informing the user + that `this-command' cannot be run until the repository has + been pulled. + +* `full' If the repository is stored in the database and the + object isn't sparse, then return it. Otherwise return nil. + +* `stub' If the repository is stored in the database, then return + it, regardless of whether it is sparse or not. Otherwise create + a new object and return it, but do not store it in the database. + In the latter case it is assumed that the caller does not need + the `id' and `forge-id' slots whose value differ from what they + would be if the object were retrieved from the database. + +* `create' This value is only intended to be used by commands + that fetch data from the API. If the repository is stored in + the database, then return that, regardless of whether the + object is sparse or not. If the repository is not stored in the + database, then make an API request to determine the ID used on + the forge, derive our own ID from that, and store a new sparse + object in the database and return it. + +If DEMAND is t, `stub' or `create', then also signal an error if +the repository cannot be determined because there is no matching +entry in `forge-alist'. + +Also update the object's `apihost', `githost' and `remote' slots +according to the respective entry in `forge-alist' and the REMOTE +argument. + +Also see info node `(forge) Repository Detection'.") + +(cl-defgeneric forge-get-topic () + "Return a forge issue or pullreq object.") + +(cl-defgeneric forge-get-issue () + "Return a forge issue object.") + +(cl-defgeneric forge-get-pullreq () + "Return a forge pullreq object.") + +(cl-defgeneric forge-get-url (obj) + "Return the URL for a forge object.") + +(cl-defgeneric forge-browse (obj) + "Visit the URL corresponding to a forge object in a browser." + (browse-url (forge-get-url obj))) + +(cl-defgeneric forge-visit (obj) + "View a forge object in a separate buffer.") + +(cl-defgeneric forge--object-id (class &rest args) + "Return the database id for the CLASS object specified by ARGS.") + +(cl-defgeneric forge--repository-ids (class host owner name &optional stub) + "Return the database and forge ids for the specified CLASS object.") + +(cl-defmethod magit-section-ident-value ((obj forge-object)) + (oref obj id)) + +;;; Utilities + +(defmacro forge--childp (obj type) + "Somewhat similar to `cl-typep' but only for (possibly unknown) classes. +TYPE is evaluated at macro-expansion time but unlike with +`cl-typep' the respective class does not have to be defined +at that time." + (let ((fn (intern (concat (symbol-name (eval type)) "--eieio-childp")))) + `(and (fboundp ',fn) (,fn ,obj)))) + +(defun forge--set-id-slot (repo object slot rows) + (let ((repo-id (oref repo id))) + (closql-oset + object slot + (mapcar (lambda (val) + (forge--object-id repo-id + (if (atom val) val (alist-get 'id val)))) + rows)))) + +(cl-defgeneric forge--format (object slot &optional spec)) + +(cl-defmethod forge--format ((remote string) slot &optional spec) + (if-let ((parts (forge--split-remote-url remote))) + (forge--format + (forge-get-repository 'stub remote) slot + (pcase-let* ((`(,host ,owner ,name) parts) + (path (if owner (concat owner "/" name) name))) + `(,@spec + (?h . ,host) + (?o . ,owner) + (?n . ,name) + (?p . ,path) + (?P . ,(string-replace "/" "%2F" path))))) + (user-error "Cannot browse non-forge remote %s" remote))) + +(defun forge--url-regexp () + (concat "\\`\\(?:git://\\|" + "[^/@]+@\\|" + "\\(?:ssh\\|ssh\\+git\\|git\\+ssh\\)://\\(?:[^/@]+@\\)?\\|" + "https?://\\(?:[^/@]+@\\)?\\)?" + (regexp-opt (mapcar #'car forge-alist) t) + "\\(?::[0-9]+\\)?" + "\\(?:/\\|:/?\\)" + "\\(.+?\\)" + "\\(?:\\.git\\|/\\)?\\'")) + +(defun forge--split-remote-url (remote) + (and-let* ((url (magit-git-string "remote" "get-url" remote))) + (forge--split-url url))) + +(defun forge--split-url (url) + (and (string-match (forge--url-regexp) url) + (and-let* ((host (match-string 1 url)) + (path (match-string 2 url)) + (path (forge--split-url-path + (nth 3 (assoc host forge-alist)) + path))) + (cons host path)))) + +(cl-defmethod forge--split-url-path + ((_class (subclass forge-repository)) path) + (and (string-match "\\`\\([^/]+\\)/\\([^/]+?\\)\\'" path) + (list (match-string 1 path) + (match-string 2 path)))) + +(cl-defmethod forge--split-url-path + ((_class (subclass forge-noapi-repository)) path) + (and (string-match "\\`\\(?:~?\\(.+\\)/\\)?\\([^/]+?\\)\\'" path) + (list (match-string 1 path) + (match-string 2 path)))) + +(defun forge--url-p (url) + (save-match-data + (and (string-match (forge--url-regexp) url) + (nth 2 (assoc (match-string 1 url) forge-alist))))) + +(defun forge--forge-remote-p (remote) + (and-let* ((url (magit-git-string "remote" "get-url" remote))) + (forge--url-p url))) + +(defun forge--url-equal (urlA urlB) + (or (equal urlA urlB) + (save-match-data + (let ((re (forge--url-regexp)) + hostA repoA hostB repoB) + (and (when (string-match re urlA) + (setq hostA (match-string 1 urlA)) + (setq repoA (match-string 2 urlA))) + (when (string-match re urlB) + (setq hostB (match-string 1 urlB)) + (setq repoB (match-string 2 urlB))) + (equal repoA repoB) + (equal (cl-caddr (assoc hostA forge-alist)) + (cl-caddr (assoc hostB forge-alist)))))))) + +(cl-defmethod forge--format-resource ((object forge-object) resource) + (save-match-data + (setq resource + (replace-regexp-in-string + ":\\([^/]+\\)" + (lambda (str) + (let ((slot (intern (substring str 1)))) + (or (and-let* + ((v (ignore-errors + (cl-case slot + (repo (oref object name)) + (project (concat (string-replace + "/" "%2F" (oref object owner)) + "%2F" + (oref object name))) + (topic (and (forge--childp object 'forge-topic) + (oref object number))) + (t (eieio-oref object slot)))))) + (format "%s" v)) + str))) + resource t t)) + (if (string-match ":[^/]*" resource) + (if-let ((parent (ignore-errors (forge-get-parent object)))) + (forge--format-resource parent resource) + (error "Cannot resolve %s for a %s" + (match-string 0 resource) + (eieio-object-class object))) + resource))) + +;; This is a copy of `org-id-uuid'. +(defun forge--uuid () + "Return string with random (version 4) UUID." + (let ((rnd (md5 (format "%s%s%s%s%s%s%s" + (random) + (current-time) + (user-uid) + (emacs-pid) + (user-full-name) + user-mail-address + (recent-keys))))) + (format "%s-%s-4%s-%s%s-%s" + (substring rnd 0 8) + (substring rnd 8 12) + (substring rnd 13 16) + (format "%x" + (logior + #b10000000 + (logand + #b10111111 + (string-to-number + (substring rnd 16 18) 16)))) + (substring rnd 18 20) + (substring rnd 20 32)))) + +;;; _ +(provide 'forge-core) +;;; forge-core.el ends here diff --git a/elpa/forge-20230505.926/forge-db.el b/elpa/forge-20230505.926/forge-db.el new file mode 100644 index 00000000..237989c2 --- /dev/null +++ b/elpa/forge-20230505.926/forge-db.el @@ -0,0 +1,446 @@ +;;; forge-db.el --- Database implementation -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Code: + +(require 'closql) +(require 'compat) +(require 'eieio) +(require 'emacsql) + +;; For `closql--db-update-schema': +(declare-function forge-get-issue "forge-core") +(declare-function forge-get-pullreq "forge-core") +(declare-function forge--object-id "forge-core") + +(eval-when-compile + (cl-pushnew 'value eieio--known-slot-names)) + +;;; Options + +(defcustom forge-database-file + (expand-file-name "forge-database.sqlite" user-emacs-directory) + "The file used to store the forge database." + :package-version '(forge . "0.1.0") + :group 'forge + :type 'file) + +;;; Core + +(defclass forge-database (closql-database) + ((name :initform "Forge") + (object-class :initform 'forge-repository) + (file :initform 'forge-database-file) + (schemata :initform 'forge--db-table-schemata) + (version :initform 9))) + +(defvar forge--override-connection-class nil) + +(defun forge-db (&optional livep) + (closql-db 'forge-database livep forge--override-connection-class)) + +(defun forge-sql (sql &rest args) + (if (stringp sql) + (emacsql (forge-db) (apply #'format sql args)) + (apply #'emacsql (forge-db) sql args))) + +(defun forge-connect-database-once () + "Try to connect Forge database on first use of `magit-status' only." + (remove-hook 'magit-status-mode-hook #'forge-connect-database-once) + (forge-db)) +(add-hook 'magit-status-mode-hook #'forge-connect-database-once) + +;;; Schemata + +(defconst forge--db-table-schemata + '((repository + [(class :not-null) + (id :not-null :primary-key) + forge-id + forge + owner + name + apihost + githost + remote + sparse-p + created + updated + pushed + parent + description + homepage + default-branch + archived-p + fork-p + locked-p + mirror-p + private-p + issues-p + wiki-p + stars + watchers + (assignees :default eieio-unbound) + (forks :default eieio-unbound) + (issues :default eieio-unbound) + (labels :default eieio-unbound) + (revnotes :default eieio-unbound) + (pullreqs :default eieio-unbound) + selective-p + worktree + (milestones :default eieio-unbound)]) + + (assignee + [(repository :not-null) + (id :not-null :primary-key) + login + name + forge-id] ; Needed for Gitlab. + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (fork + [(parent :not-null) + (id :not-null :primary-key) + owner + name] + (:foreign-key + [parent] :references repository [id] + :on-delete :cascade)) + + (issue + [(class :not-null) + (id :not-null :primary-key) + repository + number + state + author + title + created + updated + closed + unread-p + locked-p + milestone + body + (assignees :default eieio-unbound) + (cards :default eieio-unbound) + (edits :default eieio-unbound) + (labels :default eieio-unbound) + (participants :default eieio-unbound) + (posts :default eieio-unbound) + (reactions :default eieio-unbound) + (timeline :default eieio-unbound) + (marks :default eieio-unbound) + note + their-id] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (issue-assignee + [(issue :not-null) + (id :not-null)] + (:foreign-key + [issue] :references issue [id] + :on-delete :cascade)) + + (issue-label + [(issue :not-null) + (id :not-null)] + (:foreign-key + [issue] :references issue [id] + :on-delete :cascade) + (:foreign-key + [id] :references label [id] + :on-delete :cascade)) + + (issue-mark + [(issue :not-null) + (id :not-null)] + (:foreign-key + [issue] :references issue [id] + :on-delete :cascade) + (:foreign-key + [id] :references mark [id] + :on-delete :cascade)) + + (issue-post + [(class :not-null) + (id :not-null :primary-key) + issue + number + author + created + updated + body + (edits :default eieio-unbound) + (reactions :default eieio-unbound)] + (:foreign-key + [issue] :references issue [id] + :on-delete :cascade)) + + (label + [(repository :not-null) + (id :not-null :primary-key) + name + color + description] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (mark + [;; For now this is always nil because it seems more useful to + ;; share marks between repositories. We cannot omit this slot + ;; though because `closql--iref' expects `id' to be the second + ;; slot. + repository + (id :not-null :primary-key) + name + face + description]) + + (milestone + [(repository :not-null) + (id :not-null :primary-key) + number + title + created + updated + due + closed + description] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (notification + [(class :not-null) + (id :not-null :primary-key) + thread-id + repository + forge + reason + unread-p + last-read + updated + title + type + topic + url] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (pullreq + [(class :not-null) + (id :not-null :primary-key) + repository + number + state + author + title + created + updated + closed + merged + unread-p + locked-p + editable-p + cross-repo-p + base-ref + base-repo + head-ref + head-user + head-repo + milestone + body + (assignees :default eieio-unbound) + (cards :default eieio-unbound) + (commits :default eieio-unbound) + (edits :default eieio-unbound) + (labels :default eieio-unbound) + (participants :default eieio-unbound) + (posts :default eieio-unbound) + (reactions :default eieio-unbound) + (review-requests :default eieio-unbound) + (reviews :default eieio-unbound) + (timeline :default eieio-unbound) + (marks :default eieio-unbound) + note + base-rev + head-rev + draft-p + their-id] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)) + + (pullreq-assignee + [(pullreq :not-null) + (id :not-null)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade)) + + (pullreq-label + [(pullreq :not-null) + (id :not-null)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade) + (:foreign-key + [id] :references label [id] + :on-delete :cascade)) + + (pullreq-mark + [(pullreq :not-null) + (id :not-null)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade) + (:foreign-key + [id] :references mark [id] + :on-delete :cascade)) + + (pullreq-post + [(class :not-null) + (id :not-null :primary-key) + pullreq + number + author + created + updated + body + (edits :default eieio-unbound) + (reactions :default eieio-unbound)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade)) + + (pullreq-review-request + [(pullreq :not-null) + (id :not-null)] + (:foreign-key + [pullreq] :references pullreq [id] + :on-delete :cascade)) + + (revnote + [(class :not-null) + (id :not-null :primary-key) + repository + commit + file + line + author + body] + (:foreign-key + [repository] :references repository [id] + :on-delete :cascade)))) + +(cl-defmethod closql--db-update-schema ((db forge-database)) + (let ((code-version (oref-default 'forge-database version)) + (version (closql--db-get-version db))) + (when (< version code-version) + (forge--backup-database db)) + (closql-with-transaction db + (when (= version 2) + (message "Upgrading Forge database from version 2 to 3...") + (emacsql db [:create-table pullreq-review-request $S1] + (cdr (assq 'pullreq-review-request forge--db-table-schemata))) + (closql--db-set-version db (setq version 3)) + (message "Upgrading Forge database from version 2 to 3...done")) + (when (= version 3) + (message "Upgrading Forge database from version 3 to 4...") + (emacsql db [:drop-table notification]) + (pcase-dolist (`(,table . ,schema) forge--db-table-schemata) + (when (memq table '(notification + mark issue-mark pullreq-mark)) + (emacsql db [:create-table $i1 $S2] table schema))) + (emacsql db [:alter-table issue :add-column marks :default $s1] 'eieio-unbound) + (emacsql db [:alter-table pullreq :add-column marks :default $s1] 'eieio-unbound) + (closql--db-set-version db (setq version 4)) + (message "Upgrading Forge database from version 3 to 4...done")) + (when (= version 4) + (message "Upgrading Forge database from version 4 to 5...") + (emacsql db [:alter-table repository :add-column selective-p :default nil]) + (closql--db-set-version db (setq version 5)) + (message "Upgrading Forge database from version 4 to 5...done")) + (when (= version 5) + (message "Upgrading Forge database from version 5 to 6...") + (emacsql db [:alter-table repository :add-column worktree :default nil]) + (closql--db-set-version db (setq version 6)) + (message "Upgrading Forge database from version 5 to 6...done")) + (when (= version 6) + (message "Upgrading Forge database from version 6 to 7...") + (emacsql db [:alter-table issue :add-column note :default nil]) + (emacsql db [:alter-table pullreq :add-column note :default nil]) + (emacsql db [:create-table milestone $S1] + (cdr (assq 'milestone forge--db-table-schemata))) + (emacsql db [:alter-table repository :add-column milestones :default $s1] + 'eieio-unbound) + (pcase-dolist (`(,repo-id ,issue-id ,milestone) + (emacsql db [:select [repository id milestone] + :from issue + :where (notnull milestone)])) + (unless (stringp milestone) + (oset (forge-get-issue issue-id) milestone + (forge--object-id repo-id (cdar milestone))))) + (pcase-dolist (`(,repo-id ,pullreq-id ,milestone) + (emacsql db [:select [repository id milestone] + :from pullreq + :where (notnull milestone)])) + (unless (stringp milestone) + (oset (forge-get-pullreq pullreq-id) milestone + (forge--object-id repo-id (cdar milestone))))) + (closql--db-set-version db (setq version 7)) + (message "Upgrading Forge database from version 6 to 7...done")) + (when (= version 7) + (message "Upgrading Forge database from version 7 to 8...") + (emacsql db [:alter-table pullreq :add-column base-rev :default nil]) + (emacsql db [:alter-table pullreq :add-column head-rev :default nil]) + (emacsql db [:alter-table pullreq :add-column draft-p :default nil]) + (closql--db-set-version db (setq version 8)) + (message "Upgrading Forge database from version 7 to 8...done")) + (when (= version 8) + (message "Upgrading Forge database from version 8 to 9...") + (emacsql db [:alter-table pullreq :add-column their-id :default nil]) + (emacsql db [:alter-table issue :add-column their-id :default nil]) + (closql--db-set-version db (setq version 9)) + (message "Upgrading Forge database from version 8 to 9...done"))) + (cl-call-next-method))) + +(defun forge--backup-database (db) + (let ((dst (concat (file-name-sans-extension forge-database-file) + (format "-v%s" (caar (emacsql (oref db connection) + [:pragma user-version]))) + (format-time-string "-%Y%m%d-%H%M") + ".sqlite"))) + (message "Copying Forge database to %s..." dst) + (copy-file forge-database-file dst) + (message "Copying Forge database to %s...done" dst))) + +;;; _ +(provide 'forge-db) +;;; forge-db.el ends here diff --git a/elpa/forge-20230505.926/forge-gitea.el b/elpa/forge-20230505.926/forge-gitea.el new file mode 100644 index 00000000..31be47f7 --- /dev/null +++ b/elpa/forge-20230505.926/forge-gitea.el @@ -0,0 +1,47 @@ +;;; forge-gitea.el --- Gitea support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Code: + +(require 'gtea) +(require 'forge) + +;;; Class + +(defclass forge-gitea-repository (forge-unusedapi-repository) + ((issues-url-format :initform "https://%h/%o/%n/issues") + (issue-url-format :initform "https://%h/%o/%n/issues/%i") + ;; The anchor for the issue itself is .../%i#issue-%i + (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#issuecomment-%I") + (pullreqs-url-format :initform "https://%h/%o/%n/pulls") + (pullreq-url-format :initform "https://%h/%o/%n/pulls/%i") + (pullreq-post-url-format :initform "https://%h/%o/%n/pulls/%i#issuecomment-%I") + (commit-url-format :initform "https://%h/%o/%n/commit/%r") + (branch-url-format :initform "https://%h/%o/%n/commits/branch/%r") + (remote-url-format :initform "https://%h/%o/%n") + (create-issue-url-format :initform "https://%h/%o/%n/issues/new") + (create-pullreq-url-format :initform "https://%h/%o/%n/pulls") ; sic + (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*"))) + +;;; _ +(provide 'forge-gitea) +;;; forge-gitea.el ends here diff --git a/elpa/forge-20230505.926/forge-github.el b/elpa/forge-20230505.926/forge-github.el new file mode 100644 index 00000000..56507517 --- /dev/null +++ b/elpa/forge-20230505.926/forge-github.el @@ -0,0 +1,801 @@ +;;; forge-github.el --- Github support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Code: + +(require 'ghub) + +(require 'forge) +(require 'forge-issue) +(require 'forge-pullreq) + +;;; Class + +(defclass forge-github-repository (forge-repository) + ((issues-url-format :initform "https://%h/%o/%n/issues") + (issue-url-format :initform "https://%h/%o/%n/issues/%i") + (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#issuecomment-%I") + (pullreqs-url-format :initform "https://%h/%o/%n/pulls") + (pullreq-url-format :initform "https://%h/%o/%n/pull/%i") + (pullreq-post-url-format :initform "https://%h/%o/%n/pull/%i#issuecomment-%I") + (commit-url-format :initform "https://%h/%o/%n/commit/%r") + (branch-url-format :initform "https://%h/%o/%n/commits/%r") + (remote-url-format :initform "https://%h/%o/%n") + (create-issue-url-format :initform "https://%h/%o/%n/issues/new") + (create-pullreq-url-format :initform "https://%h/%o/%n/compare") + (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*"))) + +;;; Pull +;;;; Repository + +(cl-defmethod forge--pull ((repo forge-github-repository) until + &optional callback) + (let ((buf (current-buffer)) + (dir default-directory) + (selective-p (oref repo selective-p)) + (ghub-graphql-items-per-request + (string-to-number + (or (magit-get "forge.graphqlItemLimit") "100")))) + (ghub-fetch-repository + (oref repo owner) + (oref repo name) + (lambda (data) + (forge--msg repo t t "Pulling REPO") + (forge--msg repo t nil "Storing REPO") + (closql-with-transaction (forge-db) + (let-alist data + (forge--update-repository repo data) + (forge--update-assignees repo .assignableUsers) + (forge--update-forks repo .forks) + (forge--update-labels repo .labels) + (forge--update-milestones repo .milestones) + (forge--update-issues repo .issues t) + (forge--update-pullreqs repo .pullRequests t) + (forge--update-revnotes repo .commitComments)) + (oset repo sparse-p nil)) + (forge--msg repo t t "Storing REPO") + (cond + (selective-p) + (callback (funcall callback)) + (forge-pull-notifications + (forge--pull-notifications (eieio-object-class repo) + (oref repo githost) + (lambda () (forge--git-fetch buf dir repo)))) + (t (forge--git-fetch buf dir repo)))) + `((issues-until . ,(forge--topics-until repo until 'issue)) + (pullRequests-until . ,(forge--topics-until repo until 'pullreq))) + :host (oref repo apihost) + :auth 'forge + :sparse selective-p))) + +(cl-defmethod forge--pull-topic ((repo forge-github-repository) + (topic forge-topic)) + (let ((buffer (current-buffer)) + (fetch #'ghub-fetch-issue) + (update #'forge--update-issue) + (errorback (lambda (err _headers _status _req) + (when (equal (cdr (assq 'type (cadr err))) "NOT_FOUND") + (forge--pull-topic + repo (forge-pullreq :repository (oref repo id) + :number (oref topic number))))))) + (when (cl-typep topic 'forge-pullreq) + (setq fetch #'ghub-fetch-pullreq) + (setq update #'forge--update-pullreq) + (setq errorback nil)) + (funcall + fetch + (oref repo owner) + (oref repo name) + (oref topic number) + (lambda (data) + (funcall update repo data nil) + (with-current-buffer + (if (buffer-live-p buffer) buffer (current-buffer)) + (magit-refresh))) + nil + :errorback errorback + :host (oref repo apihost) + :auth 'forge))) + +(cl-defmethod forge--update-repository ((repo forge-github-repository) data) + (let-alist data + (oset repo created .createdAt) + (oset repo updated .updatedAt) + (oset repo pushed .pushedAt) + (oset repo parent .parent.nameWithOwner) + (oset repo description .description) + (oset repo homepage (and (not (equal .homepageUrl "")) .homepageUrl)) + (oset repo default-branch .defaultBranchRef.name) + (oset repo archived-p .isArchived) + (oset repo fork-p .isFork) + (oset repo locked-p .isLocked) + (oset repo mirror-p .isMirror) + (oset repo private-p .isPrivate) + (oset repo issues-p .hasIssuesEnabled) + (oset repo wiki-p .hasWikiEnabled) + (oset repo stars .stargazers.totalCount) + (oset repo watchers .watchers.totalCount))) + +(cl-defmethod forge--update-issues ((repo forge-github-repository) data bump) + (closql-with-transaction (forge-db) + (mapc (lambda (e) (forge--update-issue repo e bump)) data))) + +(cl-defmethod forge--update-issue ((repo forge-github-repository) data bump) + (closql-with-transaction (forge-db) + (let-alist data + (let* ((issue-id (forge--object-id 'forge-issue repo .number)) + (issue (or (forge-get-issue repo .number) + (closql-insert + (forge-db) + (forge-issue :id issue-id + :repository (oref repo id) + :number .number))))) + (oset issue id issue-id) + (oset issue their-id .id) + (oset issue state (pcase-exhaustive .state + ("CLOSED" 'closed) + ("OPEN" 'open))) + (oset issue author .author.login) + (oset issue title .title) + (oset issue created .createdAt) + (oset issue updated (cond (bump (or .updatedAt .createdAt)) + ((slot-boundp issue 'updated) + (oref issue updated)) + (t "0"))) + (oset issue closed .closedAt) + (oset issue locked-p .locked) + (oset issue milestone (and .milestone.id + (forge--object-id (oref repo id) + .milestone.id))) + (oset issue body (forge--sanitize-string .body)) + .databaseId ; Silence Emacs 25 byte-compiler. + (dolist (c .comments) + (let-alist c + (closql-insert + (forge-db) + (forge-issue-post + :id (forge--object-id issue-id .databaseId) + :issue issue-id + :number .databaseId + :author .author.login + :created .createdAt + :updated .updatedAt + :body (forge--sanitize-string .body)) + t))) + (when bump + (forge--set-id-slot repo issue 'assignees .assignees) + (unless (magit-get-boolean "forge.kludge-for-issue-294") + (forge--set-id-slot repo issue 'labels .labels))) + issue)))) + +(cl-defmethod forge--update-pullreqs ((repo forge-github-repository) data bump) + (closql-with-transaction (forge-db) + (mapc (lambda (e) (forge--update-pullreq repo e bump)) data))) + +(cl-defmethod forge--update-pullreq ((repo forge-github-repository) data bump) + (closql-with-transaction (forge-db) + (let-alist data + (let* ((pullreq-id (forge--object-id 'forge-pullreq repo .number)) + (pullreq (or (forge-get-pullreq repo .number) + (closql-insert + (forge-db) + (forge-pullreq :id pullreq-id + :repository (oref repo id) + :number .number))))) + (oset pullreq their-id .id) + (oset pullreq state (pcase-exhaustive .state + ("MERGED" 'merged) + ("CLOSED" 'closed) + ("OPEN" 'open))) + (oset pullreq author .author.login) + (oset pullreq title .title) + (oset pullreq created .createdAt) + (oset pullreq updated (cond (bump (or .updatedAt .createdAt)) + ((slot-boundp pullreq 'updated) + (oref pullreq updated)) + (t "0"))) + (oset pullreq closed .closedAt) + (oset pullreq merged .mergedAt) + (oset pullreq draft-p .isDraft) + (oset pullreq locked-p .locked) + (oset pullreq editable-p .maintainerCanModify) + (oset pullreq cross-repo-p .isCrossRepository) + (oset pullreq base-ref .baseRef.name) + (oset pullreq base-rev .baseRefOid) + (oset pullreq base-repo .baseRef.repository.nameWithOwner) + (oset pullreq head-ref .headRef.name) + (oset pullreq head-rev .headRefOid) + (oset pullreq head-user .headRef.repository.owner.login) + (oset pullreq head-repo .headRef.repository.nameWithOwner) + (oset pullreq milestone (and .milestone.id + (forge--object-id (oref repo id) + .milestone.id))) + (oset pullreq body (forge--sanitize-string .body)) + .databaseId ; Silence Emacs 25 byte-compiler. + (dolist (p .comments) + (let-alist p + (closql-insert + (forge-db) + (forge-pullreq-post + :id (forge--object-id pullreq-id .databaseId) + :pullreq pullreq-id + :number .databaseId + :author .author.login + :created .createdAt + :updated .updatedAt + :body (forge--sanitize-string .body)) + t))) + (when bump + (forge--set-id-slot repo pullreq 'assignees .assignees) + (forge--set-id-slot repo pullreq 'review-requests + (--map (cdr (cadr (car it))) + .reviewRequests)) + (unless (magit-get-boolean "forge.kludge-for-issue-294") + (forge--set-id-slot repo pullreq 'labels .labels))) + pullreq)))) + +(cl-defmethod forge--update-revnotes ((repo forge-github-repository) data) + (closql-with-transaction (forge-db) + (mapc (apply-partially #'forge--update-revnote repo) data))) + +(cl-defmethod forge--update-revnote ((repo forge-github-repository) data) + (closql-with-transaction (forge-db) + (let-alist data + (closql-insert + (forge-db) + (forge-revnote + :id (forge--object-id 'forge-revnote repo .id) + :repository (oref repo id) + :commit .commit.oid + :file .path + :line .position + :author .author.login + :body .body) + t)))) + +(cl-defmethod forge--update-assignees ((repo forge-github-repository) data) + (oset repo assignees + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + (list (forge--object-id id .id) + .login + .name + .id))) + (delete-dups data))))) + +(cl-defmethod forge--update-forks ((repo forge-github-repository) data) + (oset repo forks + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + (nconc (forge--repository-ids + (eieio-object-class repo) + (oref repo githost) + .owner.login + .name) + (list .owner.login + .name)))) + (delete-dups data))))) + +(cl-defmethod forge--update-labels ((repo forge-github-repository) data) + (oset repo labels + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + (list (forge--object-id id .id) + .name + (concat "#" (downcase .color)) + .description))) + (delete-dups data))))) + +(cl-defmethod forge--update-milestones ((repo forge-github-repository) data) + (oset repo milestones + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + (list (forge--object-id id .id) + .number + .title + .createdAt + .updatedAt + .dueOn + .closedAt + .description))) + (delete-dups data))))) + +;;;; Notifications + +(cl-defmethod forge--pull-notifications + ((_class (subclass forge-github-repository)) githost &optional callback) + ;; The GraphQL API doesn't support notifications and also likes to + ;; timeout for handcrafted requests, forcing us to perform a major + ;; rain dance. + (let ((spec (assoc githost forge-alist))) + (unless spec + (error "No entry for %S in forge-alist" githost)) + (forge--msg nil t nil "Pulling notifications") + (pcase-let* + ((`(,_ ,apihost ,forge ,_) spec) + (notifs (-keep (lambda (data) + ;; Github may return notifications for repos + ;; the user no longer has access to. Trying + ;; to retrieve information for such a repo + ;; leads to an error, which we suppress. See #164. + (with-demoted-errors "forge--pull-notifications: %S" + (forge--ghub-massage-notification + data forge githost))) + (forge--ghub-get nil "/notifications" + '((all . t)) + :host apihost :unpaginate t))) + (groups (-partition-all 50 notifs)) + (pages (length groups)) + (page 0) + (result nil)) + (cl-labels + ((cb (&optional data _headers _status _req) + (when data + (setq result (nconc result (cdr data)))) + (if groups + (progn (cl-incf page) + (forge--msg nil t nil + "Pulling notifications (page %s/%s)" + page pages) + (ghub--graphql-vacuum + (cons 'query (-keep #'caddr (pop groups))) + nil #'cb nil :auth 'forge :host apihost)) + (forge--msg nil t t "Pulling notifications") + (forge--msg nil t nil "Storing notifications") + (closql-with-transaction (forge-db) + (forge-sql [:delete-from notification + :where (= forge $s1)] forge) + (pcase-dolist (`(,key ,repo ,query ,obj) notifs) + (closql-insert (forge-db) obj) + (forge--zap-repository-cache (forge-get-repository obj)) + (when query + (oset (funcall (if (eq (oref obj type) 'issue) + #'forge--update-issue + #'forge--update-pullreq) + repo (cdr (cadr (assq key result))) nil) + unread-p (oref obj unread-p))))) + (forge--msg nil t t "Storing notifications") + (when callback + (funcall callback))))) + (cb))))) + +(defun forge--ghub-massage-notification (data forge githost) + (let-alist data + (let* ((type (intern (downcase .subject.type))) + (type (if (eq type 'pullrequest) 'pullreq type))) + (and (memq type '(pullreq issue)) + (let* ((number (and (string-match "[0-9]*\\'" .subject.url) + (string-to-number (match-string 0 .subject.url)))) + (repo (forge-get-repository + (list githost + .repository.owner.login + .repository.name) + nil 'create)) + (repoid (oref repo id)) + (owner (oref repo owner)) + (name (oref repo name)) + (id (forge--object-id repoid (string-to-number .id))) + (alias (intern (concat "_" (string-replace "=" "_" id))))) + (list alias repo + `((,alias repository) + [(name ,name) + (owner ,owner)] + ,@(cddr + (caddr + (ghub--graphql-prepare-query + ghub-fetch-repository + (if (eq type 'issue) + `(repository issues (issue . ,number)) + `(repository pullRequest (pullRequest . ,number))) + )))) + (forge-notification + :id id + :thread-id .id + :repository repoid + :forge forge + :reason (intern (downcase .reason)) + :unread-p .unread + :last-read .last_read_at + :updated .updated_at + :title .subject.title + :type type + :topic number + :url .subject.url))))))) + +(cl-defmethod forge-topic-mark-read ((_ forge-github-repository) topic) + (when (oref topic unread-p) + (oset topic unread-p nil) + (when-let ((notif (forge-get-notification topic))) + (oset topic unread-p nil) + (forge--ghub-patch notif "/notifications/threads/:thread-id")))) + +;;;; Miscellaneous + +(cl-defmethod forge--add-user-repos + ((class (subclass forge-github-repository)) host user) + (forge--fetch-user-repos + class (forge--as-apihost host) user + (apply-partially #'forge--batch-add-callback (forge--as-githost host) user))) + +(cl-defmethod forge--add-organization-repos + ((class (subclass forge-github-repository)) host org) + (forge--fetch-organization-repos + class (forge--as-apihost host) org + (apply-partially #'forge--batch-add-callback (forge--as-githost host) org))) + +(cl-defmethod forge--fetch-user-repos + ((_ (subclass forge-github-repository)) host user callback) + (ghub--graphql-vacuum + '(query (user + [(login $login String!)] + (repositories + [(:edges t) + (ownerAffiliations . (OWNER))] + name))) + `((login . ,user)) + (lambda (d) + (funcall callback + (--map (alist-get 'name it) + (let-alist d .user.repositories)))) + nil :auth 'forge :host host)) + +(cl-defmethod forge--fetch-organization-repos + ((_ (subclass forge-github-repository)) host org callback) + (ghub--graphql-vacuum + '(query (organization + [(login $login String!)] + (repositories [(:edges t)] name))) + `((login . ,org)) + (lambda (d) + (funcall callback + (--map (alist-get 'name it) + (let-alist d .organization.repositories)))) + nil :auth 'forge :host host)) + +(defun forge--batch-add-callback (host owner names) + (let ((repos (cl-mapcan (lambda (name) + (let ((repo (forge-get-repository + (list host owner name) + nil 'create))) + (and (oref repo sparse-p) + (list repo)))) + names)) + cb) + (setq cb (lambda () + (when-let ((repo (pop repos))) + (message "Adding %s..." (oref repo name)) + (forge--pull repo nil cb)))) + (funcall cb))) + +;;; Mutations + +(cl-defmethod forge--create-pullreq-from-issue ((repo forge-github-repository) + (issue forge-issue) + source target) + (pcase-let* ((`(,base-remote . ,base-branch) + (magit-split-branch-name target)) + (`(,head-remote . ,head-branch) + (magit-split-branch-name source)) + (head-repo (forge-get-repository 'stub head-remote))) + (forge--ghub-post repo "/repos/:owner/:repo/pulls" + `((issue . ,(oref issue number)) + (base . ,base-branch) + (head . ,(if (equal head-remote base-remote) + head-branch + (concat (oref head-repo owner) ":" + head-branch))) + (maintainer_can_modify . t)) + :callback (lambda (&rest _) + (closql-delete issue) + (forge-pull)) + :errorback (lambda (&rest _) (forge-pull))))) + +(cl-defmethod forge--submit-create-pullreq ((_ forge-github-repository) repo) + (let-alist (forge--topic-parse-buffer) + (when (and .yaml (local-variable-p 'forge-buffer-draft-p)) + (user-error "Cannot use yaml frontmatter and set `%s' at the same time" + 'forge-buffer-draft-p)) + (pcase-let* ((`(,base-remote . ,base-branch) + (magit-split-branch-name forge--buffer-base-branch)) + (`(,head-remote . ,head-branch) + (magit-split-branch-name forge--buffer-head-branch)) + (head-repo (forge-get-repository 'stub head-remote)) + (url-mime-accept-string + ;; Support draft pull-requests. + "application/vnd.github.shadow-cat-preview+json")) + (forge--ghub-post repo "/repos/:owner/:repo/pulls" + `((title . , .title) + (body . , .body) + (base . ,base-branch) + (head . ,(if (equal head-remote base-remote) + head-branch + (concat (oref head-repo owner) ":" + head-branch))) + (draft . ,(if (local-variable-p 'forge-buffer-draft-p) + forge-buffer-draft-p + .draft)) + (maintainer_can_modify . t)) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))))) + +(cl-defmethod forge--submit-create-issue ((_ forge-github-repository) repo) + (let-alist (forge--topic-parse-buffer) + (forge--ghub-post repo "/repos/:owner/:repo/issues" + `((title . , .title) + (body . , .body) + ,@(and .labels (list (cons 'labels .labels))) + ,@(and .assignees (list (cons 'assignees .assignees)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback)))) + +(cl-defmethod forge--submit-create-post ((_ forge-github-repository) topic) + (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/comments" + `((body . ,(string-trim (buffer-string)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + +(cl-defmethod forge--submit-edit-post ((_ forge-github-repository) post) + (forge--ghub-patch post + (cl-typecase post + (forge-pullreq "/repos/:owner/:repo/pulls/:number") + (forge-issue "/repos/:owner/:repo/issues/:number") + (forge-post "/repos/:owner/:repo/issues/comments/:number")) + (if (cl-typep post 'forge-topic) + (let-alist (forge--topic-parse-buffer) + `((title . , .title) + (body . , .body))) + `((body . ,(string-trim (buffer-string))))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + +(cl-defmethod forge--set-topic-title + ((_repo forge-github-repository) topic title) + (forge--ghub-patch topic + "/repos/:owner/:repo/issues/:number" + `((title . ,title)) + :callback (forge--set-field-callback))) + +(cl-defmethod forge--set-topic-state + ((_repo forge-github-repository) topic) + (forge--ghub-patch topic + "/repos/:owner/:repo/issues/:number" + `((state . ,(cl-ecase (oref topic state) + (closed "OPEN") + (open "CLOSED")))) + :callback (forge--set-field-callback))) + +(cl-defmethod forge--set-topic-draft + ((_repo forge-github-repository) topic value) + (let ((buffer (current-buffer))) + (ghub-graphql + `(mutation (,(if value + 'convertPullRequestToDraft + 'markPullRequestReadyForReview) + [(input $input ,(if value + 'ConvertPullRequestToDraftInput! + 'MarkPullRequestReadyForReviewInput!))] + (pullRequest isDraft))) + `((input (pullRequestId . ,(oref topic their-id)))) + :host (oref (forge-get-repository topic) apihost) + :auth 'forge + :callback (lambda (data &rest _) + (if (assq 'error data) + (ghub--graphql-pp-response data) + (oset topic draft-p value) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (magit-refresh-buffer)))))))) + +(cl-defmethod forge--set-topic-milestone + ((repo forge-github-repository) topic milestone) + (forge--ghub-patch topic + "/repos/:owner/:repo/issues/:number" + `((milestone + . ,(caar (forge-sql [:select [number] + :from milestone + :where (and (= repository $s1) + (= title $s2))] + (oref repo id) + milestone)))) + :callback (forge--set-field-callback))) + +(cl-defmethod forge--set-topic-labels + ((_repo forge-github-repository) topic labels) + (forge--ghub-put topic "/repos/:owner/:repo/issues/:number/labels" nil + :payload labels + :callback (forge--set-field-callback))) + +(cl-defmethod forge--set-topic-assignees + ((_repo forge-github-repository) topic assignees) + (let ((value (mapcar #'car (closql--iref topic 'assignees)))) + (when-let ((add (cl-set-difference assignees value :test #'equal))) + (forge--ghub-post topic "/repos/:owner/:repo/issues/:number/assignees" + `((assignees . ,add)))) + (when-let ((remove (cl-set-difference value assignees :test #'equal))) + (forge--ghub-delete topic "/repos/:owner/:repo/issues/:number/assignees" + `((assignees . ,remove))))) + (forge-pull)) + +(cl-defmethod forge--set-topic-review-requests + ((_repo forge-github-repository) topic reviewers) + (let ((value (mapcar #'car (closql--iref topic 'review-requests)))) + (when-let ((add (cl-set-difference reviewers value :test #'equal))) + (forge--ghub-post topic + "/repos/:owner/:repo/pulls/:number/requested_reviewers" + `((reviewers . ,add)))) + (when-let ((remove (cl-set-difference value reviewers :test #'equal))) + (forge--ghub-delete topic + "/repos/:owner/:repo/pulls/:number/requested_reviewers" + `((reviewers . ,remove))))) + (forge-pull)) + +(cl-defmethod forge--delete-comment + ((_repo forge-github-repository) post) + (forge--ghub-delete post "/repos/:owner/:repo/issues/comments/:number") + (closql-delete post) + (magit-refresh)) + +(cl-defmethod forge--topic-templates ((repo forge-github-repository) + (_ (subclass forge-issue))) + (and-let* ((files (magit-revision-files (oref repo default-branch)))) + (let ((case-fold-search t)) + (if-let ((file (--first (string-match-p "\ +\\`\\(\\|docs/\\|\\.github/\\)issue_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it) + files))) + (list file) + (setq files + (--filter (string-match-p "\\`\\.github/ISSUE_TEMPLATE/[^/]*" it) + files)) + (if-let ((conf (cl-find-if + (lambda (f) + (equal (file-name-nondirectory f) "config.yml")) + files))) + (nconc (delete conf files) + (list conf)) + files))))) + +(cl-defmethod forge--topic-templates ((repo forge-github-repository) + (_ (subclass forge-pullreq))) + (and-let* ((files (magit-revision-files (oref repo default-branch)))) + (let ((case-fold-search t)) + (if-let ((file (--first (string-match-p "\ +\\`\\(\\|docs/\\|\\.github/\\)pull_request_template\\(\\.[a-zA-Z0-9]+\\)?\\'" it) + files))) + (list file) + ;; Unlike for issues, the web interface does not support + ;; multiple pull-request templates. The API does though, + ;; but due to this limitation I doubt many people use them, + ;; so Forge doesn't support them either. + )))) + +(cl-defmethod forge--set-default-branch ((repo forge-github-repository) + newname oldname) + (forge--ghub-post repo + (format "/repos/:owner/:name/branches/%s/rename" oldname) + `((new_name . ,newname))) + (message "Waiting 5 seconds for GitHub to complete rename...") + (sleep-for 5) + (message "Waiting 5 seconds for GitHub to complete rename...done") + (magit-call-git "fetch" "--prune" (oref repo remote)) + (magit--set-default-branch newname oldname)) + +(cl-defmethod forge--fork-repository ((repo forge-github-repository) fork) + (with-slots (owner name) repo + (forge--ghub-post repo + (format "/repos/%s/%s/forks" owner name) + (and (not (equal fork (ghub--username (ghub--host nil)))) + `((organization . ,fork)))) + (ghub-wait (format "/repos/%s/%s" fork name) nil :auth 'forge))) + +(cl-defmethod forge--merge-pullreq ((_repo forge-github-repository) + topic hash method) + (forge--ghub-put topic + "/repos/:owner/:repo/pulls/:number/merge" + `((merge_method . ,(symbol-name method)) + ,@(and hash `((sha . ,hash)))))) + +;;; Utilities + +(cl-defun forge--ghub-get (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host + callback errorback) + (declare (indent defun)) + (ghub-get (if obj (forge--format-resource obj resource) resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +(cl-defun forge--ghub-put (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host + callback errorback) + (declare (indent defun)) + (ghub-put (if obj (forge--format-resource obj resource) resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +(cl-defun forge--ghub-post (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (ghub-post (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +(cl-defun forge--ghub-patch (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (ghub-patch (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +(cl-defun forge--ghub-delete (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (ghub-delete (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback :errorback errorback)) + +;;; _ +(provide 'forge-github) +;;; forge-github.el ends here diff --git a/elpa/forge-20230505.926/forge-gitlab.el b/elpa/forge-20230505.926/forge-gitlab.el new file mode 100644 index 00000000..a318bbba --- /dev/null +++ b/elpa/forge-20230505.926/forge-gitlab.el @@ -0,0 +1,672 @@ +;;; forge-gitlab.el --- Gitlab support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Code: + +(require 'glab) + +(require 'forge) +(require 'forge-issue) +(require 'forge-pullreq) + +;;; Class + +(defclass forge-gitlab-repository (forge-repository) + ((issues-url-format :initform "https://%h/%o/%n/issues") + (issue-url-format :initform "https://%h/%o/%n/issues/%i") + (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#note_%I") + (pullreqs-url-format :initform "https://%h/%o/%n/merge_requests") + (pullreq-url-format :initform "https://%h/%o/%n/merge_requests/%i") + (pullreq-post-url-format :initform "https://%h/%o/%n/merge_requests/%i#note_%I") + (commit-url-format :initform "https://%h/%o/%n/commit/%r") + (branch-url-format :initform "https://%h/%o/%n/commits/%r") + (remote-url-format :initform "https://%h/%o/%n") + (create-issue-url-format :initform "https://%h/%o/%n/issues/new") + (create-pullreq-url-format :initform "https://%h/%o/%n/merge_requests/new") + (pullreq-refspec :initform "+refs/merge-requests/*/head:refs/pullreqs/*"))) + +;;; Pull +;;;; Repository + +(cl-defmethod forge--pull ((repo forge-gitlab-repository) until) + (let ((cb (let ((buf (and (derived-mode-p 'magit-mode) + (current-buffer))) + (dir default-directory) + (val nil)) + (lambda (cb &optional v) + (when v (if val (push v val) (setq val v))) + (let-alist val + (cond + ((not val) + (forge--fetch-repository repo cb)) + ((not (assq 'assignees val)) + (forge--fetch-assignees repo cb)) + ((not (assq 'forks val)) + (forge--fetch-forks repo cb)) + ((not (assq 'labels val)) + (forge--fetch-labels repo cb)) + ((and .issues_enabled + (not (assq 'issues val))) + (forge--fetch-issues repo cb until)) + ((and .merge_requests_enabled + (not (assq 'pullreqs val))) + (forge--fetch-pullreqs repo cb until)) + (t + (forge--msg repo t t "Pulling REPO") + (forge--msg repo t nil "Storing REPO") + (closql-with-transaction (forge-db) + (forge--update-repository repo val) + (forge--update-assignees repo .assignees) + (forge--update-labels repo .labels) + (dolist (v .issues) (forge--update-issue repo v)) + (dolist (v .pullreqs) (forge--update-pullreq repo v)) + (oset repo sparse-p nil)) + (forge--msg repo t t "Storing REPO") + (unless (oref repo selective-p) + (forge--git-fetch buf dir repo))))))))) + (funcall cb cb))) + +(cl-defmethod forge--fetch-repository ((repo forge-gitlab-repository) callback) + (forge--glab-get repo "/projects/:project" nil + :callback (lambda (value _headers _status _req) + (cond ((oref repo selective-p) + (setq value (append '((assignees) (forks) (labels) + (issues) (pullreqs)) + value))) + ((magit-get-boolean "forge.omitExpensive") + (setq value (append '((assignees) (forks) (labels)) + value)))) + (funcall callback callback value)))) + +(cl-defmethod forge--update-repository ((repo forge-gitlab-repository) data) + (let-alist data + (oset repo created .created_at) + (oset repo updated .last_activity_at) + (oset repo pushed nil) + (oset repo parent .forked_from_project.path_with_namespace) + (oset repo description .description) + (oset repo homepage nil) + (oset repo default-branch .default_branch) + (oset repo archived-p .archived) + (oset repo fork-p (and .forked_from_project.path_with_namespace t)) + (oset repo locked-p nil) + (oset repo mirror-p .mirror) + (oset repo private-p (equal .visibility "private")) + (oset repo issues-p .issues_enabled) + (oset repo wiki-p .wiki_enabled) + (oset repo stars .star_count) + (oset repo watchers .star_count))) + +(cl-defmethod forge--split-url-path + ((_class (subclass forge-gitlab-repository)) path) + (and (string-match "\\`\\(?:~?\\(.+\\)/\\)?\\([^/]+?\\)\\'" path) + (list (match-string 1 path) + (match-string 2 path)))) + +;;;; Issues + +(cl-defmethod forge--fetch-issues ((repo forge-gitlab-repository) callback until) + (let ((cb (let (val cur cnt pos) + (lambda (cb &optional v) + (cond + ((not pos) + (if (setq cur (setq val v)) + (progn + (setq pos 1) + (setq cnt (length val)) + (forge--msg nil nil nil "Pulling issue %s/%s" pos cnt) + (forge--fetch-issue-posts repo cur cb)) + (forge--msg repo t t "Pulling REPO issues") + (funcall callback callback (cons 'issues val)))) + (t + (if (setq cur (cdr cur)) + (progn + (cl-incf pos) + (forge--msg nil nil nil "Pulling issue %s/%s" pos cnt) + (forge--fetch-issue-posts repo cur cb)) + (forge--msg repo t t "Pulling REPO issues") + (funcall callback callback (cons 'issues val))))))))) + (forge--msg repo t nil "Pulling REPO issues") + (forge--glab-get repo "/projects/:project/issues" + `((per_page . 100) + (order_by . "updated_at") + ,@(and-let* ((after (forge--topics-until repo until 'issue))) + `((updated_after . ,after)))) + :unpaginate t + :callback (lambda (value _headers _status _req) + (funcall cb cb value))))) + +(cl-defmethod forge--fetch-issue-posts ((repo forge-gitlab-repository) cur cb) + (let-alist (car cur) + (forge--glab-get repo + (format "/projects/%s/issues/%s/notes" .project_id .iid) + '((per_page . 100)) + :unpaginate t + :callback (lambda (value _headers _status _req) + (setf (alist-get 'notes (car cur)) value) + (funcall cb cb))))) + +(cl-defmethod forge--update-issue ((repo forge-gitlab-repository) data) + (closql-with-transaction (forge-db) + (let-alist data + (let* ((issue-id (forge--object-id 'forge-issue repo .iid)) + (issue + (forge-issue + :id issue-id + :their-id .iid + :number .iid + :repository (oref repo id) + :state (pcase-exhaustive .state + ("closed" 'closed) + ("opened" 'open)) + :author .author.username + :title .title + :created .created_at + :updated .updated_at + ;; `.closed_at' may be nil even though the issues is + ;; closed. In such cases use 1, so that this slots + ;; at least can serve as a boolean. + :closed (or .closed_at (and (equal .state "closed") 1)) + :locked-p .discussion_locked + :milestone .milestone.iid + :body (forge--sanitize-string .description)))) + (closql-insert (forge-db) issue t) + (unless (magit-get-boolean "forge.omitExpensive") + (forge--set-id-slot repo issue 'assignees .assignees) + (forge--set-id-slot repo issue 'labels .labels)) + .body .id ; Silence Emacs 25 byte-compiler. + (dolist (c .notes) + (let-alist c + (let ((post + (forge-issue-post + :id (forge--object-id issue-id .id) + :issue issue-id + :number .id + :author .author.username + :created .created_at + :updated .updated_at + :body (forge--sanitize-string .body)))) + (closql-insert (forge-db) post t)))))))) + +;;;; Pullreqs + +(cl-defmethod forge--fetch-pullreqs ((repo forge-gitlab-repository) callback until) + (let ((cb (let (val cur cnt pos) + (lambda (cb &optional v) + (cond + ((not pos) + (if (setq cur (setq val v)) + (progn + (setq pos 1) + (setq cnt (length val)) + (forge--msg nil nil nil "Pulling pullreq %s/%s" pos cnt) + (forge--fetch-pullreq-posts repo cur cb)) + (forge--msg repo t t "Pulling REPO pullreqs") + (funcall callback callback (cons 'pullreqs val)))) + ((not (assq 'source_project (car cur))) + (forge--fetch-pullreq-source-repo repo cur cb)) + ((not (assq 'target_project (car cur))) + (forge--fetch-pullreq-target-repo repo cur cb)) + (t + (if (setq cur (cdr cur)) + (progn + (cl-incf pos) + (forge--msg nil nil nil "Pulling pullreq %s/%s" pos cnt) + (forge--fetch-pullreq-posts repo cur cb)) + (forge--msg repo t t "Pulling REPO pullreqs") + (funcall callback callback (cons 'pullreqs val))))))))) + (forge--msg repo t nil "Pulling REPO pullreqs") + (forge--glab-get repo "/projects/:project/merge_requests" + `((per_page . 100) + (order_by . "updated_at") + ,@(and-let* ((after (forge--topics-until repo until 'pullreq))) + `((updated_after . ,after)))) + :unpaginate t + :callback (lambda (value _headers _status _req) + (funcall cb cb value))))) + +(cl-defmethod forge--fetch-pullreq-posts + ((repo forge-gitlab-repository) cur cb) + (let-alist (car cur) + (forge--glab-get repo + (format "/projects/%s/merge_requests/%s/notes" .target_project_id .iid) + '((per_page . 100)) + :unpaginate t + :callback (lambda (value _headers _status _req) + (setf (alist-get 'notes (car cur)) value) + (funcall cb cb))))) + +(cl-defmethod forge--fetch-pullreq-source-repo + ((repo forge-gitlab-repository) cur cb) + ;; If the fork no longer exists, then `.source_project_id' is nil. + ;; This will lead to difficulties later on but there is nothing we + ;; can do about it. + (let-alist (car cur) + (if .source_project_id + (forge--glab-get repo (format "/projects/%s" .source_project_id) nil + :errorback (lambda (_err _headers _status _req) + (setf (alist-get 'source_project (car cur)) nil) + (funcall cb cb)) + :callback (lambda (value _headers _status _req) + (setf (alist-get 'source_project (car cur)) value) + (funcall cb cb))) + (setf (alist-get 'source_project (car cur)) nil) + (funcall cb cb)))) + +(cl-defmethod forge--fetch-pullreq-target-repo + ((repo forge-gitlab-repository) cur cb) + (let-alist (car cur) + (forge--glab-get repo (format "/projects/%s" .target_project_id) nil + :errorback (lambda (_err _headers _status _req) + (setf (alist-get 'target_project (car cur)) nil) + (funcall cb cb)) + :callback (lambda (value _headers _status _req) + (setf (alist-get 'target_project (car cur)) value) + (funcall cb cb))))) + +(cl-defmethod forge--update-pullreq ((repo forge-gitlab-repository) data) + (closql-with-transaction (forge-db) + (let-alist data + (let* ((pullreq-id (forge--object-id 'forge-pullreq repo .iid)) + (pullreq + (forge-pullreq + :id pullreq-id + :their-id .iid + :number .iid + :repository (oref repo id) + :state (pcase-exhaustive .state + ("merged" 'merged) + ("closed" 'closed) + ("opened" 'open)) + :author .author.username + :title .title + :created .created_at + :updated .updated_at + ;; `.merged_at' and `.closed_at' may both be nil even + ;; though the pullreq is merged or otherwise closed. + ;; In such cases use 1, so that these slots at least + ;; can serve as booleans. + :closed (or .closed_at + (and (member .state '("closed" "merged")) 1)) + :merged (or .merged_at + (and (equal .state "merged") 1)) + :draft-p .draft + :locked-p .discussion_locked + :editable-p .allow_maintainer_to_push + :cross-repo-p (not (equal .source_project_id + .target_project_id)) + :base-ref .target_branch + :base-rev .diff_refs.start_sha + :base-repo .target_project.path_with_namespace + :head-ref .source_branch + :head-rev .diff_refs.head_sha + :head-user .source_project.owner.username + :head-repo .source_project.path_with_namespace + :milestone .milestone.iid + :body (forge--sanitize-string .description)))) + (closql-insert (forge-db) pullreq t) + (unless (magit-get-boolean "forge.omitExpensive") + (forge--set-id-slot repo pullreq 'assignees .assignees) + (forge--set-id-slot repo pullreq 'review-requests .reviewers) + (forge--set-id-slot repo pullreq 'labels .labels)) + .body .id ; Silence Emacs 25 byte-compiler. + (dolist (c .notes) + (let-alist c + (let ((post + (forge-pullreq-post + :id (forge--object-id pullreq-id .id) + :pullreq pullreq-id + :number .id + :author .author.username + :created .created_at + :updated .updated_at + :body (forge--sanitize-string .body)))) + (closql-insert (forge-db) post t)))))))) + +;;;; Other + +;; The extend of the documentation for "GET /projects/:id/users" is +;; "Get the users list of a project." I don't know what that means, +;; but it stands to reason that this must at least overlap with the +;; set of users that can be assigned to topics. + +(cl-defmethod forge--fetch-assignees ((repo forge-gitlab-repository) callback) + (forge--glab-get repo "/projects/:project/users" + '((per_page . 100)) + :unpaginate t + :callback (lambda (value _headers _status _req) + (funcall callback callback (cons 'assignees value))))) + +(cl-defmethod forge--update-assignees ((repo forge-gitlab-repository) data) + (oset repo assignees + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + ;; For other forges we don't need to store `id' + ;; but here we do because that's what has to be + ;; used when assigning issues. + (list (forge--object-id id .id) + .username + .name + .id))) + data)))) + +(cl-defmethod forge--fetch-forks ((repo forge-gitlab-repository) callback) + (forge--glab-get repo "/projects/:project/forks" + '((per_page . 100) + (simple . t)) + :unpaginate t + :callback (lambda (value _headers _status _req) + (funcall callback callback (cons 'forks value))))) + +(cl-defmethod forge--update-forks ((repo forge-gitlab-repository) data) + (oset repo forks + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + (nconc (forge--repository-ids + (eieio-object-class repo) + (oref repo githost) + .namespace.path + .path) + (list .namespace.path + .path)))) + data)))) + +(cl-defmethod forge--fetch-labels ((repo forge-gitlab-repository) callback) + (forge--glab-get repo "/projects/:project/labels" + '((per_page . 100)) + :unpaginate t + :callback (lambda (value _headers _status _req) + (funcall callback callback (cons 'labels value))))) + +(cl-defmethod forge--update-labels ((repo forge-gitlab-repository) data) + (oset repo labels + (with-slots (id) repo + (mapcar (lambda (row) + (let-alist row + ;; We should use the label's `id' instead of its + ;; `name' but a topic's `labels' field is a list + ;; of names instead of a list of ids or an alist. + ;; As a result of this we cannot recognize when + ;; a label is renamed and a topic continues to be + ;; tagged with the old label name until it itself + ;; is modified somehow. Additionally it leads to + ;; name conflicts between group and project + ;; labels. See #160. + (list (forge--object-id id .name) + .name + (downcase .color) + .description))) + ;; For now simply remove one of the duplicates. + (cl-delete-duplicates data + :key (apply-partially #'alist-get 'name) + :test #'equal))))) + +;;;; Notifications + +;; The closest to notifications that Gitlab provides are "events" as +;; described at https://docs.gitlab.com/ee/api/events.html. This +;; allows us to see the last events that took place, but that is not +;; good enough because we are mostly interested in events we haven't +;; looked at yet. Gitlab doesn't make a distinction between unread +;; and read events, so this is rather useless and we don't use it for +;; the time being. + +;;; Mutations + +(cl-defmethod forge--submit-create-pullreq ((_ forge-gitlab-repository) base-repo) + (let-alist (forge--topic-parse-buffer) + (pcase-let* ((`(,base-remote . ,base-branch) + (magit-split-branch-name forge--buffer-base-branch)) + (`(,head-remote . ,head-branch) + (magit-split-branch-name forge--buffer-head-branch)) + (head-repo (forge-get-repository 'stub head-remote))) + (forge--glab-post head-repo "/projects/:project/merge_requests" + `((title . ,(if (if (local-variable-p 'forge-buffer-draft-p) + forge-buffer-draft-p + .draft) + (concat "Draft: " .title) + .title)) + (description . , .body) + ,@(and (not (equal head-remote base-remote)) + `((target_project_id . ,(oref base-repo forge-id)))) + (target_branch . ,base-branch) + (source_branch . ,head-branch) + (allow_collaboration . t)) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))))) + +(cl-defmethod forge--submit-create-issue ((_ forge-gitlab-repository) repo) + (let-alist (forge--topic-parse-buffer) + (forge--glab-post repo "/projects/:project/issues" + `((title . , .title) + (description . , .body)) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback)))) + +(cl-defmethod forge--submit-create-post ((_ forge-gitlab-repository) topic) + (forge--glab-post topic + (if (forge-issue-p topic) + "/projects/:project/issues/:number/notes" + "/projects/:project/merge_requests/:number/notes") + `((body . ,(string-trim (buffer-string)))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + +(cl-defmethod forge--submit-edit-post ((_ forge-gitlab-repository) post) + (forge--glab-put post + (cl-etypecase post + (forge-pullreq "/projects/:project/merge_requests/:number") + (forge-issue "/projects/:project/issues/:number") + (forge-issue-post "/projects/:project/issues/:topic/notes/:number") + (forge-pullreq-post "/projects/:project/merge_requests/:topic/notes/:number")) + (if (cl-typep post 'forge-topic) + (let-alist (forge--topic-parse-buffer) + ;; Keep Gitlab from claiming that the user + ;; changed the description when that isn't + ;; true. The same isn't necessary for the + ;; title; in that case Gitlab performs the + ;; necessary check itself. + `((title . , .title) + ,@(and (not (equal .body (oref post body))) + `((description . , .body))))) + `((body . ,(string-trim (buffer-string))))) + :callback (forge--post-submit-callback) + :errorback (forge--post-submit-errorback))) + +(cl-defmethod forge--set-topic-field + ((_repo forge-gitlab-repository) topic field value) + (forge--glab-put topic + (cl-typecase topic + (forge-pullreq "/projects/:project/merge_requests/:number") + (forge-issue "/projects/:project/issues/:number")) + `((,field . ,value)) + :callback (forge--set-field-callback))) + +(cl-defmethod forge--set-topic-title + ((repo forge-gitlab-repository) topic title) + (forge--set-topic-field repo topic 'title title)) + +(cl-defmethod forge--set-topic-state + ((repo forge-gitlab-repository) topic) + (forge--set-topic-field repo topic 'state_event + (cl-ecase (oref topic state) + (closed "reopen") + (open "close")))) + +(cl-defmethod forge--set-topic-draft + ((repo forge-gitlab-repository) topic value) + (let ((buffer (current-buffer))) + (glab-graphql + `(mutation (mergeRequestSetDraft + [(input $input MergeRequestSetDraftInput!)] + (mergeRequest iid draft))) + `((input (projectPath . ,(format "%s/%s" + (oref repo owner) + (oref repo name))) + (iid . ,(number-to-string (oref topic number))) + (draft . ,value))) + :host (oref (forge-get-repository topic) apihost) + :auth 'forge + :callback (lambda (data &rest _) + (if (assq 'error data) + (ghub--graphql-pp-response data) + (oset topic draft-p value) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (magit-refresh-buffer)))))))) + +(cl-defmethod forge--set-topic-labels + ((repo forge-gitlab-repository) topic labels) + (forge--set-topic-field repo topic 'labels + (mapconcat #'identity labels ","))) + +(cl-defmethod forge--set-topic-assignees + ((repo forge-gitlab-repository) topic assignees) + (let ((users (mapcar #'cdr (oref repo assignees)))) + (cl-typecase topic + (forge-pullreq ; Can only be assigned to a single user. + (forge--set-topic-field repo topic 'assignee_id + (or (caddr (assoc (car assignees) users)) + 0))) + (forge-issue + (forge--set-topic-field repo topic 'assignee_ids + (or (--map (caddr (assoc it users)) assignees) + 0)))))) + +(cl-defmethod forge--set-topic-review-requests + ((repo forge-gitlab-repository) topic reviewers) + (let ((users (mapcar #'cdr (oref repo assignees)))) + (forge--set-topic-field repo topic 'reviewer_ids + (or (--map (caddr (assoc it users)) reviewers) + 0)))) + +(cl-defmethod forge--delete-comment + ((_repo forge-gitlab-repository) post) + (forge--glab-delete post + (cl-etypecase post + (forge-pullreq-post + "/projects/:project/merge_requests/:topic/notes/:number") + (forge-issue-post + "/projects/:project/issues/:topic/notes/:number"))) + (closql-delete post) + (magit-refresh)) + +(cl-defmethod forge--topic-templates ((repo forge-gitlab-repository) + (_ (subclass forge-issue))) + (--filter (string-match-p "\\`\\.gitlab/issue_templates/.+\\.md\\'" it) + (magit-revision-files (oref repo default-branch)))) + +(cl-defmethod forge--topic-templates ((repo forge-gitlab-repository) + (_ (subclass forge-pullreq))) + (--filter (string-match-p "\\`\\.gitlab/merge_request_templates/.+\\.md\\'" it) + (magit-revision-files (oref repo default-branch)))) + +(cl-defmethod forge--fork-repository ((repo forge-gitlab-repository) fork) + (with-slots (owner name) repo + (forge--glab-post repo (format "/projects/%s%%2F%s/fork" owner name) + (and (not (equal fork (ghub--username (ghub--host nil)))) + `((namespace . ,fork))) + :noerror t) + (ghub-wait (format "/projects/%s%%2F%s" fork name) + nil :auth 'forge :forge 'gitlab))) + +(cl-defmethod forge--merge-pullreq ((_repo forge-gitlab-repository) + topic hash method) + (forge--glab-put topic + "/projects/:project/merge_requests/:number/merge" + `((squash . ,(eq method 'squash)) + ,@(and hash `((sha . ,hash)))))) + +;;; Utilities + +(cl-defmethod forge--topic-type-prefix ((_repo forge-gitlab-repository) type) + (if (eq type 'pullreq) "!" "#")) + +(cl-defun forge--glab-get (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (glab-get (if obj (forge--format-resource obj resource) resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback + :errorback (or errorback (and callback t)))) + +(cl-defun forge--glab-put (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (glab-put (if obj (forge--format-resource obj resource) resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback + :errorback (or errorback (and callback t)))) + +(cl-defun forge--glab-post (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (glab-post (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback + :errorback (or errorback (and callback t)))) + +(cl-defun forge--glab-delete (obj resource + &optional params + &key query payload headers + silent unpaginate noerror reader + host callback errorback) + (declare (indent defun)) + (glab-delete (forge--format-resource obj resource) + params + :host (or host (oref (forge-get-repository obj) apihost)) + :auth 'forge + :query query :payload payload :headers headers + :silent silent :unpaginate unpaginate + :noerror noerror :reader reader + :callback callback + :errorback (or errorback (and callback t)))) + +;;; _ +(provide 'forge-gitlab) +;;; forge-gitlab.el ends here diff --git a/elpa/forge-20230505.926/forge-gogs.el b/elpa/forge-20230505.926/forge-gogs.el new file mode 100644 index 00000000..a13aa8ac --- /dev/null +++ b/elpa/forge-20230505.926/forge-gogs.el @@ -0,0 +1,46 @@ +;;; forge-gogs.el --- Gogs support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Code: + +(require 'gogs) +(require 'forge) + +;;; Class + +(defclass forge-gogs-repository (forge-unusedapi-repository) + ((issues-url-format :initform "https://%h/%o/%n/issues") + (issue-url-format :initform "https://%h/%o/%n/issues/%i") + (issue-post-url-format :initform "https://%h/%o/%n/issues/%i#issuecomment-%I") + (pullreqs-url-format :initform "https://%h/%o/%n/pulls") + (pullreq-url-format :initform "https://%h/%o/%n/pulls/%i") + (pullreq-post-url-format :initform "https://%h/%o/%n/pulls/%i#issuecomment-%I") + (commit-url-format :initform "https://%h/%o/%n/commit/%r") + (branch-url-format :initform "https://%h/%o/%n/commits/%r") + (remote-url-format :initform "https://%h/%o/%n") + (create-issue-url-format :initform "https://%h/%o/%n/issues/new") + (create-pullreq-url-format :initform "https://%h/%o/%n/pulls") ; sic + (pullreq-refspec :initform "+refs/pull/*/head:refs/pullreqs/*"))) + +;;; _ +(provide 'forge-gogs) +;;; forge-gogs.el ends here diff --git a/elpa/forge-20230505.926/forge-issue.el b/elpa/forge-20230505.926/forge-issue.el new file mode 100644 index 00000000..1142e56d --- /dev/null +++ b/elpa/forge-20230505.926/forge-issue.el @@ -0,0 +1,225 @@ +;;; forge-issue.el --- Issue support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Code: + +(require 'forge) +(require 'forge-post) +(require 'forge-topic) + +;;; Classes + +(defclass forge-issue (forge-topic) + ((closql-table :initform 'issue) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(desc number)]) + (closql-foreign-key :initform 'repository) + (closql-class-prefix :initform "forge-") + (id :initarg :id) + (repository :initarg :repository) + (number :initarg :number) + (state :initarg :state) + (author :initarg :author) + (title :initarg :title) + (created :initarg :created) + (updated :initarg :updated) + (closed :initarg :closed) + (unread-p :initarg :unread-p :initform nil) + (locked-p :initarg :locked-p) + (milestone :initarg :milestone) + (body :initarg :body) + (assignees :closql-table (issue-assignee assignee)) + (project-cards) ; projectsCards + (edits) ; userContentEdits + (labels :closql-table (issue-label label)) + (participants) + (posts :closql-class forge-issue-post) + (reactions) + (timeline) + (marks :closql-table (issue-mark mark)) + (note :initarg :note :initform nil) + (their-id :initarg :their-id) + )) + +(defclass forge-issue-post (forge-post) + ((closql-table :initform 'issue-post) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(asc number)]) + (closql-foreign-key :initform 'issue) + (closql-class-prefix :initform "forge-issue-") + (id :initarg :id) + (issue :initarg :issue) + (number :initarg :number) + (author :initarg :author) + (created :initarg :created) + (updated :initarg :updated) + (body :initarg :body) + (edits) + (reactions) + )) + +;;; Query + +(cl-defmethod forge-get-repository ((post forge-issue-post)) + (forge-get-repository (forge-get-issue post))) + +(cl-defmethod forge-get-topic ((post forge-issue-post)) + (forge-get-issue post)) + +(cl-defmethod forge-get-issue ((issue forge-issue)) + issue) + +(cl-defmethod forge-get-issue ((repo forge-repository) number) + (closql-get (forge-db) + (forge--object-id 'forge-issue repo number) + 'forge-issue)) + +(cl-defmethod forge-get-issue ((number integer)) + (and-let* ((repo (forge-get-repository t))) + (forge-get-issue repo number))) + +(cl-defmethod forge-get-issue ((id string)) + (closql-get (forge-db) id 'forge-issue)) + +(cl-defmethod forge-get-issue ((post forge-issue-post)) + (closql-get (forge-db) + (oref post issue) + 'forge-issue)) + +(cl-defmethod forge-ls-issues ((repo forge-repository) &optional type select) + (forge-ls-topics repo 'forge-issue type select)) + +;;; Utilities + +(defun forge-read-issue (prompt &optional type) + (when (eq type t) + (setq type (if current-prefix-arg nil 'open))) + (let* ((default (forge-current-issue)) + (repo (forge-get-repository (or default t))) + (choices (mapcar + (apply-partially #'forge--topic-format-choice repo) + (forge-ls-issues repo type [number title id class])))) + (cdr (assoc (magit-completing-read + prompt choices nil nil nil nil + (and default + (setq default (forge--topic-format-choice default)) + (member default choices) + (car default))) + choices)))) + +(cl-defmethod forge-get-url ((issue forge-issue)) + (forge--format issue 'issue-url-format)) + +(defun forge--issue-by-forge-short-link-at-point () + (forge--topic-by-forge-short-link-at-point '("#") #'forge-get-issue)) + +;;; Sections + +(defun forge-current-issue () + (or (forge-issue-at-point) + (and (derived-mode-p 'forge-topic-mode) + (forge-issue-p forge-buffer-topic) + forge-buffer-topic) + (and (derived-mode-p 'forge-topic-list-mode) + (let ((topic (forge-get-topic (tabulated-list-get-id)))) + (and (forge-issue-p topic) + topic))))) + +(defun forge-issue-at-point () + (or (magit-section-value-if 'issue) + (and-let* ((post (magit-section-value-if 'post))) + (cond ((forge-issue-p post) + post) + ((forge-issue-post-p post) + (forge-get-issue post)))) + (forge--issue-by-forge-short-link-at-point))) + +(defvar-keymap forge-issues-section-map + " " #'forge-browse-issues + " " #'forge-list-issues + "C-c C-n" #'forge-create-issue) + +(defvar-keymap forge-issue-section-map + " " #'forge-browse-issue + " " #'forge-visit-issue) + +(defun forge-insert-issues () + "Insert a list of mostly recent and/or open issues. +Also see option `forge-topic-list-limit'." + (when (and forge-display-in-status-buffer (forge-db t)) + (when-let ((repo (forge-get-repository nil))) + (when (and (not (oref repo sparse-p)) + (or (not (slot-boundp repo 'issues-p)) ; temporary KLUDGE + (oref repo issues-p))) + (forge-insert-topics "Issues" + (forge-ls-recent-topics repo 'issue) + (forge--topic-type-prefix repo 'issue)))))) + +(defun forge-insert-assigned-issues () + "Insert a list of open issues that are assigned to you." + (when forge-display-in-status-buffer + (when-let ((repo (forge-get-repository nil))) + (unless (oref repo sparse-p) + (forge-insert-topics "Assigned issues" + (forge--ls-assigned-issues repo) + (forge--topic-type-prefix repo 'issue)))))) + +(defun forge--ls-assigned-issues (repo) + (mapcar (lambda (row) + (closql--remake-instance 'forge-issue (forge-db) row)) + (forge-sql + [:select $i1 :from [issue issue_assignee assignee] + :where (and (= issue_assignee:issue issue:id) + (= issue_assignee:id assignee:id) + (= issue:repository $s2) + (= assignee:login $s3) + (isnull issue:closed)) + :order-by [(desc updated)]] + (vconcat (closql--table-columns (forge-db) 'issue t)) + (oref repo id) + (ghub--username repo)))) + +(defun forge-insert-authored-issues () + "Insert a list of open issues that are authored to you." + (when forge-display-in-status-buffer + (when-let ((repo (forge-get-repository nil))) + (unless (oref repo sparse-p) + (forge-insert-topics "Authored issues" + (forge--ls-authored-issues repo) + (forge--topic-type-prefix repo 'issue)))))) + +(defun forge--ls-authored-issues (repo) + (mapcar (lambda (row) + (closql--remake-instance 'forge-issue (forge-db) row)) + (forge-sql + [:select $i1 :from [issue] + :where (and (= issue:repository $s2) + (= issue:author $s3) + (isnull issue:closed)) + :order-by [(desc updated)]] + (vconcat (closql--table-columns (forge-db) 'issue t)) + (oref repo id) + (ghub--username repo)))) + +;;; _ +(provide 'forge-issue) +;;; forge-issue.el ends here diff --git a/elpa/forge-20230505.926/forge-list.el b/elpa/forge-20230505.926/forge-list.el new file mode 100644 index 00000000..edd4154f --- /dev/null +++ b/elpa/forge-20230505.926/forge-list.el @@ -0,0 +1,465 @@ +;;; forge-list.el --- Tabulated-list interface -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Code: + +(require 'forge) + +(defvar x-stretch-cursor) + +;;; Options + +(defcustom forge-topic-list-mode-hook '(hl-line-mode) + "Hook run after entering Forge-Topic-List mode." + :package-version '(forge . "0.1.0") + :group 'forge + :type 'hook + :options '(hl-line-mode)) + +(defvar forge-topic-list-columns + '(("#" 5 forge-topic-list-sort-by-number (:right-align t) number nil) + ("Title" 35 t nil title nil) + )) + +(defvar forge-global-topic-list-columns + '(("Owner" 15 t nil repository:owner nil) + ("Name" 20 t nil repository:name nil) + ("#" 5 forge-topic-list-sort-by-number (:right-align t) number nil) + ("Title" 35 t nil title nil) + )) + +(defvar forge-repository-list-columns + '(("Owner" 20 t nil owner nil) + ("Name" 20 t nil name nil) + ("N" 1 t nil sparse-p nil) + ("S" 1 t nil selective-p nil) + ("Worktree" 99 t nil worktree nil) + )) + +(defcustom forge-owned-accounts nil + "An alist of accounts that are owned by you. +This should include your username as well as any organization +that you own. Used by the commands `forge-list-owned-issues', +`forge-list-owned-pullreqs' and `forge-fork'. + +Each element has the form (ACCOUNT . PLIST). The following +properties are currently being used: + +`remote-name' The default name suggested by `forge-fork' for a + fork created within this account. If unspecified, then the + name of the account is used." + :package-version '(forge . "0.2.0") + :group 'forge + :type '(repeat (cons (string :tag "Account") plist))) + +(define-obsolete-variable-alias 'forge-owned-blacklist + 'forge-owned-ignored "Forge 3.0.0") + +(defcustom forge-owned-ignored nil + "A list of repositories that are ignored when listing those owned by you. +This is a list of package names. Used by the commands +`forge-list-owned-issues' and `forge-list-owned-pullreqs'." + :package-version '(forge . "0.2.0") + :group 'forge + :type '(repeat (string :tag "Name"))) + +;;; Variables + +(defvar-local forge--tabulated-list-columns nil) +(put 'forge--tabulated-list-columns 'permanent-local t) + +(defvar-local forge--tabulated-list-query nil) +(put 'forge--tabulated-list-query 'permanent-local t) + +;;; Modes +;;;; Topics + +(defvar-keymap forge-topic-list-mode-map + :doc "Local keymap for Forge-Topic-List mode buffers." + :parent tabulated-list-mode-map + "RET" #'forge-visit-topic + "" #'forge-visit-topic + "o" #'forge-browse-topic + "'" #'forge-dispatch + "?" #'magit-dispatch) + +(define-derived-mode forge-topic-list-mode tabulated-list-mode + "Issues" + "Major mode for browsing a list of topics." + (setq-local x-stretch-cursor nil) + (setq tabulated-list-padding 0) + (setq tabulated-list-sort-key (cons "#" nil))) + +(define-derived-mode forge-issue-list-mode forge-topic-list-mode + "Issues" + "Major mode for browsing a list of issues.") + +(define-derived-mode forge-pullreq-list-mode forge-topic-list-mode + "Pull-Requests" + "Major mode for browsing a list of pull-requests.") + +(defun forge-topic-list-setup (mode id buffer-name columns fn) + (declare (indent 4)) + (let* ((repo (forge-get-repository (list :id id))) + (topdir (magit-toplevel))) + (with-current-buffer + (get-buffer-create + (or buffer-name + (format "*%s: %s/%s*" + (substring (symbol-name mode) 0 -5) + (oref repo owner) + (oref repo name)))) + (setq forge--tabulated-list-columns (or columns forge-topic-list-columns)) + (setq forge--tabulated-list-query fn) + (setq forge-buffer-repository repo) + (when topdir + (setq default-directory topdir)) + (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229 + (funcall mode)) + (forge-topic-list-refresh) + (add-hook 'tabulated-list-revert-hook + #'forge-topic-list-refresh nil t) + (tabulated-list-init-header) + (tabulated-list-print) + (switch-to-buffer (current-buffer))))) + +(defun forge-topic-list-refresh () + (setq tabulated-list-format + (vconcat (--map `(,@(-take 3 it) + ,@(-flatten (nth 3 it))) + forge--tabulated-list-columns))) + (tabulated-list-init-header) + (setq tabulated-list-entries + (mapcar #'forge--tablist-format-entry + (funcall forge--tabulated-list-query)))) + +;;;; Repository + +(defvar-keymap forge-repository-list-mode-map + :doc "Local keymap for Forge-Repository-List mode buffers." + :parent tabulated-list-mode-map + "RET" #'forge-visit-repository + "" #'forge-visit-repository + "o" #'forge-browse-repository + "'" #'forge-dispatch + "?" #'magit-dispatch) + +(define-derived-mode forge-repository-list-mode tabulated-list-mode + "Repositories" + "Major mode for browsing a list of repositories." + (setq-local x-stretch-cursor nil) + (setq forge--tabulated-list-columns forge-repository-list-columns) + (setq tabulated-list-padding 0) + (setq tabulated-list-sort-key (cons "Owner" nil)) + (setq tabulated-list-format + (vconcat (--map `(,@(-take 3 it) + ,@(-flatten (nth 3 it))) + forge-repository-list-columns))) + (tabulated-list-init-header)) + +(defun forge-repository-list-setup (fn buf) + (with-current-buffer (get-buffer-create buf) + (cl-letf (((symbol-function #'tabulated-list-revert) #'ignore)) ; see #229 + (forge-repository-list-mode)) + (funcall fn) + (add-hook 'tabulated-list-revert-hook fn nil t) + (tabulated-list-print) + (switch-to-buffer (current-buffer)))) + +(defun forge-repository-list-refresh () + (setq tabulated-list-entries + (mapcar #'forge--tablist-format-entry + (forge-sql [:select $i1 :from repository + :order-by [(asc owner) (asc name)]] + (forge--tablist-columns-vector))))) + +(defun forge-repository-list-owned-refresh () + (setq tabulated-list-entries + (mapcar #'forge--tablist-format-entry + (forge-sql [:select $i1 :from repository + :where (and (in owner $v2) + (not (in name $v3))) + :order-by [(asc owner) (asc name)]] + (forge--tablist-columns-vector) + (vconcat (mapcar #'car forge-owned-accounts)) + (vconcat forge-owned-ignored))))) + +;;; Commands +;;;; Topic + +;;;###autoload +(defun forge-list-topics (id) + "List topics of the current repository in a separate buffer." + (interactive (list (oref (forge-get-repository t) id))) + (forge-topic-list-setup #'forge-topic-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from issue :where (= repository $s2) :union + :select $i1 :from pullreq :where (= repository $s2)] + (forge--tablist-columns-vector) + id)))) + +;;;; Issue + +;;;###autoload +(defun forge-list-issues (id) + "List issues of the current repository in a separate buffer." + (interactive (list (oref (forge-get-repository t) id))) + (forge-topic-list-setup #'forge-issue-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from issue :where (= repository $s2)] + (forge--tablist-columns-vector) + id)))) + +;;;###autoload +(defun forge-list-labeled-issues (id label) + "List issues of the current repository that have LABEL. +List them in a separate buffer." + (interactive (list (oref (forge-get-repository t) id) + (magit-completing-read + "Label" + (mapcar #'cadr (oref (forge-get-repository t) labels)) + nil t))) + (forge-topic-list-setup #'forge-issue-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from [issue issue_label label] + :where (and (= issue_label:issue issue:id) + (= issue_label:id label:id) + (= issue:repository $s2) + (= label:name $s3) + (isnull issue:closed)) + :order-by [(desc updated)]] + (forge--tablist-columns-vector 'issue) + id label)))) + +;;;###autoload +(defun forge-list-assigned-issues (id) + "List issues of the current repository that are assigned to you. +List them in a separate buffer." + (interactive (list (oref (forge-get-repository t) id))) + (forge-topic-list-setup #'forge-issue-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from [issue issue_assignee assignee] + :where (and (= issue_assignee:issue issue:id) + (= issue_assignee:id assignee:id) + (= issue:repository $s2) + (= assignee:login $s3) + (isnull issue:closed)) + :order-by [(desc updated)]] + (forge--tablist-columns-vector 'issue) + id (ghub--username (forge-get-repository (list :id id))))))) + +;;;###autoload +(defun forge-list-owned-issues () + "List open issues from all your Github repositories. +Options `forge-owned-accounts' and `forge-owned-ignored' +controls which repositories are considered to be owned by you. +Only Github is supported for now." + (interactive) + (forge-topic-list-setup #'forge-issue-list-mode nil "My issues" + forge-global-topic-list-columns + (lambda () + (forge-sql [:select $i1 :from [issue repository] + :where (and (= issue:repository repository:id) + (in repository:owner $v2) + (not (in repository:name $v3)) + (isnull issue:closed)) + :order-by [(asc repository:owner) + (asc repository:name) + (desc issue:number)]] + (forge--tablist-columns-vector 'issue) + (vconcat (mapcar #'car forge-owned-accounts)) + (vconcat forge-owned-ignored))))) + +;;;; Pullreq + +;;;###autoload +(defun forge-list-pullreqs (id) + "List pull-requests of the current repository in a separate buffer." + (interactive (list (oref (forge-get-repository t) id))) + (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from pullreq :where (= repository $s2)] + (forge--tablist-columns-vector) + id)))) + +;;;###autoload +(defun forge-list-labeled-pullreqs (id label) + "List pull-requests of the current repository that have LABEL. +List them in a separate buffer." + (interactive (list (oref (forge-get-repository t) id) + (magit-completing-read + "Label" + (mapcar #'cadr (oref (forge-get-repository t) labels)) + nil t))) + (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from [pullreq pullreq_label label] + :where (and (= pullreq_label:pullreq pullreq:id) + (= pullreq_label:id label:id) + (= pullreq:repository $s2) + (= label:name $s3) + (isnull pullreq:closed)) + :order-by [(desc updated)]] + (forge--tablist-columns-vector 'pullreq) + id label)))) + +;;;###autoload +(defun forge-list-assigned-pullreqs (id) + "List pull-requests of the current repository that are assigned to you. +List them in a separate buffer." + (interactive (list (oref (forge-get-repository t) id))) + (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from [pullreq pullreq_assignee assignee] + :where (and (= pullreq_assignee:pullreq pullreq:id) + (= pullreq_assignee:id assignee:id) + (= pullreq:repository $s2) + (= assignee:login $s3) + (isnull pullreq:closed)) + :order-by [(desc updated)]] + (forge--tablist-columns-vector 'pullreq) + id (ghub--username (forge-get-repository (list :id id))))))) + +;;;###autoload +(defun forge-list-requested-reviews (id) + "List pull-requests of the current repository that are awaiting your review. +List them in a separate buffer." + (interactive (list (oref (forge-get-repository t) id))) + (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from [pullreq pullreq_review_request assignee] + :where (and (= pullreq_review_request:pullreq pullreq:id) + (= pullreq_review_request:id assignee:id) + (= pullreq:repository $s2) + (= assignee:login $s3) + (isnull pullreq:closed)) + :order-by [(desc updated)]] + (forge--tablist-columns-vector 'pullreq) + id (ghub--username (forge-get-repository (list :id id))))))) + +;;;###autoload +(defun forge-list-owned-pullreqs () + "List open pull-requests from all your Github repositories. +Options `forge-owned-accounts' and `forge-owned-ignored' +controls which repositories are considered to be owned by you. +Only Github is supported for now." + (interactive) + (forge-topic-list-setup #'forge-pullreq-list-mode nil "My pullreqs" + forge-global-topic-list-columns + (lambda () + (forge-sql [:select $i1 :from [pullreq repository] + :where (and (= pullreq:repository repository:id) + (in repository:owner $v2) + (not (in repository:name $v3)) + (isnull pullreq:closed)) + :order-by [(asc repository:owner) + (asc repository:name) + (desc pullreq:number)]] + (forge--tablist-columns-vector 'pullreq) + (vconcat (mapcar #'car forge-owned-accounts)) + (vconcat forge-owned-ignored))))) + +;;;###autoload +(defun forge-list-authored-pullreqs (id) + "List open pull-requests of the current repository that are authored by you. +List them in a separate buffer." + (interactive (list (oref (forge-get-repository t) id))) + (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from [pullreq] + :where (and (= pullreq:repository $s2) + (= pullreq:author $s3) + (isnull pullreq:closed)) + :order-by [(desc updated)]] + (forge--tablist-columns-vector 'pullreq) + id (ghub--username (forge-get-repository (list :id id))))))) + +;;;###autoload +(defun forge-list-authored-issues (id) + "List open issues from the current repository that are authored by you. +List them in a separate buffer." + (interactive (list (oref (forge-get-repository t) id))) + (forge-topic-list-setup #'forge-pullreq-list-mode id nil nil + (lambda () + (forge-sql [:select $i1 :from [issue] + :where (and (= issue:repository $s2) + (= issue:author $s3) + (isnull issue:closed)) + :order-by [(desc updated)]] + (forge--tablist-columns-vector 'issue) + id (ghub--username (forge-get-repository (list :id id))))))) + +;;;; Repository + +;;;###autoload +(defun forge-list-repositories () + "List known repositories in a separate buffer. +Here \"known\" means that an entry exists in the local database." + (interactive) + (forge-repository-list-setup #'forge-repository-list-refresh + "*Forge Repositories*")) + +;;;###autoload +(defun forge-list-owned-repositories () + "List your own known repositories in a separate buffer. +Here \"known\" means that an entry exists in the local database +and options `forge-owned-accounts' and `forge-owned-ignored' +controls which repositories are considered to be owned by you. +Only Github is supported for now." + (interactive) + (forge-repository-list-setup #'forge-repository-list-owned-refresh + "*Forge Owned Repositories*")) + +;;; Internal + +(defun forge-topic-list-sort-by-number (a b) + "Sort the `tabulated-list-entries' by topic number. +This assumes that `number' is the first column, otherwise +it silently fails." + (ignore-errors + (> (read (aref (cadr a) 0)) + (read (aref (cadr b) 0))))) + +(defun forge--tablist-columns-vector (&optional table) + (let ((columns (cons 'id (--map (nth 4 it) forge--tabulated-list-columns)))) + (vconcat (if table + (let ((table (symbol-name table))) + (--map (let ((col (symbol-name it))) + (if (string-search ":" col) + it + (intern (concat table ":" col)))) + columns)) + columns)))) + +(defun forge--tablist-format-entry (row) + (list (car row) + (vconcat + (cl-mapcar (lambda (val col) + (if-let ((pp (nth 5 col))) + (funcall pp val) + (if val (format "%s" val) ""))) + (cdr row) + forge--tabulated-list-columns)))) + +;;; _ +(provide 'forge-list) +;;; forge-list.el ends here diff --git a/elpa/forge-20230505.926/forge-notify.el b/elpa/forge-20230505.926/forge-notify.el new file mode 100644 index 00000000..471deed7 --- /dev/null +++ b/elpa/forge-20230505.926/forge-notify.el @@ -0,0 +1,151 @@ +;;; forge-notify.el --- Notify support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Code: + +(require 'forge) + +;;; Class + +(defclass forge-notification (forge-object) + ((closql-class-prefix :initform "forge-") + (closql-table :initform 'notification) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(desc id)]) + (id :initarg :id) + (thread-id :initarg :thread-id) + (repository :initarg :repository) + (forge :initarg :forge) + (reason :initarg :reason) + (unread-p :initarg :unread-p) + (last-read :initarg :last-read) + (updated :initarg :updated) + (title :initarg :title) + (type :initarg :type) + (topic :initarg :topic) + (url :initarg :url))) + +;;; Core + +(cl-defmethod forge-get-repository ((notify forge-notification)) + "Return the object for the repository that NOTIFY belongs to." + (and-let* ((id (oref notify repository))) + (closql-get (forge-db) id 'forge-repository))) + +(cl-defmethod forge-get-notification ((topic forge-topic)) + (and-let* ((row (car (forge-sql [:select * :from notification + :where (and (= repository $s1) + (= topic $s2))] + (oref topic repository) + (oref topic number))))) + (closql--remake-instance 'forge-notification (forge-db) row))) + +;;; Utilities + +(cl-defmethod forge-get-url ((notify forge-notification)) + (oref notify url)) + +;;; Mode + +(defvar-keymap forge-notifications-mode-map + :doc "Keymap for `forge-notifications-mode'." + :parent magit-mode-map) + +(define-derived-mode forge-notifications-mode magit-mode "Forge Notifications" + "Mode for looking at forge notifications." + (hack-dir-local-variables-non-file-buffer)) + +(defun forge-notifications-setup-buffer () + ;; There should only ever be one such buffer. + (cl-letf (((symbol-function 'magit-get-mode-buffer) + (lambda (&rest _) + (get-buffer-create "*forge-notifications*")))) + (magit-setup-buffer #'forge-notifications-mode))) + +(defun forge-notifications-refresh-buffer () + (forge-insert-notifications)) + +;;; Utilities + +(defun forge--list-notifications-all () + (closql-query (forge-db) nil nil 'forge-notification)) + +(defun forge--list-notifications-unread () + (mapcar (lambda (row) + (closql--remake-instance 'forge-notification (forge-db) row)) + (forge-sql [:select * :from notification + :where (notnull unread-p) + :order-by [(desc id)]]))) + +;;; Sections + +;; The double-prefix is necessary due to a limitation of magit-insert-section. +(defvar-keymap forge-forge-repo-section-map + " " #'forge-browse-repository + " " #'forge-visit-repository) + +(defun forge-insert-notifications () + (when-let ((ns (forge--list-notifications-all))) + (magit-insert-section (notifications) + (magit-insert-heading "Notifications:") + (pcase-dolist (`(,_ . ,ns) (--group-by (oref it repository) ns)) + (let ((repo (forge-get-repository (car ns)))) + (magit-insert-section (forge-repo repo t) + (magit-insert-heading + (concat (propertize (format "%s/%s" + (oref repo owner) + (oref repo name)) + 'font-lock-face 'bold) + (format " (%s)" (length ns)))) + (magit-insert-section-body + (dolist (notify ns) + (with-slots (type topic title url unread-p) notify + (pcase type + ('issue + (forge-insert-topic (forge-get-issue repo topic))) + ('pullreq + (forge-insert-topic (forge-get-pullreq repo topic))) + ('commit + (magit-insert-section (ncommit nil) ; !commit + (string-match "[^/]*\\'" url) + (insert + (format "%s %s\n" + (propertize (substring (match-string 0 url) + 0 (magit-abbrev-length)) + 'font-lock-face 'magit-hash) + (magit-log-propertize-keywords + nil (propertize title 'font-lock-face + (if unread-p + 'forge-topic-unread + 'forge-topic-open))))))) + (_ + ;; The documentation does not mention what "types" + ;; exist. Make it obvious that this is something + ;; we do not know how to handle properly yet. + (magit-insert-section (notification notify) + (insert (propertize (format "(%s) %s\n" type title) + 'font-lock-face 'error))))))) + (insert ?\n)))))))) + +;;; _ +(provide 'forge-notify) +;;; forge-notify.el ends here diff --git a/elpa/forge-20230505.926/forge-pkg.el b/elpa/forge-20230505.926/forge-pkg.el new file mode 100644 index 00000000..7f28e073 --- /dev/null +++ b/elpa/forge-20230505.926/forge-pkg.el @@ -0,0 +1,22 @@ +(define-package "forge" "20230505.926" "Access Git forges from Magit." + '((emacs "25.1") + (compat "29.1.3.4") + (closql "20230407") + (dash "2.19.1") + (emacsql "20230409") + (ghub "20220621") + (let-alist "1.0.6") + (magit "20230319") + (markdown-mode "2.4") + (transient "0.3.6") + (yaml "0.3.5")) + :commit "12428a702fc6c9b2b36896803e6022baafcad3cd" :authors + '(("Jonas Bernoulli" . "jonas@bernoul.li")) + :maintainer + '("Jonas Bernoulli" . "jonas@bernoul.li") + :keywords + '("git" "tools" "vc") + :url "https://github.com/magit/forge") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/forge-20230505.926/forge-post.el b/elpa/forge-20230505.926/forge-post.el new file mode 100644 index 00000000..4e76e6e1 --- /dev/null +++ b/elpa/forge-20230505.926/forge-post.el @@ -0,0 +1,286 @@ +;;; forge-post.el --- Post support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Code: + +(require 'markdown-mode) + +(require 'forge) + +;;; Options + +(defcustom forge-post-mode-hook + '(visual-line-mode + turn-on-flyspell) + "Hook run after entering Forge-Post mode." + :package-version '(forge . "0.2.0") + :group 'forge + :type 'hook + :options '(visual-line-mode + turn-on-flyspell)) + +(defcustom forge-buffer-draft-p nil + "Whether new pull-requests start out as drafts by default. + +The buffer-local value is use to keep track of the draft status +of the current pull-request." + :package-version '(forge . "0.4.0") + :group 'forge + :type 'boolean) + +;;; Class + +(defclass forge-post (forge-object) () :abstract t) + +;;; Query + +(cl-defmethod forge-get-parent ((post forge-post)) + (forge-get-topic post)) + +(cl-defmethod forge-get-repository ((post forge-post)) + (forge-get-repository (forge-get-topic post))) + +;;; Utilities + +(cl-defmethod forge-get-url ((post forge-post)) + (forge--format post (let ((topic (forge-get-parent post))) + (cond ((forge--childp topic 'forge-issue) + 'issue-post-url-format) + ((forge--childp topic 'forge-pullreq) + 'pullreq-post-url-format))))) + +(cl-defmethod forge-browse :after ((post forge-post)) + (oset (forge-get-topic post) unread-p nil)) + +;;; Sections + +(defun forge-post-at-point () + (magit-section-value-if '(issue pullreq post))) + +(defun forge-comment-at-point () + (and (magit-section-value-if '(post)) + (let ((post (oref (magit-current-section) value))) + (and (or (forge-pullreq-post-p post) + (forge-issue-post-p post)) + post)))) + +(defun forge-topic-at-point () + (or (magit-section-value-if '(issue pullreq)) + (and-let* ((branch (magit-branch-at-point)) + (n (magit-get "branch" branch "pullRequest"))) + (forge-get-pullreq (string-to-number n))) + (and-let* ((rev (magit-commit-at-point))) + (forge--pullreq-from-rev rev)) + (forge--issue-by-forge-short-link-at-point) + (forge--pullreq-by-forge-short-link-at-point))) + +(defun forge-current-topic () + (or (forge-topic-at-point) + (and (derived-mode-p 'forge-topic-mode) + forge-buffer-topic) + (and (derived-mode-p 'forge-topic-list-mode) + (forge-get-topic (tabulated-list-get-id))))) + +(defun forge--pullreq-from-rev (rev) + (and-let* ((repo (forge-get-repository nil)) + (refspec (oref repo pullreq-refspec)) + (name (magit-rev-name rev (cadr (split-string refspec ":"))))) + (save-match-data + (and (string-match "\\([0-9]*\\)\\([~^][0-9]*\\)?\\'" name) + (forge-get-pullreq (string-to-number (match-string 0 name))))))) + +;;; Utilities + +(cl-defmethod forge--format ((post forge-post) slot &optional spec) + (forge--format (forge-get-topic post) slot + `(,@spec (?I . ,(oref post number))))) + +;;; Mode + +(defvar-keymap forge-post-mode-map + "C-c C-e" #'forge-post-dispatch + "C-c C-c" #'forge-post-submit + " " #'forge-post-submit + " " #'forge-post-submit + "C-c C-k" #'forge-post-cancel + " " #'forge-post-cancel + " " #'forge-post-cancel + " " #'forge-post-cancel + " " #'forge-post-cancel) + +(define-derived-mode forge-post-mode gfm-mode "Forge-Post" "") + +(defvar-local forge--buffer-base-branch nil) +(defvar-local forge--buffer-head-branch nil) +(defvar-local forge--buffer-post-object nil) +(defvar-local forge--buffer-issue nil) +(defvar-local forge--submit-post-function nil) +(defvar-local forge--cancel-post-function nil) +(defvar-local forge--pre-post-buffer nil) +(make-variable-buffer-local 'forge-buffer-draft-p) + +(defun forge--prepare-post-buffer (filename &optional header source target) + (let ((file (convert-standard-filename + (expand-file-name (concat "magit/posts/" filename) + (magit-gitdir))))) + (make-directory (file-name-directory file) t) + (let ((prevbuf (current-buffer)) + (resume (and (file-exists-p file) + (> (file-attribute-size (file-attributes file)) 0))) + (buf (find-file-noselect file))) + (with-current-buffer buf + (forge-post-mode) + (when header + (magit-set-header-line-format header)) + (setq forge--pre-post-buffer prevbuf) + (when resume + (forge--display-post-buffer buf) + (when (magit-read-char-case "A draft already exists. " nil + (?r "[r]esume editing existing draft") + (?d "[d]iscard draft and start over" t)) + (erase-buffer) + (setq resume nil))) + (when (and (not resume) (string-prefix-p "new" filename)) + (let-alist (forge--topic-template + (forge-get-repository t) + (if source 'forge-pullreq 'forge-issue)) + (cond + (.url + (browse-url .url) + (forge-post-cancel) + (setq buf nil) + (message "Using browser to visit %s instead of opening an issue" + .url)) + (.name + ;; A Github issue with yaml frontmatter. + (save-excursion (insert .text)) + (unless (re-search-forward "^title: " nil t) + (when (re-search-forward "^---" nil t 2) + (beginning-of-line) + (insert "title: \n") + (backward-char)))) + (t + (insert "# ") + (let ((single + (and source + (= (car (magit-rev-diff-count source target)) 1)))) + (save-excursion + (when single + ;; A pull-request. + (magit-rev-insert-format "%B" source)) + (when .text + (if single + (insert "-------\n") + (insert "\n")) + (insert "\n" .text))))))))) + buf))) + +(defun forge--display-post-buffer (buf) + (magit-display-buffer buf #'display-buffer)) + +(defun forge-post-cancel () + "Cancel the post that is being edited in the current buffer." + (interactive) + (save-buffer) + (if-let ((fn forge--cancel-post-function)) + (funcall fn forge--buffer-post-object) + (magit-mode-bury-buffer 'kill))) + +(defun forge-post-submit () + "Submit the post that is being edited in the current buffer." + (interactive) + (save-buffer) + (if-let ((fn forge--submit-post-function)) + (funcall fn + (forge-get-repository forge--buffer-post-object) + forge--buffer-post-object) + (error "forge--submit-post-function is nil"))) + +(defun forge--post-submit-callback () + (let* ((file buffer-file-name) + (editbuf (current-buffer)) + (prevbuf forge--pre-post-buffer) + (topic (ignore-errors (forge-get-topic forge--buffer-post-object))) + (repo (forge-get-repository topic))) + (lambda (value headers status req) + (run-hook-with-args 'forge-post-submit-callback-hook + value headers status req) + (delete-file file t) + (let ((dir (file-name-directory file))) + (unless (cddr (directory-files dir nil nil t)) + (delete-directory dir nil t))) + (when (buffer-live-p editbuf) + (with-current-buffer editbuf + (magit-mode-bury-buffer 'kill))) + (with-current-buffer + (if (buffer-live-p prevbuf) prevbuf (current-buffer)) + (if (and topic + (forge--childp repo 'forge-github-repository) + (or (and (fboundp 'forge-pullreq-p) + (forge-pullreq-p topic)) + (oref repo selective-p))) + (forge--pull-topic repo topic) + (forge-pull)))))) + +(defun forge--post-submit-errorback () + (lambda (error &rest _) + (error "Failed to submit post: %S" error))) + +(transient-define-prefix forge-post-dispatch () + "Dispatch a post creation command." + ["Variables" + ("d" "Create draft" forge-post-toggle-draft)] + ["Act" + ("C-c" "Submit" forge-post-submit) + ("C-k" "Cancel" forge-post-cancel)]) + +(transient-define-infix forge-post-toggle-draft () + "Toggle whether the pull-request being created is a draft." + :class 'transient-lisp-variable + :variable 'forge-buffer-draft-p + :reader (lambda (&rest _) (not forge-buffer-draft-p)) + :if (lambda () (equal (file-name-nondirectory buffer-file-name) "new-pullreq"))) + +;;; Notes + +(defclass forge-note (forge-post) ()) + +(defvar-keymap forge-note-section-map + " " #'forge-edit-topic-note) + +(defun forge--save-note (_repo topic) + (let ((value (string-trim (buffer-substring-no-properties + (point-min) + (point-max))))) + (oset topic note (if (equal value "") nil value))) + (delete-file buffer-file-name t) + (let ((dir (file-name-directory buffer-file-name))) + (unless (cddr (directory-files dir nil nil t)) + (delete-directory dir))) + (let ((prevbuf forge--pre-post-buffer)) + (magit-mode-bury-buffer 'kill) + (when (buffer-live-p prevbuf) + (magit-refresh)))) + +;;; _ +(provide 'forge-post) +;;; forge-post.el ends here diff --git a/elpa/forge-20230505.926/forge-pullreq.el b/elpa/forge-20230505.926/forge-pullreq.el new file mode 100644 index 00000000..7231a5b1 --- /dev/null +++ b/elpa/forge-20230505.926/forge-pullreq.el @@ -0,0 +1,330 @@ +;;; forge-pullreq.el --- Pullreq support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Code: + +(require 'forge) +(require 'forge-post) +(require 'forge-topic) + +;;; Classes + +(defclass forge-pullreq (forge-topic) + ((closql-table :initform 'pullreq) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(desc number)]) + (closql-foreign-key :initform 'repository) + (closql-class-prefix :initform "forge-") + (id :initarg :id) + (repository :initarg :repository) + (number :initarg :number) + (state :initarg :state) + (author :initarg :author) + (title :initarg :title) + (created :initarg :created) + (updated :initarg :updated) + (closed :initarg :closed) + (merged :initarg :merged) + (unread-p :initarg :unread-p :initform nil) + (locked-p :initarg :locked-p) + (editable-p :initarg :editable-p) + (cross-repo-p :initarg :cross-repo-p) + (base-ref :initarg :base-ref) + (base-repo :initarg :base-repo) + (head-ref :initarg :head-ref) + (head-user :initarg :head-user) + (head-repo :initarg :head-repo) + (milestone :initarg :milestone) + (body :initarg :body) + (assignees :closql-table (pullreq-assignee assignee)) + (project-cards) ; projectsCards + (commits) + (edits) ; userContentEdits + (labels :closql-table (pullreq-label label)) + (participants) + (posts :closql-class forge-pullreq-post) + (reactions) + (review-requests :closql-table (pullreq-review-request assignee)) + (reviews) + (timeline) + (marks :closql-table (pullreq-mark mark)) + (note :initarg :note :initform nil) + (base-rev :initarg :base-rev) + (head-rev :initarg :head-rev) + (draft-p :initarg :draft-p) + (their-id :initarg :their-id) + )) + +(defclass forge-pullreq-post (forge-post) + ((closql-table :initform 'pullreq-post) + (closql-primary-key :initform 'id) + (closql-order-by :initform [(asc number)]) + (closql-foreign-key :initform 'pullreq) + (closql-class-prefix :initform "forge-pullreq-") + (id :initarg :id) + (pullreq :initarg :pullreq) + (number :initarg :number) + (author :initarg :author) + (created :initarg :created) + (updated :initarg :updated) + (body :initarg :body) + (edits) + (reactions) + )) + +;;; Query + +(cl-defmethod forge-get-repository ((post forge-pullreq-post)) + (forge-get-repository (forge-get-pullreq post))) + +(cl-defmethod forge-get-topic ((post forge-pullreq-post)) + (forge-get-pullreq post)) + +(cl-defmethod forge-get-pullreq ((pullreq forge-pullreq)) + pullreq) + +(cl-defmethod forge-get-pullreq ((repo forge-repository) number) + (closql-get (forge-db) + (forge--object-id 'forge-pullreq repo number) + 'forge-pullreq)) + +(cl-defmethod forge-get-pullreq ((number integer)) + (and-let* ((repo (forge-get-repository t))) + (forge-get-pullreq repo number))) + +(cl-defmethod forge-get-pullreq ((id string)) + (closql-get (forge-db) id 'forge-pullreq)) + +(cl-defmethod forge-get-pullreq ((post forge-pullreq-post)) + (closql-get (forge-db) + (oref post pullreq) + 'forge-pullreq)) + +(cl-defmethod forge-ls-pullreqs ((repo forge-repository) &optional type select) + (forge-ls-topics repo 'forge-pullreq type select)) + +;;; Utilities + +(defun forge-read-pullreq (prompt &optional type) + (when (eq type t) + (setq type (if current-prefix-arg nil 'open))) + (let* ((default (forge-current-pullreq)) + (repo (forge-get-repository (or default t))) + (choices (mapcar + (apply-partially #'forge--topic-format-choice repo) + (forge-ls-pullreqs repo type [number title id class])))) + (cdr (assoc (magit-completing-read + prompt choices nil nil nil nil + (and default + (setq default (forge--topic-format-choice default)) + (member default choices) + (car default))) + choices)))) + +(defun forge--pullreq-branch-internal (pullreq) + (let ((branch (oref pullreq head-ref))) + ;; It is invalid for a branch name to begin with a colon, yet + ;; that is what Gitlab uses when a pull-request's source branch + ;; has been deleted. On Github this is simply nil in the same + ;; situation. + (and branch (not (string-prefix-p ":" branch)) branch))) + +(defun forge--pullreq-branch-active (pullreq) + (let* ((number (number-to-string (oref pullreq number))) + (branch-n (format "pr-%s" number)) + (branch (forge--pullreq-branch-internal pullreq))) + (or (and (magit-branch-p branch) + (equal (magit-get "branch" branch "pullRequest") number) + branch) + (and (magit-branch-p branch-n) + (equal (magit-get "branch" branch-n "pullRequest") number) + branch-n)))) + +(defun forge--pullreq-ref (pullreq) + (let ((ref (format "refs/pullreqs/%s" (oref pullreq number)))) + (and (magit-rev-verify ref) ref))) + +(defun forge--pullreq-range (pullreq &optional endpoints) + (and-let* ((head (forge--pullreq-ref pullreq))) + (concat (forge--get-remote) "/" (oref pullreq base-ref) + (if endpoints "..." "..") + head))) + +(cl-defmethod forge-get-url ((pullreq forge-pullreq)) + (forge--format pullreq 'pullreq-url-format)) + +(defun forge--pullreq-by-forge-short-link-at-point () + (forge--topic-by-forge-short-link-at-point '("#" "!") #'forge-get-pullreq)) + +;;; Sections + +(defun forge-current-pullreq () + (or (forge-pullreq-at-point) + (and (derived-mode-p 'forge-topic-mode) + (forge-pullreq-p forge-buffer-topic) + forge-buffer-topic) + (and (derived-mode-p 'forge-topic-list-mode) + (let ((topic (forge-get-topic (tabulated-list-get-id)))) + (and (forge-pullreq-p topic) + topic))))) + +(defun forge-pullreq-at-point () + (or (magit-section-value-if 'pullreq) + (and-let* ((post (magit-section-value-if 'post))) + (cond ((forge-pullreq-p post) + post) + ((forge-pullreq-post-p post) + (forge-get-pullreq post)))) + (forge--pullreq-by-forge-short-link-at-point))) + +(defvar-keymap forge-pullreqs-section-map + " " #'forge-browse-pullreqs + " " #'forge-list-pullreqs + "C-c C-n" #'forge-create-pullreq) + +(defvar-keymap forge-pullreq-section-map + " " #'forge-browse-pullreq + " " #'forge-visit-pullreq) + +(defun forge-insert-pullreqs () + "Insert a list of mostly recent and/or open pull-requests. +Also see option `forge-topic-list-limit'." + (when (and forge-display-in-status-buffer (forge-db t)) + (when-let ((repo (forge-get-repository nil))) + (unless (oref repo sparse-p) + (forge-insert-topics "Pull requests" + (forge-ls-recent-topics repo 'pullreq) + (forge--topic-type-prefix repo 'pullreq)))))) + +(defun forge--insert-pullreq-commits (pullreq &optional all) + (cl-letf (((symbol-function #'magit-cancel-section) (lambda ()))) + (if all + ;; Numeric pr ref, pr branch (if it exists) and api + ;; pr range may be out of sync. Just show them all. + (magit-insert-section-body + (magit--insert-log nil + (delq nil (list (concat "^" (or (oref pullreq base-rev) + (concat (forge--get-remote) "/" + (oref pullreq base-ref)))) + (forge--pullreq-ref pullreq) + (forge--pullreq-branch-active pullreq) + (and-let* ((branch (oref pullreq head-ref))) + (and (magit-local-branch-p branch) branch)))) + (seq-uniq (cons "--graph" magit-buffer-log-args))) + (magit-make-margin-overlay nil t)) + (when-let ((range (forge--pullreq-range pullreq))) + (magit-insert-section-body + (magit--insert-log nil range magit-buffer-log-args) + (magit-make-margin-overlay nil t)))))) + +(cl-defmethod forge--insert-topic-contents :after ((pullreq forge-pullreq) + _width _prefix) + (unless (oref pullreq merged) + (magit-insert-heading) + (forge--insert-pullreq-commits pullreq))) + +(cl-defmethod forge--format-topic-id ((pullreq forge-pullreq) &optional prefix) + (propertize (format "%s%s" + (or prefix (forge--topic-type-prefix pullreq)) + (oref pullreq number)) + 'font-lock-face (if (oref pullreq merged) + 'forge-topic-merged + 'forge-topic-unmerged))) + +(cl-defmethod forge--topic-type-prefix ((pullreq forge-pullreq)) + (if (forge--childp (forge-get-repository pullreq) 'forge-gitlab-repository) + "!" + "#")) + +(defun forge-insert-assigned-pullreqs () + "Insert a list of open pull-requests that are assigned to you." + (when forge-display-in-status-buffer + (when-let ((repo (forge-get-repository nil))) + (unless (oref repo sparse-p) + (forge-insert-topics "Assigned pull requests" + (forge--ls-assigned-pullreqs repo) + (forge--topic-type-prefix repo 'pullreq)))))) + +(defun forge--ls-assigned-pullreqs (repo) + (mapcar (lambda (row) + (closql--remake-instance 'forge-pullreq (forge-db) row)) + (forge-sql + [:select $i1 :from pullreq + :join pullreq_assignee :on (= pullreq_assignee:pullreq pullreq:id) + :join assignee :on (= pullreq_assignee:id assignee:id) + :where (and (= pullreq:repository $s2) + (= assignee:login $s3) + (isnull pullreq:closed)) + :order-by [(desc updated)]] + (vconcat (closql--table-columns (forge-db) 'pullreq t)) + (oref repo id) + (ghub--username repo)))) + +(defun forge-insert-requested-reviews () + "Insert a list of pull-requests that are awaiting your review." + (when-let ((repo (forge-get-repository nil))) + (unless (oref repo sparse-p) + (forge-insert-topics "Pull requests awaiting review" + (forge--ls-requested-reviews repo) + (forge--topic-type-prefix repo 'pullreq))))) + +(defun forge--ls-requested-reviews (repo) + (mapcar + (lambda (row) + (closql--remake-instance 'forge-pullreq (forge-db) row)) + (forge-sql + [:select $i1 :from pullreq + :join pullreq_review_request :on (= pullreq_review_request:pullreq pullreq:id) + :join assignee :on (= pullreq_review_request:id assignee:id) + :where (and (= pullreq:repository $s2) + (= assignee:login $s3) + (isnull pullreq:closed)) + :order-by [(desc updated)]] + (vconcat (closql--table-columns (forge-db) 'pullreq t)) + (oref repo id) + (ghub--username repo)))) + +(defun forge-insert-authored-pullreqs () + "Insert a list of open pullreqs that are authored to you." + (when forge-display-in-status-buffer + (when-let ((repo (forge-get-repository nil))) + (unless (oref repo sparse-p) + (forge-insert-topics "Authored pullreqs" + (forge--ls-authored-pullreqs repo) + (forge--topic-type-prefix repo 'pullreq)))))) + +(defun forge--ls-authored-pullreqs (repo) + (mapcar (lambda (row) + (closql--remake-instance 'forge-pullreq (forge-db) row)) + (forge-sql + [:select $i1 :from [pullreq] + :where (and (= pullreq:repository $s2) + (= pullreq:author $s3) + (isnull pullreq:closed)) + :order-by [(desc updated)]] + (vconcat (closql--table-columns (forge-db) 'pullreq t)) + (oref repo id) + (ghub--username repo)))) + +;;; _ +(provide 'forge-pullreq) +;;; forge-pullreq.el ends here diff --git a/elpa/forge-20230505.926/forge-repo.el b/elpa/forge-20230505.926/forge-repo.el new file mode 100644 index 00000000..e3189bf8 --- /dev/null +++ b/elpa/forge-20230505.926/forge-repo.el @@ -0,0 +1,378 @@ +;;; forge-repo.el --- Repository support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Code: + +(require 'forge) +(require 'eieio) + +;;; Classes + +(defclass forge-repository (forge-object) + ((closql-class-prefix :initform "forge-") + (closql-class-suffix :initform "-repository") + (closql-table :initform 'repository) + (closql-primary-key :initform 'id) + (issues-url-format :initform nil :allocation :class) + (issue-url-format :initform nil :allocation :class) + (issue-post-url-format :initform nil :allocation :class) + (pullreqs-url-format :initform nil :allocation :class) + (pullreq-url-format :initform nil :allocation :class) + (pullreq-post-url-format :initform nil :allocation :class) + (commit-url-format :initform nil :allocation :class) + (branch-url-format :initform nil :allocation :class) + (remote-url-format :initform nil :allocation :class) + (create-issue-url-format :initform nil :allocation :class) + (create-pullreq-url-format :initform nil :allocation :class) + (pullreq-refspec :initform nil :allocation :class) + (id :initform nil :initarg :id) + (forge-id :initform nil :initarg :forge-id) + (forge :initform nil :initarg :forge) + (owner :initform nil :initarg :owner) + (name :initform nil :initarg :name) + (apihost :initform nil :initarg :apihost) + (githost :initform nil :initarg :githost) + (remote :initform nil :initarg :remote) + (sparse-p :initform t) + (created :initform nil) + (updated :initform nil) + (pushed :initform nil) + (parent :initform nil) + (description :initform nil) + (homepage :initform nil) + (default-branch :initform nil) + (archived-p :initform nil) + (fork-p :initform nil) + (locked-p :initform nil) + (mirror-p :initform nil) + (private-p :initform nil) + (issues-p :initform t) + (wiki-p :initform nil) + (stars :initform nil) + (watchers :initform nil) + (assignees :closql-table assignee) + (forks :closql-table fork) + (issues :closql-class forge-issue) + (labels :closql-table label) + (pullreqs :closql-class forge-pullreq) + (revnotes :closql-class forge-revnote) + (selective-p :initform nil) + (worktree :initform nil) + (milestones :closql-table milestone)) + :abstract t) + +(defclass forge-unusedapi-repository (forge-repository) () :abstract t) + +(defclass forge-noapi-repository (forge-repository) () :abstract t) + +;;; Core + +(cl-defmethod forge--repository-ids ((class (subclass forge-repository)) + host owner name &optional stub) + "Return (OUR-ID . THEIR-ID) of the specified repository. +If optional STUB is non-nil, then the IDs are not guaranteed to +be unique. Otherwise this method has to make an API request to +retrieve THEIR-ID, the repository's ID on the forge. In that +case OUR-ID derives from THEIR-ID and is unique across all +forges and hosts." + (pcase-let* ((`(,_githost ,apihost ,id ,_class) + (or (assoc host forge-alist) + (error "No entry for %S in forge-alist" host))) + (path (format "%s/%s" owner name)) + (their-id (and (not stub) + (ghub-repository-id + owner name + :host apihost + :auth 'forge + :forge (forge--ghub-type-symbol class))))) + (cons (base64-encode-string + (format "%s:%s" id + (cond (stub path) + ((eq class 'forge-github-repository) + ;; This is base64 encoded, according to + ;; https://docs.github.com/en/graphql/reference/scalars#id. + ;; Unfortunately that is not always true. + ;; E.g. https://github.com/dit7ya/roamex. + (condition-case nil + (base64-decode-string their-id) + (error their-id))) + (t their-id))) + t) + (or their-id path)))) + +(cl-defmethod forge--repository-ids ((_class (subclass forge-noapi-repository)) + host owner name &optional _stub) + (let ((their-id (if owner (concat owner "/" name) name))) + (cons (base64-encode-string + (format "%s:%s" + (nth 3 (or (assoc host forge-alist) + (error "No entry for %S in forge-alist" host))) + their-id) + t) + their-id))) + +(defvar-local forge-buffer-repository nil) +(put 'forge-buffer-repository 'permanent-local t) + +(defconst forge--signal-no-entry '(t stub create)) + +(defun forge--get-remote (&optional warn) + (let* ((remotes (magit-list-remotes)) + (config (magit-get "forge.remote")) + (remote (if (cdr remotes) + (or (car (member config remotes)) + (car (member "upstream" remotes)) + (car (member "origin" remotes))) + (car remotes)))) + (when (and warn config remote (not (equal config remote))) + (message "Ignored forge.remote=%s; no such remote.\nSee %s." config + "https://magit.vc/manual/forge/Repository-Detection.html")) + remote)) + +(cl-defmethod forge-get-repository (((_ id) (head :id))) + (closql-get (forge-db) id 'forge-repository)) + +(cl-defmethod forge-get-repository ((demand symbol) &optional remote) + "Return the current forge repository. + +If the `forge-buffer-repository' is non-nil, then return that. +Otherwise if `forge-buffer-topic' is non-nil, then return the +repository for that. Finally if both variables are nil, then +return the forge repository corresponding to the current Git +repository, if any." + (or forge-buffer-repository + (and forge-buffer-topic + (forge-get-repository forge-buffer-topic)) + (magit--with-refresh-cache + (list default-directory 'forge-get-repository demand) + (unless remote + (setq remote (forge--get-remote 'warn))) + (if-let ((url (and remote + (magit-git-string "remote" "get-url" remote)))) + (when-let* ((repo (forge-get-repository url remote demand))) + ;; Cannot use and-let* because of debbugs#31840. + (oset repo worktree (magit-toplevel)) + repo) + (when (memq demand forge--signal-no-entry) + (error + "Cannot determine forge repository. %s\nSee %s." + (cond (remote (format "No url configured for %S." remote)) + ((and-let* ((config (magit-get "forge.remote"))) + (format "Value of `forge.remote' is %S but %s" + config "that remote does not exist."))) + ((magit-list-remotes) "Cannot decide on remote to use.") + (t "No remote configured.")) + "https://magit.vc/manual/forge/Repository-Detection.html")))))) + +(cl-defmethod forge-get-repository ((url string) &optional remote demand) + "Return the repository at URL." + (if-let ((parts (forge--split-url url))) + (forge-get-repository parts remote demand) + (when (memq demand forge--signal-no-entry) + (error "Cannot determine forge repository. %s isn't a forge url" url)))) + +(cl-defmethod forge-get-repository (((host owner name) list) + &optional remote demand) + "((host owner name) &optional remote demand) + +Return the repository identified by HOST, OWNER and NAME." + (if-let ((spec (assoc host forge-alist))) + (pcase-let ((`(,githost ,apihost ,forge ,class) spec)) + (let* ((row (car (forge-sql [:select * :from repository + :where (and (= forge $s1) + (= owner $s2) + (= name $s3))] + forge owner name))) + (obj (and row (closql--remake-instance class (forge-db) row)))) + (when obj + (oset obj apihost apihost) + (oset obj githost githost) + (oset obj remote remote)) + (cond ((and (eq demand t) + (or (not obj) + (oref obj sparse-p))) + (error "Cannot use `%s' in %S yet.\n%s" + this-command (magit-toplevel) + "Use `M-x forge-add-repository' before trying again.")) + ((and (eq demand 'full) obj + (oref obj sparse-p)) + (setq obj nil))) + (when (and (memq demand '(stub create)) + (not obj)) + (pcase-let ((`(,id . ,forge-id) + (forge--repository-ids class host owner name + (eq demand 'stub)))) + ;; The repo might have been renamed on the forge. #188 + (unless (setq obj (forge-get-repository (list :id id))) + (setq obj (funcall class + :id id + :forge-id forge-id + :forge forge + :owner owner + :name name + :apihost apihost + :githost githost + :remote remote)) + (when (eq demand 'create) + (closql-insert (forge-db) obj))))) + obj)) + (when (memq demand forge--signal-no-entry) + (error "Cannot determine forge repository. No entry for %S in %s" + host 'forge-alist)))) + +(cl-defmethod forge-get-repository ((repo forge-repository)) + repo) + +;;; Utilities + +(defun forge-repository-at-point () + (magit-section-value-if 'forge-repo)) + +(defun forge-current-repository () + (or (forge-repository-at-point) + (and (derived-mode-p 'forge-repository-list-mode) + (forge-get-repository (list :id (tabulated-list-get-id)))))) + +(cl-defmethod forge-visit ((repo forge-repository)) + (let ((worktree (oref repo worktree))) + (if (and worktree (file-directory-p worktree)) + (magit-status-setup-buffer worktree) + (forge-list-issues (oref repo id))))) + +(defun forge-read-repository (prompt) + (let ((choice (magit-completing-read + prompt + (mapcar (pcase-lambda (`(,host ,owner ,name)) + (format "%s/%s @%s" owner name host)) + (forge-sql [:select [githost owner name] + :from repository])) + nil t nil nil + (and-let* ((default (or (forge-current-repository) + (forge-get-repository nil)))) + (format "%s/%s @%s" + (oref default owner) + (oref default name) + (oref default githost)))))) + (save-match-data + (if (string-match "\\`\\(.+\\)/\\([^/]+\\) @\\(.+\\)\\'" choice) + (list (match-string 3 choice) + (match-string 1 choice) + (match-string 2 choice)) + (error "BUG"))))) + +(defun forge-read-host (prompt &optional class) + (magit-completing-read + prompt + (if class + (-keep (pcase-lambda (`(,githost ,_apihost ,_id ,c)) + (and (child-of-class-p c class) githost)) + forge-alist) + (mapcar #'car forge-alist)) + nil t)) + +(defun forge--as-githost (host) + (or (car (car (cl-member host forge-alist :test #'equal :key #'car))) + (car (car (cl-member host forge-alist :test #'equal :key #'cadr))) + (car (car (cl-member host forge-alist :test #'equal :key #'caddr))) + (user-error "Cannot determine githost for %S" host))) + +(defun forge--as-apihost (host) + (or (cadr (car (cl-member host forge-alist :test #'equal :key #'cadr))) + (cadr (car (cl-member host forge-alist :test #'equal :key #'car))) + (cadr (car (cl-member host forge-alist :test #'equal :key #'caddr))) + (user-error "Cannot determine githost for %S" host))) + +(cl-defmethod forge--topics-until ((repo forge-repository) until table) + (if (oref repo sparse-p) + until + (caar (forge-sql [:select [updated] :from $i1 + :where (= repository $s2) + :order-by [(desc updated)] + :limit 1] + table (oref repo id))))) + +(cl-defmethod forge--format ((repo forge-repository) format-or-slot &optional spec) + (format-spec + (if (symbolp format-or-slot) + (eieio-oref repo format-or-slot) + format-or-slot) + (with-slots (githost owner name) repo + (let ((path (if owner (concat owner "/" name) name))) + `(,@spec + (?h . ,githost) + (?o . ,owner) + (?n . ,name) + (?p . ,path) + (?P . ,(string-replace "/" "%2F" path))))))) + +(cl-defmethod forge-get-url ((repo forge-repository)) + (forge--format (oref repo remote) 'remote-url-format)) + +(defun forge--set-field-callback () + (let ((buf (current-buffer))) + (lambda (&rest _) + (with-current-buffer + (or buf (current-buffer)) + (forge-pull))))) + +(defvar forge--mode-line-buffer nil) + +(defun forge--msg (repo echo done format &rest args) + (let ((msg (apply #'format format args))) + (when repo + (setq msg (string-replace + "REPO" + (concat (oref repo owner) "/" (oref repo name)) + msg))) + (when (and echo msg) + (message "%s%s" msg (if done "...done" "..."))) + (when (buffer-live-p forge--mode-line-buffer) + (with-current-buffer forge--mode-line-buffer + (setq mode-line-process + (if done + nil + (concat " " (propertize msg 'font-lock-face + 'magit-mode-line-process))))) + (force-mode-line-update t)))) + +(cl-defmethod ghub--host ((repo forge-repository)) + (cl-call-next-method (forge--ghub-type-symbol (eieio-object-class repo)))) + +(cl-defmethod ghub--username ((repo forge-repository)) + (let ((sym (forge--ghub-type-symbol (eieio-object-class repo)))) + (cl-call-next-method (ghub--host sym) sym))) + +(defun forge--ghub-type-symbol (class) + (cl-ecase class + ;; This package does not define a `forge-gitlab-http-repository' + ;; class, but we suggest at #9 that users define such a class if + ;; they must connect to a Gitlab instance that uses http instead + ;; of https. + ((forge-gitlab-repository forge-gitlab-http-repository) 'gitlab) + (forge-github-repository 'github) + (forge-gitea-repository 'gitea) + (forge-gogs-repository 'gogs) + (forge-bitbucket-repository 'bitbucket))) + +;;; _ +(provide 'forge-repo) +;;; forge-repo.el ends here diff --git a/elpa/forge-20230505.926/forge-revnote.el b/elpa/forge-20230505.926/forge-revnote.el new file mode 100644 index 00000000..b410f81c --- /dev/null +++ b/elpa/forge-20230505.926/forge-revnote.el @@ -0,0 +1,47 @@ +;;; forge-revnote.el --- Revnote support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Code: + +(require 'forge) +(require 'forge-post) +(require 'forge-topic) + +;;; Class + +(defclass forge-revnote (forge-topic) + ((closql-table :initform 'revnote) + (closql-primary-key :initform 'id) + ;; (closql-order-by :initform [(desc number)]) + (closql-foreign-key :initform 'repository) + (closql-class-prefix :initform "forge-") + (id :initarg :id) + (repository :initarg :repository) + (commit :initarg :commit) + (file :initarg :file) + (line :initarg :line) + (author :initarg :author) + (body :initarg :body))) + +;;; _ +(provide 'forge-revnote) +;;; forge-revnote.el ends here diff --git a/elpa/forge-20230505.926/forge-semi.el b/elpa/forge-20230505.926/forge-semi.el new file mode 100644 index 00000000..dc235adc --- /dev/null +++ b/elpa/forge-20230505.926/forge-semi.el @@ -0,0 +1,81 @@ +;;; forge-semi.el --- Support for semi-forges -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Code: + +(require 'forge) + +(defclass forge-gitweb-repository (forge-noapi-repository) + ((commit-url-format :initform "https://%h/gitweb/?p=%P.git;a=commitdiff;h=%r") + (branch-url-format :initform "https://%h/gitweb/?p=%P.git;a=log;h=refs/heads/%r") + (remote-url-format :initform "https://%h/gitweb/?p=%P.git;a=summary")) + "Gitweb from https://git-scm.com/docs/gitweb.") + +(defclass forge-cgit-repository (forge-noapi-repository) + ((commit-url-format :initform "https://%h/%p.git/commit/?id=%r") + (branch-url-format :initform "https://%h/%p.git/log/?h=%r") + (remote-url-format :initform "https://%h/%p.git/about")) + "Cgit from https://git.zx2c4.com/cgit/about. +Different hosts use different url schemata, so we need multiple +classes. See their definitions in \"forge-semi.el\".") + +(defclass forge-cgit*-repository (forge-cgit-repository) + ((commit-url-format :initform "https://%h/cgit/%p.git/commit/?id=%r") + (branch-url-format :initform "https://%h/cgit/%p.git/log/?h=%r") + (remote-url-format :initform "https://%h/cgit/%p.git/about")) + "Cgit from https://git.zx2c4.com/cgit/about. +Different hosts use different url schemata, so we need multiple +classes. See their definitions in \"forge-semi.el\".") + +(defclass forge-cgit**-repository (forge-cgit-repository) + ((commit-url-format :initform "https://%h/cgit/%n.git/commit/?id=%r") + (branch-url-format :initform "https://%h/cgit/%n.git/log/?h=%r") + (remote-url-format :initform "https://%h/cgit/%n.git/about")) + "Cgit from https://git.zx2c4.com/cgit/about. +Different hosts use different url schemata, so we need multiple +classes. See their definitions in \"forge-semi.el\".") + +(defclass forge-repoorcz-repository (forge-cgit-repository) + ((commit-url-format :initform "https://%h/%p.git/commit/%r") + (branch-url-format :initform "https://%h/%p.git/log/%r") + (remote-url-format :initform "https://%h/%p.git")) + "Cgit fork used on https://repo.or.cz/cgit.git. +Different hosts use different url schemata, so we need multiple +classes. See their definitions in \"forge-semi.el\".") + +(defclass forge-stagit-repository (forge-noapi-repository) + ((commit-url-format :initform "https://%h/%n/commit/%r.html") + (branch-url-format :initform "https://%h/%n/refs.html") + (remote-url-format :initform "https://%h/%n/file/README.html")) + "Stagit from https://codemadness.org/git/stagit/file/README.html. +Only the history of \"master\" can be shown, so this links to the +list of refs instead of the log of the specified branch.") + +(defclass forge-srht-repository (forge-noapi-repository) + ((commit-url-format :initform "https://%h/~%o/%n/commit/%r") + (branch-url-format :initform "https://%h/~%o/%n/log/%r") + (remote-url-format :initform "https://%h/~%o/%n")) + "See https://meta.sr.ht.") + +;;; _ +(provide 'forge-semi) +;;; forge-semi.el ends here diff --git a/elpa/forge-20230505.926/forge-topic.el b/elpa/forge-20230505.926/forge-topic.el new file mode 100644 index 00000000..26e7e407 --- /dev/null +++ b/elpa/forge-20230505.926/forge-topic.el @@ -0,0 +1,977 @@ +;;; forge-topic.el --- Topics support -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Code: + +(require 'bug-reference) +(require 'markdown-mode) +(require 'parse-time) +(require 'yaml) + +(require 'forge) +(require 'forge-post) + +(defvar bug-reference-auto-setup-functions) + +;;; Options + +(defcustom forge-topic-list-order '(updated . string>) + "Order of topics listed in the status buffer. + +The value has the form (SLOT . PREDICATE), where SLOT is a +slot of issue or pullreq objects, and PREDICATE is a function +used to order the topics by that slot. Reasonable values +include (number . >) and (updated . string>)." + :package-version '(forge . "0.1.0") + :group 'forge + :type '(cons (symbol :tag "Slot") + (function :tag "Predicate"))) + +(defcustom forge-topic-list-limit '(60 . 5) + "Limit the number of topics listed in the status buffer. + +All unread topics are always shown. If the value of this option +has the form (OPEN . CLOSED), then the integer OPEN specifies the +maximal number of topics and CLOSED specifies the maximal number +of closed topics. IF CLOSED is negative then show no closed +topics until the command `forge-toggle-closed-visibility' changes +the sign. + +The value can also be an integer, in which case it limits the +number of closed topics only." + :package-version '(forge . "0.1.0") + :group 'forge + :type '(choice (number :tag "Maximal number of closed issues") + (cons (number :tag "Maximal number of open issues") + (number :tag "Maximal number of closed issues")))) + +(defcustom forge-post-heading-format "%a %C\n" + "Format for post headings in topic view. + +The following %-sequences are supported: + +`%a' The forge nickname of the author. +`%c' The absolute creation date. +`%C' The relative creation date." + :package-version '(forge . "0.1.0") + :group 'forge + :type 'string) + +(defcustom forge-post-fill-region t + "Whether to call `fill-region' before displaying forge posts." + :package-version '(forge . "0.1.0") + :group 'forge + :type 'boolean) + +(defcustom forge-bug-reference-hooks + '(find-file-hook + forge-post-mode-hook + git-commit-setup-hook + magit-mode-hook) + "Hooks to which `forge-bug-reference-setup' is added. +This variable has to be customized before `forge' is loaded." + :package-version '(forge . "0.2.0") + :group 'forge + :options '(find-file-hook + forge-post-mode-hook + git-commit-setup-hook + magit-mode-hook) + :type '(list :convert-widget custom-hook-convert-widget)) + +(defvar-local forge-display-in-status-buffer t + "Whether to display topics in the current Magit status buffer.") +(put 'forge-display-in-status-buffer 'permanent-local t) + +(defvar forge-format-avatar-function nil + "Function used to insert avatars in certain locations. +This is experimental and intended for users who wish to +implement such a function themselves. See #447.") + +;;; Faces + +(defface forge-topic-unread + '((t :inherit bold)) + "Face used for title of unread topics." + :group 'forge-faces) + +(defface forge-topic-closed + '((t :inherit magit-dimmed)) + "Face used for title of closed topics." + :group 'forge-faces) + +(defface forge-topic-open + '((t :inherit default)) + "Face used for title of open topics." + :group 'forge-faces) + +(defface forge-topic-merged + '((t :inherit magit-dimmed)) + "Face used for number of merged pull-requests." + :group 'forge-faces) + +(defface forge-topic-unmerged + '((t :inherit magit-dimmed :slant italic)) + "Face used for number of unmerged pull-requests." + :group 'forge-faces) + +(defface forge-topic-label + `((t :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1) + :style released-button))) + "Face used for topic labels." + :group 'forge-faces) + +(defface forge-post-author + '((t :inherit bold)) + "Face used for post author in topic view." + :group 'forge-faces) + +(defface forge-post-date + '((t :inherit italic)) + "Face used for post date in topic view." + :group 'forge-faces) + +;;; Class + +(defclass forge-topic (forge-post) () :abstract t) + +(cl-defmethod forge--object-id ((class (subclass forge-topic)) repo number) + "Return the id for a CLASS object in REPO identified by id NUMBER." + (base64-encode-string + (encode-coding-string + (format "%s:%s%s" + (base64-decode-string (oref repo id)) + (substring (symbol-name class) + (length (oref-default class closql-class-prefix))) + number) + 'utf-8) + t)) + +(cl-defmethod forge--object-id ((prefix string) number-or-id) + (base64-encode-string + (encode-coding-string + (format "%s:%s" + (base64-decode-string prefix) + (if (numberp number-or-id) + number-or-id + ;; Currently every id is base64 encode. Unfortunately + ;; we cannot use the ids of Gitlab labels (see comment + ;; in the respective `forge--update-labels' method), + ;; and have to use their names, which are not encoded. + (or (ignore-errors (base64-decode-string number-or-id)) + number-or-id))) + 'utf-8) + t)) + +;;; Query + +(cl-defmethod forge-get-parent ((topic forge-topic)) + (forge-get-repository topic)) + +(cl-defmethod forge-get-repository ((topic forge-topic)) + (closql-get (forge-db) + (oref topic repository) + 'forge-repository)) + +(cl-defmethod forge-get-topic ((topic forge-topic)) + topic) + +(cl-defmethod forge-get-topic ((repo forge-repository) number-or-id) + (if (numberp number-or-id) + (if (< number-or-id 0) + (forge-get-pullreq repo (abs number-or-id)) + (or (forge-get-issue repo number-or-id) + (forge-get-pullreq repo number-or-id))) + (or (forge-get-issue number-or-id) + (forge-get-pullreq number-or-id)))) + +(cl-defmethod forge-get-topic ((number integer)) + (if (< number 0) + (forge-get-pullreq (abs number)) + (or (forge-get-issue number) + (forge-get-pullreq number)))) + +(cl-defmethod forge-get-topic ((id string)) + (or (forge-get-issue id) + (forge-get-pullreq id))) + +(cl-defmethod forge-ls-recent-topics ((repo forge-repository) table) + (magit--with-repository-local-cache (list 'forge-ls-recent-topics table) + (let* ((id (oref repo id)) + (limit forge-topic-list-limit) + (open-limit (if (consp limit) (car limit) limit)) + (closed-limit (if (consp limit) (cdr limit) limit)) + (topics (forge-sql [:select * :from $i1 + :where (and (= repository $s2) + (notnull unread-p))] + table id))) + (mapc (lambda (row) + (cl-pushnew row topics :test #'equal)) + (if (consp limit) + (forge-sql [:select * :from $i1 + :where (and (= repository $s2) + (isnull closed)) + :order-by [(desc updated)] + :limit $s3] + table id open-limit) + (forge-sql [:select * :from $i1 + :where (and (= repository $s2) + (isnull closed))] + table id))) + (when (> closed-limit 0) + (mapc (lambda (row) + (cl-pushnew row topics :test #'equal)) + (forge-sql [:select * :from $i1 + :where (and (= repository $s2) + (notnull closed)) + :order-by [(desc updated)] + :limit $s3] + table id closed-limit))) + (cl-sort (mapcar (let ((class (if (eq table 'pullreq) + 'forge-pullreq + 'forge-issue))) + (lambda (row) + (closql--remake-instance class (forge-db) row))) + topics) + (cdr forge-topic-list-order) + :key (lambda (it) (eieio-oref it (car forge-topic-list-order))))))) + +(cl-defmethod forge-ls-topics ((repo forge-repository) + class &optional type select) + (let* ((table (oref-default class closql-table)) + (id (oref repo id)) + (rows (pcase-exhaustive type + (`open (forge-sql [:select $i1 :from $i2 + :where (and (= repository $s3) + (isnull closed)) + :order-by [(desc number)]] + (or select '*) table id)) + (`closed (forge-sql [:select $i1 :from $i2 + :where (and (= repository $s3) + (notnull closed)) + :order-by [(desc number)]] + (or select '*) table id)) + (`nil (forge-sql [:select $i1 :from $i2 + :where (= repository $s3) + :order-by [(desc number)]] + (or select '*) table id))))) + (if select + rows + (mapcar (lambda (row) + (closql--remake-instance class (forge-db) row)) + rows)))) + +;;; Utilities + +(cl-defmethod forge--format ((topic forge-topic) slot &optional spec) + (forge--format (forge-get-repository topic) slot + `(,@spec (?i . ,(oref topic number))))) + +(cl-defmethod forge-visit ((topic forge-topic)) + (forge-topic-setup-buffer topic) + (forge-topic-mark-read (forge-get-repository topic) topic)) + +(cl-defmethod forge-topic-mark-read ((_ forge-repository) topic) + (oset topic unread-p nil)) + +(defun forge--sanitize-string (string) + ;; For Gitlab this may also be nil. + (if string (string-replace "\r\n" "\n" string) "")) + +(defun forge-insert-topics (heading topics prefix) + "Under a new section with HEADING, insert TOPICS." + (when topics + (let ((width (apply #'max + (--map (length (number-to-string (oref it number))) + topics))) + list-section-type topic-section-type) + (cond ((forge--childp (car topics) 'forge-issue) + (setq list-section-type 'issues) + (setq topic-section-type 'issue)) + ((forge--childp (car topics) 'forge-pullreq) + (setq list-section-type 'pullreqs) + (setq topic-section-type 'pullreq))) + (magit-insert-section ((eval list-section-type) nil t) + (magit-insert-heading + (concat (magit--propertize-face (concat heading " ") + 'magit-section-heading) + (magit--propertize-face (format "(%s)" (length topics)) + 'magit-section-child-count))) + (magit-make-margin-overlay nil t) + (magit-insert-section-body + (dolist (topic topics) + (forge-insert-topic topic topic-section-type width prefix)) + (insert ?\n) + (magit-make-margin-overlay nil t)))))) + +(defun forge-insert-topic (topic &optional topic-section-type width prefix) + "Insert TOPIC as a new section. +If TOPIC-SECTION-TYPE is provided, it is the section type to use. +If WIDTH is provided, it is a fixed width to use for the topic +identifier." + (unless topic-section-type + (setq topic-section-type + (cond ((forge--childp topic 'forge-issue) 'issue) + ((forge--childp topic 'forge-pullreq) 'pullreq)))) + (magit-insert-section ((eval topic-section-type) topic t) + (forge--insert-topic-contents topic width prefix))) + +(cl-defmethod forge--format-topic-id ((topic forge-topic) &optional prefix) + (propertize (format "%s%s" + (or prefix (forge--topic-type-prefix topic)) + (oref topic number)) + 'font-lock-face 'magit-dimmed)) + +(cl-defmethod forge--insert-topic-contents ((topic forge-topic) width prefix) + (with-slots (number title unread-p closed) topic + (insert (format (if width (format "%%-%is" (1+ width)) "%s") + (forge--format-topic-id topic prefix))) + (forge--insert-topic-marks topic) + (insert " ") + (insert (magit-log-propertize-keywords + nil (propertize title 'font-lock-face + (cond (unread-p 'forge-topic-unread) + (closed 'forge-topic-closed) + (t 'forge-topic-open))))) + (forge--insert-topic-labels topic) + (insert "\n") + (magit-log-format-author-margin + (oref topic author) + (format-time-string "%s" (parse-iso8601-time-string (oref topic created))) + t))) + +(defun forge--topic-by-forge-short-link-at-point (known-prefixes finder) + "Finds a topic by forge-dependant short link around point. +The topic number is expected to be a number prefixed by any of +the elements in KNOWN-PREFIXES. If a reference is found, FINDER +is called and a topic object is returned if available." + (and-let* ((number (number-at-point)) + (prefix (buffer-substring-no-properties + (- (match-beginning 0) 1) + (match-beginning 0)))) + (and (member prefix known-prefixes) + (funcall finder number)))) + +;;; Mode + +(defvar-keymap forge-topic-mode-map + "C-c C-n" #'forge-create-post + "C-c C-r" #'forge-create-post + " " #'forge-browse-topic + " " #'markdown-follow-link-at-point + "" #'markdown-follow-link-at-point) + +(define-derived-mode forge-topic-mode magit-mode "View Topic" + "View a forge issue or pull-request." + (setq-local markdown-translate-filename-function + #'forge--markdown-translate-filename-function)) + +(defvar forge-topic-headers-hook + '(forge-insert-topic-title + forge-insert-topic-state + forge-insert-topic-draft + forge-insert-topic-refs + forge-insert-topic-milestone + forge-insert-topic-labels + forge-insert-topic-marks + forge-insert-topic-assignees + forge-insert-topic-review-requests)) + +(defvar-keymap forge-post-section-map + " " #'forge-browse-post + " " #'forge-edit-post + "C-c C-k" #'forge-delete-comment) + +(defvar-local forge-buffer-topic nil) +(defvar-local forge-buffer-topic-ident nil) + +(defun forge-topic-setup-buffer (topic) + (let* ((repo (forge-get-repository topic)) + (ident (concat (forge--topic-type-prefix topic) + (number-to-string (oref topic number)))) + (name (format "*forge: %s/%s %s*" + (oref repo owner) + (oref repo name) + ident)) + (magit-generate-buffer-name-function (lambda (_mode _value) name)) + (current-repo (forge-get-repository nil)) + (default-directory (if (and current-repo + (eq (oref current-repo id) + (oref repo id))) + default-directory + (or (oref repo worktree) + default-directory)))) + (magit-setup-buffer #'forge-topic-mode t + (forge-buffer-topic topic) + (forge-buffer-topic-ident ident)))) + +(defun forge-topic-refresh-buffer () + (let ((topic (closql-reload forge-buffer-topic))) + (setq forge-buffer-topic topic) + (magit-set-header-line-format + (format "%s: %s" forge-buffer-topic-ident (oref topic title))) + (magit-insert-section (topicbuf) + (magit-insert-headers 'forge-topic-headers-hook) + (when (forge-pullreq-p topic) + (magit-insert-section (pullreq topic) + (magit-insert-heading "Commits") + (forge--insert-pullreq-commits topic t))) + (when-let ((note (oref topic note))) + (magit-insert-section (note) + (magit-insert-heading "Note") + (insert (forge--fontify-markdown note) "\n\n"))) + (dolist (post (cons topic (oref topic posts))) + (with-slots (author created body) post + (magit-insert-section section (post post) + (oset section heading-highlight-face + 'magit-diff-hunk-heading-highlight) + (let ((heading + (format-spec + forge-post-heading-format + `((?a . ,(propertize (concat (forge--format-avatar author) + (or author "(ghost)")) + 'font-lock-face 'forge-post-author)) + (?c . ,(propertize created 'font-lock-face 'forge-post-date)) + (?C . ,(propertize (apply #'format "%s %s ago" + (magit--age + (float-time + (date-to-time created)))) + 'font-lock-face 'forge-post-date)))))) + (font-lock-append-text-property + 0 (length heading) + 'font-lock-face 'magit-diff-hunk-heading heading) + (magit-insert-heading heading)) + (insert (forge--fontify-markdown body) "\n\n")))) + (when (and (display-images-p) + (fboundp 'markdown-display-inline-images)) + (let ((markdown-display-remote-images t)) + (markdown-display-inline-images)))))) + +(cl-defmethod magit-buffer-value (&context (major-mode forge-topic-mode)) + forge-buffer-topic-ident) + +(defvar-keymap forge-topic-title-section-map + " " #'forge-edit-topic-title) + +(cl-defun forge-insert-topic-title + (&optional (topic forge-buffer-topic)) + (magit-insert-section (topic-title) + (insert (format "%-11s" "Title: ") (oref topic title) "\n"))) + +(defvar-keymap forge-topic-state-section-map + " " #'forge-edit-topic-state) + +(cl-defun forge-insert-topic-state + (&optional (topic forge-buffer-topic)) + (magit-insert-section (topic-state) + (insert (format + "%-11s%s\n" "State: " + (let ((state (oref topic state))) + (magit--propertize-face + (symbol-name state) + (pcase (list state (forge-pullreq-p (forge-topic-at-point))) + ('(merged) 'forge-topic-merged) + ('(closed) 'forge-topic-closed) + ('(open t) 'forge-topic-unmerged) + ('(open) 'forge-topic-open)))))))) + +(defvar-keymap forge-topic-draft-section-map + " " #'forge-edit-topic-draft) + +(cl-defun forge-insert-topic-draft + (&optional (topic forge-buffer-topic)) + (when (forge-pullreq-p topic) + (magit-insert-section (topic-draft) + (insert (format "%-11s%s\n" "Draft: " (oref topic draft-p)))))) + +(defvar-keymap forge-topic-milestone-section-map + " " #'forge-edit-topic-milestone) + +(cl-defun forge-insert-topic-milestone + (&optional (topic forge-buffer-topic)) + (magit-insert-section (topic-milestone) + (insert (format "%-11s" "Milestone: ") + (or (forge--get-topic-milestone topic) + ;; If the user hasn't pulled this repository yet after + ;; updating to db v7, then only the id is available. + (oref topic milestone) + (propertize "none" 'font-lock-face 'magit-dimmed)) + "\n"))) + +(defun forge--get-topic-milestone (topic) + (and-let* ((id (oref topic milestone))) + (caar (forge-sql [:select [title] :from milestone :where (= id $s1)] id)))) + +(defvar-keymap forge-topic-labels-section-map + " " #'forge-edit-topic-labels) + +(cl-defun forge-insert-topic-labels + (&optional (topic forge-buffer-topic)) + (magit-insert-section (topic-labels) + (insert (format "%-11s" "Labels: ")) + (if-let ((labels (closql--iref topic 'labels))) + (forge--insert-topic-labels topic t labels) + (insert (propertize "none" 'font-lock-face 'magit-dimmed))) + (insert ?\n))) + +(defun forge--format-topic-labels (topic) + (and-let* ((labels (closql--iref topic 'labels))) + (mapconcat (pcase-lambda (`(,name ,color ,_desc)) + (propertize name 'font-lock-face (list :box color))) + labels " "))) + +(defun forge--insert-topic-labels (topic &optional skip-separator labels) + (pcase-dolist (`(,name ,color ,description) + (or labels (closql--iref topic 'labels))) + (if skip-separator + (setq skip-separator nil) + (insert " ")) + (let* ((background (forge--sanitize-color color)) + (foreground (forge--contrast-color background))) + (insert name) + (let ((o (make-overlay (- (point) (length name)) (point)))) + (overlay-put o 'priority 2) + (overlay-put o 'evaporate t) + (overlay-put o 'font-lock-face + `(( :background ,background + :foreground ,foreground) + forge-topic-label)) + (when description + (overlay-put o 'help-echo description)))))) + +(defvar-keymap forge-topic-marks-section-map + " " #'forge-edit-topic-marks) + +(cl-defun forge-insert-topic-marks + (&optional (topic forge-buffer-topic)) + (magit-insert-section (topic-marks) + (insert (format "%-11s" "Marks: ")) + (if-let ((marks (closql--iref topic 'marks))) + (forge--insert-topic-marks topic t marks) + (insert (propertize "none" 'font-lock-face 'magit-dimmed))) + (insert ?\n))) + +(defun forge--insert-topic-marks (topic &optional skip-separator marks) + (pcase-dolist (`(,name ,face ,description) + (or marks (closql--iref topic 'marks))) + (if skip-separator + (setq skip-separator nil) + (insert " ")) + (insert name) + (let ((o (make-overlay (- (point) (length name)) (point)))) + (overlay-put o 'priority 2) + (overlay-put o 'evaporate t) + (overlay-put o 'font-lock-face (list face 'forge-topic-label)) + (when description + (overlay-put o 'help-echo description))))) + +(defun forge--sanitize-color (color) + (cond ((x-color-values color) color) + ;; Discard alpha information. + ((string-match-p "\\`#.\\{4\\}\\'" color) (substring color 0 3)) + ((string-match-p "\\`#.\\{8\\}\\'" color) (substring color 0 6)) + (t "#000000"))) ; Use fallback instead of invalid color. + +(defun forge--contrast-color (color) + "Return black or white depending on the luminance of COLOR." + (if (> (forge--x-color-luminance color) 0.5) "black" "white")) + +;; Copy of `rainbow-x-color-luminance'. +(defun forge--x-color-luminance (color) + "Calculate the luminance of a color string (e.g. \"#ffaa00\", \"blue\"). +Return a value between 0 and 1." + (let ((values (x-color-values color))) + (forge--color-luminance (/ (nth 0 values) 256.0) + (/ (nth 1 values) 256.0) + (/ (nth 2 values) 256.0)))) + +;; Copy of `rainbow-color-luminance'. +;; Also see https://en.wikipedia.org/wiki/Relative_luminance. +(defun forge--color-luminance (red green blue) + "Calculate the luminance of color composed of RED, GREEN and BLUE. +Return a value between 0 and 1." + (/ (+ (* .2126 red) (* .7152 green) (* .0722 blue)) 256)) + +(cl-defun forge-insert-topic-refs + (&optional (topic forge-buffer-topic)) + (when (forge-pullreq-p topic) + (magit-insert-section (topic-refs) + (with-slots (cross-repo-p base-repo base-ref head-repo head-ref) topic + (let ((separator (propertize ":" 'font-lock-face 'magit-dimmed)) + (deleted (propertize "(deleted)" 'font-lock-face 'magit-dimmed))) + (insert (format "%-11s" "Refs: ") + (if cross-repo-p + (concat base-repo separator base-ref) + base-ref) + (propertize "..." 'font-lock-face 'magit-dimmed) + (if cross-repo-p + (if (and head-repo head-ref) + (concat head-repo separator head-ref) + deleted) + (or head-ref deleted)) + "\n")))))) + +(defvar-keymap forge-topic-assignees-section-map + " " #'forge-edit-topic-assignees) + +(cl-defun forge-insert-topic-assignees + (&optional (topic forge-buffer-topic)) + (magit-insert-section (topic-assignees) + (insert (format "%-11s" "Assignees: ")) + (if-let ((assignees (closql--iref topic 'assignees))) + (insert (mapconcat (pcase-lambda (`(,login ,name)) + (format "%s%s (@%s)" + (forge--format-avatar login) + name login)) + assignees ", ")) + (insert (propertize "none" 'font-lock-face 'magit-dimmed))) + (insert ?\n))) + +(defvar-keymap forge-topic-review-requests-section-map + " " #'forge-edit-topic-review-requests) + +(cl-defun forge-insert-topic-review-requests + (&optional (topic forge-buffer-topic)) + (when (forge-pullreq-p topic) + (magit-insert-section (topic-review-requests) + (insert (format "%-11s" "Review-Requests: ")) + (if-let ((review-requests (closql--iref topic 'review-requests))) + (insert (mapconcat (pcase-lambda (`(,login ,name)) + (format "%s%s (@%s)" + (forge--format-avatar login) + name login)) + review-requests ", ")) + (insert (propertize "none" 'font-lock-face 'magit-dimmed))) + (insert ?\n)))) + +(defun forge--fontify-markdown (text) + (with-temp-buffer + (delay-mode-hooks + (gfm-mode)) + (insert text) + (font-lock-ensure) + (when forge-post-fill-region + (fill-region (point-min) (point-max))) + (buffer-string))) + +(cl-defmethod forge--topic-type-prefix ((_ forge-topic)) + "Get the identifier prefix specific to the type of TOPIC." + "#") + +(cl-defmethod forge--topic-type-prefix ((_repo forge-repository) _type) + "#") + +(defun forge--markdown-translate-filename-function (file) + (if (string-match-p "\\`https?://" file) + file + (let ((host (oref (forge-get-repository t) githost))) + (concat (if (member host ghub-insecure-hosts) "http://" "https://") + host + (and (not (string-prefix-p "/" file)) "/") + file)))) + +(defun forge--format-avatar (author) + (if forge-format-avatar-function + (funcall forge-format-avatar-function author) + "")) + +;;; Completion + +(defun forge-read-topic (prompt &optional type allow-number) + (when (eq type t) + (setq type (if current-prefix-arg nil 'open))) + (let* ((default (forge-current-topic)) + (repo (forge-get-repository (or default t))) + (choices (mapcar + (apply-partially #'forge--topic-format-choice repo) + (cl-sort + (nconc + (forge-ls-pullreqs repo type [number title id class]) + (forge-ls-issues repo type [number title id class])) + #'> :key #'car))) + (choice (magit-completing-read + prompt choices nil nil nil nil + (and default + (setq default (forge--topic-format-choice default)) + (member default choices) + (car default))))) + (or (cdr (assoc choice choices)) + (and allow-number + (let ((number (string-to-number choice))) + (if (= number 0) + (user-error "Not an existing topic or number: %s") + number)))))) + +(cl-defmethod forge--topic-format-choice ((topic forge-topic)) + (cons (format "%s%s %s" + (forge--topic-type-prefix topic) + (oref topic number) + (oref topic title)) + (oref topic id))) + +(cl-defmethod forge--topic-format-choice ((repo forge-repository) args) + (pcase-let ((`(,number ,title ,id ,class) args)) + (cons (format "%s%s %s" + (forge--topic-type-prefix repo class) + number + title) + id))) + +(defun forge-topic-completion-at-point () + (let ((bol (line-beginning-position)) + repo) + (and (looking-back "[!#][0-9]*" bol) + (or (not bug-reference-prog-mode) + (nth 8 (syntax-ppss))) ; inside comment or string + (setq repo (forge-get-repository t)) + (looking-back (if (forge--childp repo 'forge-gitlab-repository) + "\\(?3:[!#]\\)\\(?2:[0-9]*\\)" + "#\\(?2:[0-9]*\\)") + bol) + (list (match-beginning 2) + (match-end 0) + (mapcar (lambda (row) + (propertize (number-to-string (car row)) + :title (format " %s" (cadr row)))) + (if (forge--childp repo 'forge-gitlab-repository) + (forge-sql [:select [number title] + :from $i1 + :where (= repository $s2) + :order-by [(desc updated)]] + (if (equal (match-string 3) "#") + 'issue + 'pullreq) + (oref repo id)) + (forge-sql [:select [number title updated] + :from pullreq + :where (= repository $s1) + :union + :select [number title updated] + :from issue + :where (= repository $s1) + :order-by [(desc updated)]] + (oref repo id)))) + :annotation-function (lambda (c) (get-text-property 0 :title c)))))) + +;;; Parse + +(defun forge--topic-parse-buffer (&optional file) + (save-match-data + (save-excursion + (goto-char (point-min)) + (let ((alist (save-excursion (forge--topic-parse-yaml)))) + (if alist + (setf (alist-get 'yaml alist) t) + (setq alist (save-excursion (forge--topic-parse-plain)))) + (setf (alist-get 'file alist) file) + (setf (alist-get 'text alist) (magit--buffer-string nil nil ?\n)) + (when (and file (not (alist-get 'prompt alist))) + (setf (alist-get 'prompt alist) + (file-name-sans-extension (file-name-nondirectory file)))) + ;; If there is a yaml front-matter, then it is supposed + ;; to have a `title' field, but this may not be the case. + (when (and (not file) + (not (alist-get 'title alist))) + (setf (alist-get 'title alist) + (read-string "Title: "))) + alist)))) + +(defun forge--topic-parse-yaml () + (let (alist beg end) + (when (looking-at "^---[\s\t]*$") + (forward-line) + (setq beg (point)) + (when (re-search-forward "^---[\s\t]*$" nil t) + (setq end (match-beginning 0)) + (setq alist (yaml-parse-string + (buffer-substring-no-properties beg end) + :object-type 'alist + :sequence-type 'list + ;; FIXME Does not work because of + ;; https://github.com/zkry/yaml.el/pull/28. + :false-object nil)) + (let-alist alist + (when (and .name .about) + (setf (alist-get 'prompt alist) + (format "[%s] %s" .name .about))) + (when (and .labels (atom .labels)) + (setf (alist-get 'labels alist) (list .labels))) + (when (and .assignees (atom .assignees)) + (setf (alist-get 'assignees alist) (list .assignees)))) + (forward-line) + (when (and (not (alist-get 'title alist)) + (looking-at "^\n?#*")) + (goto-char (match-end 0)) + (setf (alist-get 'title alist) + (string-trim + (magit--buffer-string (point) (line-end-position) t))) + (forward-line)) + (setf (alist-get 'body alist) + (string-trim (magit--buffer-string (point) nil ?\n))))) + alist)) + +(defun forge--topic-parse-plain () + (let (title body) + (when (looking-at "\\`#*") + (goto-char (match-end 0))) + (setq title (magit--buffer-string (point) (line-end-position) t)) + (forward-line) + (setq body (magit--buffer-string (point) nil ?\n)) + `((title . ,(string-trim title)) + (body . ,(string-trim body))))) + +(defun forge--topic-parse-link-buffer () + (save-match-data + (save-excursion + (goto-char (point-min)) + (mapcar (lambda (alist) + (cons (cons 'prompt (concat (alist-get 'name alist) " -- " + (alist-get 'about alist))) + alist)) + (forge--topic-parse-yaml-links))))) + +(defun forge--topic-parse-yaml-links () + (alist-get 'contact_links + (yaml-parse-string (buffer-substring-no-properties + (point-min) + (point-max)) + :object-type 'alist + :sequence-type 'list))) + +;;; Templates + +(cl-defgeneric forge--topic-templates (repo class) + "Return a list of topic template files for REPO and a topic of CLASS.") + +(cl-defgeneric forge--topic-template (repo class) + "Return a topic template alist for REPO and a topic of CLASS. +If there are multiple templates, then the user is asked to select +one of them. It there are no templates, then return a very basic +alist, containing just `text' and `position'.") + +(defun forge--topic-templates-data (repo class) + (let ((branch (oref repo default-branch))) + (mapcan (lambda (f) + (with-temp-buffer + (magit-git-insert "cat-file" "-p" (concat branch ":" f)) + (if (equal (file-name-nondirectory f) "config.yml") + (forge--topic-parse-link-buffer) + (list (forge--topic-parse-buffer f))))) + (forge--topic-templates repo class)))) + +(cl-defmethod forge--topic-template ((repo forge-repository) + (class (subclass forge-topic))) + (let ((choices (forge--topic-templates-data repo class))) + (if (cdr choices) + (let ((c (magit-completing-read + (if (eq class 'forge-pullreq) + "Select pull-request template" + "Select issue template") + (--map (alist-get 'prompt it) choices) + nil t))) + (--first (equal (alist-get 'prompt it) c) choices)) + (car choices)))) + +;;; Bug-Reference + +(when (< emacs-major-version 28) + (defun bug-reference-fontify (start end) + "Apply bug reference overlays to region." + (save-excursion + (let ((beg-line (progn (goto-char start) (line-beginning-position))) + (end-line (progn (goto-char end) (line-end-position)))) + ;; Remove old overlays. + (bug-reference-unfontify beg-line end-line) + (goto-char beg-line) + (while (and (< (point) end-line) + (re-search-forward bug-reference-bug-regexp end-line 'move)) + (when (and (or (not bug-reference-prog-mode) + ;; This tests for both comment and string syntax. + (nth 8 (syntax-ppss))) + ;; This is the part where this redefinition differs + ;; from the original defined in "bug-reference.el". + (not (and (derived-mode-p 'magit-status-mode + 'forge-notifications-mode) + (= (match-beginning 0) + (line-beginning-position)))) + ;; End of additions. + ) + (let ((overlay (make-overlay (match-beginning 0) (match-end 0) + nil t nil))) + (overlay-put overlay 'category 'bug-reference) + ;; Don't put a link if format is undefined + (when bug-reference-url-format + (overlay-put overlay 'bug-reference-url + (if (stringp bug-reference-url-format) + (format bug-reference-url-format + (match-string-no-properties 2)) + (funcall bug-reference-url-format))))))))))) + +(defun forge-bug-reference-setup () + "Setup `bug-reference' in the current buffer. +If forge data has been fetched for the current repository, then +enable `bug-reference-mode' or `bug-reference-prog-mode' and +modify `bug-reference-bug-regexp' if appropriate." + (unless (or bug-reference-url-format + (not (forge-db t))) + (magit--with-safe-default-directory nil + (when-let ((repo (forge-get-repository 'full))) + (if (>= emacs-major-version 28) + (when (derived-mode-p 'magit-status-mode + 'forge-notifications-mode) + (setq-local + bug-reference-auto-setup-functions + (let ((hook bug-reference-auto-setup-functions)) + (list (lambda () + ;; HOOK is not allowed to be a lexical var: + ;; (run-hook-with-args-until-success 'hook) + (catch 'success + (dolist (f hook) + (when (funcall f) + (setq bug-reference-bug-regexp + (concat "." bug-reference-bug-regexp)) + (throw 'success t))))))))) + (setq-local bug-reference-url-format + (if (forge--childp repo 'forge-gitlab-repository) + (lambda () + (forge--format repo + (if (equal (match-string 3) "#") + 'issue-url-format + 'pullreq-url-format) + `((?i . ,(match-string 2))))) + (forge--format repo 'issue-url-format '((?i . "%s"))))) + (setq-local bug-reference-bug-regexp + (if (forge--childp repo 'forge-gitlab-repository) + "\\(?3:[!#]\\)\\(?2:[0-9]+\\)" + "#\\(?2:[0-9]+\\)"))) + (if (derived-mode-p 'prog-mode) + (bug-reference-prog-mode 1) + (bug-reference-mode 1)) + (add-hook 'completion-at-point-functions + #'forge-topic-completion-at-point nil t))))) + +(unless noninteractive + (dolist (hook forge-bug-reference-hooks) + (add-hook hook #'forge-bug-reference-setup))) + +;;; _ +(provide 'forge-topic) +;;; forge-topic.el ends here diff --git a/elpa/forge-20230505.926/forge.el b/elpa/forge-20230505.926/forge.el new file mode 100644 index 00000000..592f055f --- /dev/null +++ b/elpa/forge-20230505.926/forge.el @@ -0,0 +1,169 @@ +;;; forge.el --- Access Git forges from Magit -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2023 Jonas Bernoulli + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli +;; Homepage: https://github.com/magit/forge +;; Keywords: git tools vc + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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 of the License, +;; 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 this file. If not, see . + +;;; Commentary: + +;; Work with Git forges, such as Github and Gitlab, from the comfort +;; of Magit and the rest of Emacs. + +;; The schema of the database has not been finalized yet. Until that +;; has happened it will occasionally have to be discarded. For now +;; the database does not contain any information that cannot simply +;; be fetched again. + +;;; Code: + +(require 'magit) + +(require 'forge-db) +(require 'forge-core) + +(provide 'forge) + +(require 'forge-repo) +(require 'forge-post) +(require 'forge-topic) +(require 'forge-issue) +(require 'forge-pullreq) +(require 'forge-revnote) +(require 'forge-notify) + +(require 'forge-github) +(require 'forge-gitlab) +(require 'forge-gitea) +(require 'forge-gogs) +(require 'forge-bitbucket) +(require 'forge-semi) + +(require 'forge-commands) +(require 'forge-list) + +;;; Add Sections + +(defvar forge-add-default-sections t + "Whether to add Forge's sections to `magit-status-sections-hook'. +If you want to disable this, then you must set this to nil before +`forge' is loaded.") + +(when forge-add-default-sections + (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-pullreqs nil t) + (magit-add-section-hook 'magit-status-sections-hook #'forge-insert-issues nil t)) + +;;; Add Bindings + +;;;###autoload +(defvar forge-add-default-bindings t + "Whether to add Forge's bindings to various Magit keymaps. + +If you want to disable this, then you must set this to nil before +`magit' is loaded. If you do it before `forge' but after `magit' +is loaded, then `magit-mode-map' ends up being modified anyway. + +If this is nil, then `forge-toggle-display-in-status-buffer' can +no longer do its job. It might be better to set the global value +of `forge-display-in-status-buffer' to nil instead. That way you +can still display topics on demand in the status buffer.") + +;;;###autoload +(with-eval-after-load 'git-commit + (when forge-add-default-bindings + (define-key git-commit-mode-map (kbd "C-c C-v") #'forge-visit-topic))) + +;;;###autoload +(with-eval-after-load 'magit-mode + (when forge-add-default-bindings + (define-key magit-mode-map "'" #'forge-dispatch) + (define-key magit-mode-map "N" #'forge-dispatch))) + +(when forge-add-default-bindings + (define-key magit-commit-section-map [remap magit-browse-thing] #'forge-browse-dwim) + (define-key magit-remote-section-map [remap magit-browse-thing] #'forge-browse-remote) + (define-key magit-branch-section-map [remap magit-browse-thing] #'forge-browse-branch) + + (define-key magit-commit-section-map (kbd "C-c C-v") #'forge-visit-topic) + (define-key magit-branch-section-map (kbd "C-c C-v") #'forge-visit-topic) + + (transient-insert-suffix 'magit-dispatch "o" + '("N" "Forge" forge-dispatch)) + + (transient-append-suffix 'magit-fetch "m" + '("n" "forge topics" forge-pull)) + (transient-append-suffix 'magit-fetch "n" + '("N" "forge notifications" forge-pull-notifications)) + + (transient-append-suffix 'magit-pull "m" + '("n" "forge topics" forge-pull)) + (transient-append-suffix 'magit-pull "n" + '("N" "forge notifications" forge-pull-notifications)) + + (transient-append-suffix 'magit-branch "w" + '("f" "pull-request" forge-checkout-pullreq)) + (transient-append-suffix 'magit-branch "W" + '("F" "from pull-request" forge-branch-pullreq)) + + (transient-suffix-put 'magit-remote 'magit-update-default-branch :key "b u") + (transient-append-suffix 'magit-remote "b u" + '("b r" "Rename default branch" forge-rename-default-branch)) + + (transient-append-suffix 'magit-worktree "c" + '("n" "pull-request worktree" forge-checkout-worktree)) + + (transient-append-suffix 'magit-status-jump "w" + '("Np" "Pull requests" forge-jump-to-pullreqs)) + (transient-append-suffix 'magit-status-jump "Np" + '("Ni" "Issues" forge-jump-to-issues)) + + (transient-append-suffix 'magit-merge "a" + '(7 "M" "Merge using API" forge-merge))) + +;;; Startup Asserts + +(defconst forge--minimal-git "2.7.0") + +(defun forge-startup-asserts () + (let ((version (magit-git-version))) + (when (and version + (version< version forge--minimal-git) + (not (equal (getenv "TRAVIS") "true"))) + (display-warning 'magit (format "\ +Forge requires Git >= %s, you are using %s. + +If this comes as a surprise to you, because you do actually have +a newer version installed, then that probably means that the +older version happens to appear earlier on the `$PATH'. If you +always start Emacs from a shell, then that can be fixed in the +shell's init file. If you start Emacs by clicking on an icon, +or using some sort of application launcher, then you probably +have to adjust the environment as seen by graphical interface. +For X11 something like ~/.xinitrc should work. + +If you use Tramp to work inside remote Git repositories, then you +have to make sure a suitable Git is used on the remote machines +too.\n" forge--minimal-git version) :error)))) + +(if after-init-time + (forge-startup-asserts) + (add-hook 'after-init-hook #'forge-startup-asserts t)) + +;;; forge.el ends here diff --git a/elpa/forge-20230505.926/forge.info b/elpa/forge-20230505.926/forge.info new file mode 100644 index 00000000..3e7e302e --- /dev/null +++ b/elpa/forge-20230505.926/forge.info @@ -0,0 +1,1504 @@ +This is forge.info, produced by makeinfo version 6.7 from forge.texi. + + Copyright (C) 2018-2023 Jonas Bernoulli + + You can redistribute this document 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 document 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. + +INFO-DIR-SECTION Emacs +START-INFO-DIR-ENTRY +* Forge: (forge). Access Git Forges from Magit. +END-INFO-DIR-ENTRY + + +File: forge.info, Node: Top, Next: Introduction, Up: (dir) + +Forge User and Developer Manual +******************************* + +Forge allows you to work with Git forges, such as Github and Gitlab, +from the comfort of Magit and the rest of Emacs. + +This manual is for Forge version 0.3.2.50-git. + + Copyright (C) 2018-2023 Jonas Bernoulli + + You can redistribute this document 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 document 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. + +* Menu: + +* Introduction:: +* Supported Forges and Hosts:: +* Getting Started:: +* Usage:: +* FAQ:: +* Keystroke Index:: +* Function and Command Index:: +* Variable Index:: + +— The Detailed Node Listing — + +Supported Forges and Hosts + +* Supported Forges:: +* Partially Supported Forges:: +* Supported Semi-Forges:: + +Getting Started + +* Loading Forge:: +* Token Creation:: +* Initial Pull:: +* Repository Detection:: +* Caveats:: + +Usage + +* Pulling:: +* Branching:: +* Working with Topics:: +* Miscellaneous:: + +Working with Topics + +* Visiting Topics:: +* Listing Topics and Notifications:: +* Creating Topics:: +* Editing Topics and Posts:: + + +FAQ + +* Is it possible to create a single pull-request without pulling everything?:: +* ‘error in process filter HTTP Error 502, "Bad gateway"’: error in process filter HTTP Error 502 "Bad gateway". + + + +File: forge.info, Node: Introduction, Next: Supported Forges and Hosts, Prev: Top, Up: Top + +1 Introduction +************** + +Forge allows you to work with Git forges, such as Github and Gitlab, +from the comfort of Magit and the rest of Emacs. + + Forge fetches issues, pull-requests and other data using the forge’s +API and stores that in a local database. Additionally it fetches the +pull-request references using Git. Forge implements various features +that use this data but the database and pull-request refs can also be +used by third-party packages. + + +File: forge.info, Node: Supported Forges and Hosts, Next: Getting Started, Prev: Introduction, Up: Top + +2 Supported Forges and Hosts +**************************** + +Currently Forge supports two forges and three more forges partially. +Additionally it supports four semi-forges. Support for more forges and +semi-forges can and will be added. + + Both forges and semi-forges provide web interfaces for Git +repositories. Forges additionally support pull-requests and issues and +make those and other information available using an API. + + When a forge is only partially supported, then that means that only +the functionality that does not require the API is implemented, or in +other words, that the forge is only supported as a semi-forge. + + A host is a particular instance of a forge. For example the hosts + and are both instances +of the Gitlab forge. Forge supports some well known hosts out of the +box and additional hosts can easily be supported by adding entries to +the option ‘forge-alist’. + + For more details about the caveats mentioned below (and some others) +also see *note Getting Started::. + +* Menu: + +* Supported Forges:: +* Partially Supported Forges:: +* Supported Semi-Forges:: + + +File: forge.info, Node: Supported Forges, Next: Partially Supported Forges, Up: Supported Forges and Hosts + +2.1 Supported Forges +==================== + +Github +------ + +Forge’s support for Github can be considered the "reference +implementation". Support for other forges can lag behind a bit. + +Github Caveats +.............. + + • Forge uses the Github GraphQL API when possible but has to fall + back to use the REST API in many cases because the former is still + rather incomplete. + + • The Github GraphQL API has a hard-coded timeout on queries. The + only solution is to reduce the number of entities we query at once, + which can be done by adjusting either the ‘forge.graphqlItemLimit’ + git variable or the field "GQL entity limit" in a status buffer. + + • Forge depends on the ‘updated_at’ field being updated when + appropriate. For Github pull-requests at least, that is not always + done. + +Github Hosts +............ + + • + +Gitlab +------ + +Gitlab Caveats +.............. + + • Forge cannot provide notifications because the Gitlab API does not + expose those. + +Gitlab Hosts +............ + + • + • + • + + +File: forge.info, Node: Partially Supported Forges, Next: Supported Semi-Forges, Prev: Supported Forges, Up: Supported Forges and Hosts + +2.2 Partially Supported Forges +============================== + +Gitea https://gitea.io +---------------------- + +This is the next forge whose API will be supported. + +Gitea Hosts +........... + + • + +Gogs https://gogs.io +-------------------- + +Once Gitea is supported it should be fairly simple to support Gogs too, +because the former is a fork of the latter and the APIs seem to still be +very similar. + +Gogs Hosts +.......... + + • + +Bitbucket https://bitbucket.org +------------------------------- + +I don’t plan to support Bitbucket’s API any time soon, and it gets less +likely that I will every do it every time I look at it. + +Bitbucket Caveats +................. + + • The API documentation is poor and initial tests indicated that the + implementation is buggy. + + • Atlassian’s offering contains two very distinct implementations + that are both called "Bitbucket". Forge only supports the + implementation whose only instance is available at + , because I only have access to that. + + • Unlike all other forges, Bitbucket does not expose pull-requests as + references in the upstream repository. For that reason Forge + actually treats it as a semi-forge, not as forge whose API is not + supported yet. This means that you cannot checkout pull-requests + locally. There is little hope that this will ever get fixed; the + respective issue was opened six years ago and there has been no + progress since: . + +Bitbucket Hosts +............... + + • + + +File: forge.info, Node: Supported Semi-Forges, Prev: Partially Supported Forges, Up: Supported Forges and Hosts + +2.3 Supported Semi-Forges +========================= + +Gitweb https://git-scm.com/docs/gitweb +-------------------------------------- + +Gitweb Caveats +.............. + + • I could find only one public installation + (), which gives users the choice + between Gitweb and Cgit. The latter seems more popular (not just + on this site). + +Cgit https://git.zx2c4.com/cgit/about +------------------------------------- + +Cgit Caveats +............ + + • Different sites use different URL schemata and some of the bigger + sites use a fork. For this reason Forge has to provide several + classes to support different variations of Cgit and you have to + look at their definitions to figure out which one is the correct + one for a particular installation. + +Cgit Hosts +.......... + + • + • + • + +Stgit https://codemadness.org/git/stagit/file/README.html +--------------------------------------------------------- + +Stgit Caveats +............. + + • Stgit cannot show logs for branches beside "master". For that + reason Forge takes users to a page listing the branches when they + request the log for a particular branch (even for "master" whose + log is just one click away from there). + +Stgit Hosts +........... + + • + +Srht https://meta.sr.ht +----------------------- + +Srht Caveats +............ + + • Srht cannot show logs for branches beside "master". For that + reason Forge takes users to a page listing the branches when they + request the log for a particular branch (even for "master" whose + log is just one click away from there). + +Srht Hosts +.......... + + • + + +File: forge.info, Node: Getting Started, Next: Usage, Prev: Supported Forges and Hosts, Up: Top + +3 Getting Started +***************** + +Initial setup turned out to more challenging for many users than I had +hoped. I am trying to counter that by providing detailed instructions +that cover not just the happy path but also many of the issues users +have ran into in the past. The recommended reading is longer than one +might wish, but skipping it does not necessarily save time. + + Forge uses the Ghub package to access the APIs of supported forges. +How this works and how to create and store a token is documented in +*note (ghub)Getting Started::. Please read that in full before coming +back here and continuing with the subsections listed below. + + lists additional resources; +including a link to a much shorter quick-start guide provided by a user. + +* Menu: + +* Loading Forge:: +* Token Creation:: +* Initial Pull:: +* Repository Detection:: +* Caveats:: + + +File: forge.info, Node: Loading Forge, Next: Token Creation, Up: Getting Started + +3.1 Loading Forge +================= + +Loading Magit doesn’t cause Forge to be loaded automatically. Adding +something like this to your init file takes care of that: + + (with-eval-after-load 'magit + (require 'forge)) + +Or if you use ‘use-package’: + + (use-package forge + :after magit) + + +File: forge.info, Node: Token Creation, Next: Initial Pull, Prev: Loading Forge, Up: Getting Started + +3.2 Token Creation +================== + +Forge uses the Ghub package to access the APIs of supported Git forges. +How this works and how to create and store a token is documented in +*note (ghub)Getting Started::. + + Ghub used to provide a setup wizard, but that had to be removed for +reasons given in the manual just mentioned. Nowadays there is no way +around reading the documentation and doing this manually I am afraid. + + Forge requires the following token scopes. + + • For Github these scopes are required. + + • ‘repo’ grants full read/write access to private and public + repositories. + • ‘user’ grants access to profile information. + • ‘read:org’ grants read-only access to organization membership. + + More information about these and other scopes can be found at + . + + • For Gitlab instances ‘api’ is the only required scope. It gives + read and write access to everything. The Gitlab API provides more + fine-grained scopes for read-only access, but when any write access + at all is required, then it is all or nothing. + + +File: forge.info, Node: Initial Pull, Next: Repository Detection, Prev: Token Creation, Up: Getting Started + +3.3 Initial Pull +================ + +To start using Forge in a certain repository visit the Magit status +buffer for that repository and type ‘f n’ (‘forge-pull’). +Alternatively, you can use ‘M-x forge-add-repository’, which makes it +possible to add a forge repository without pulling all topics and even +without having to clone the respective Git repository. + + You must set up a token *before* you can add the first repository. +See *note Token Creation::. + + The first time ‘forge-pull’ is run in a repository, an entry for that +repository is added to the database and a new value is added to the Git +variable ‘remote..fetch’, which fetches all pull-requests. +(‘+refs/pull/*/head:refs/pullreqs/*’ for Github) + + ‘forge-pull’ then fetches topics and other information using the +forge’s API and pull-request references using Git. + + The initial fetch can take a while but most of that is done +asynchronously. Storing the information in the database is done +synchronously though, so there can be a noticeable hang at the end. +Subsequent fetches are much faster. + + Fetching issues from Github is much faster than fetching from other +forges because making a handful of GraphQL requests is much faster than +making hundreds of REST requests. + + +File: forge.info, Node: Repository Detection, Next: Caveats, Prev: Initial Pull, Up: Getting Started + +3.4 Repository Detection +======================== + +Ghub does *not* associate a given local repository with a repository on +a forge. The Forge package itself takes care of this. In doing so it +ignores the Git variable ‘ghub.host’ and other ‘*.host’ variables used +by Ghub. (But ‘github.user’ and other variables used to specify the +user are honored). + + Forge associates the local repository with a forge repository by +first determining which remote is associated with the upstream +repository and then looking that up in ‘forge-alist’. + + If only one remote exists, then Forge uses that unconditionally. To +reduce the number of support requests, this is even the case if the Git +variable ‘forge.remote’ names another, non-existent, remote. + + If several remotes exist, then a remote may be selected based on its +name. Almost always we want to fetch the data associated with the +upstream repository, so that is what the logic described here tries to +achieve. The convention is to name the upstream remote "origin", and if +that convention were universally followed, then things would be trivial. +However many people name the upstream remote "upstream", which also +makes sense. + + Note, however, that even though a surprising number of people do + just that, it does not make any sense to use the name "origin" to + refer to a fork; not even to your own fork. A fork is a *copy* of + the original, "copy" is an antonym for "original", and the word + "origin" is not only closely related to but even contained in the + word "original". Naming a fork the "origin" is at best extremely + confusing. + + copy + a thing made to be similar or identical to another. + + original + the earliest form of something, from which copies may be made. + + origin + the point or place where something begins, arises, or is + derived. + + If several remotes exist, then the following remote names are tried +in order and the first remote thus named that exists in the repository +is used. + + 1. The value of the Git variable ‘forge.remote’, if set. If the + variable has a value but no remote by the specified name exists, + then a warning is shown, but otherwise this conflict is ignored. + This behavior is arguably odd, but due to historic and pragmatic + reasons it is the least painful path forward. + + 2. The remote named ‘upstream’, if it exists. + + 3. The remote named ‘origin’, if it exists. + + The remote named "upstream" is preferred over the remote named +"origin" because the existence of the former strongly suggests that the +latter is either not used in this repository (in which case the order +does not matter) or else it is abused as the name of a fork (in which +case "upstream" must be preferred). + + -- Variable: forge.remote + The value of this variable specifies the remote from which Forge + fetches data. It is usually best to leave this unspecified and to + rely on the behavior described above. + + If the remote has to be specified explicitly, then this should be + done locally, for a single repository. + + Only ever set this globally, if you consistently use a certain name + to refer to the upstream repository and it isn’t one of "upstream" + or "origin", and you *never* use that name to refer to a repository + that does *not* refer to the upstream repository. + +‘N r’ (‘forge-forge.remote’) + This command changes the value of the ‘forge.remote’ Git variable + in the current repository. + + If this variable is set, then Forge uses the remote by that name, if +it exists, the same way it may have used ‘origin’ if the the variable +were undefined. I.e. it does not fall through to try ‘origin’ if no +remote by your chosen name exists. + + Once the upstream remote has been determined, Forge looks it up in +‘forge-alist’, using the host part of the URL as the key. For example +the key for ‘git@github.com:magit/forge.git’ is ‘github.com’. + + +File: forge.info, Node: Caveats, Prev: Repository Detection, Up: Getting Started + +3.5 Caveats +=========== + + • Fetched information is stored in a database. The table schemata of + that database have not been finalized yet. Until that has happened + it will occasionally have to be discarded. That isn’t such a huge + deal because for now the database does not contain any information + that cannot simply be fetched again, see *note Initial Pull::. + + • Fetching is implemented under the assumption that the API can be + asked to list the things that have changed since we last checked. + Unfortunately the APIs are not bug-free, so this is not always the + case. If in doubt, then re-fetch an individual topic to ensure it + is up-to-date using the command ‘forge-pull-topic’. + + • Some other, forge-specific, caveats are mentioned in *note + Supported Forges and Hosts::. + + +File: forge.info, Node: Usage, Next: FAQ, Prev: Getting Started, Up: Top + +4 Usage +******* + +Once information has been pulled from a repository’s forge for the first +time, Forge adds two additional sections, named "Pull requests" and +"Issues" to Magit’s status buffer. It is also possible to add a +repository to the local database without pulling all the data, which is +useful if you want to create a single pull-request. + +‘N a’ (‘forge-add-repository’) + This command adds a repository to the database. + + It offers to either pull topics (now and in the future) or to only + pull individual topics when the user invokes ‘forge-pull-topic’. + + Some of Forge’s commands are only bound when point is within one of +these sections but other commands are also available elsewhere in +Magit’s status buffer and/or from Magit’s transient commands. + +‘N’ (‘forge-dispatch’) + This prefix command is available in any Magit buffer and provides + access to several of the available Forge commands. Most of these + commands are also bound elsewhere, but some are not. See the + following sections for information about the available commands. + + Throughout this manual you will find many bindings that begin with + ‘N’, but if you prefer to continue to use ‘forge-dispatch’’s older + binding you can substitute ‘'’ for that. + +* Menu: + +* Pulling:: +* Branching:: +* Working with Topics:: +* Miscellaneous:: + + +File: forge.info, Node: Pulling, Next: Branching, Up: Usage + +4.1 Pulling +=========== + +The commands that fetch forge data are available from the same transient +prefix command (‘magit-fetch’ on ‘f’) that is used to fetch Git data. +If option ‘magit-pull-or-fetch’ is non-nil, then they are also available +from the ‘magit-pull’ transient (on ‘F’). + +‘f n’ (‘forge-pull’) +‘N f f’ + This command uses a forge’s API to fetch topics and other + information about the current repository and stores the fetched + information in the database. It also fetches notifications for all + repositories from the same forge host. (Currently this is limited + to Github.) Finally it fetches pull-request references using Git. + + After using this command for the first time in a given repository + the status buffer for that repository always lists the + pull-requests and issues. See *note Initial Pull::. + +‘f N’ (‘forge-pull-notifications’) +‘N f n’ + This command uses a forge’s API to fetch all notifications from + that forge including, but not limited to, the notifications for the + current repository. + + Fetching all notifications fetches associated topics even if you + have not started fetching *all* topics for the respective + repositories (using ‘forge-pull’), but it does not cause the topics + to be listed in the status buffer of such "uninitialized" + repositories. + + Note how pulling data from a forge’s API works the same way as +pulling Git data does; you do it explicitly when you want to see the +work done by others. + + This is less disruptive, more reliable, and easier to understand than +if Forge did the pulling by itself at random intervals. It might +however mean that you occasionally invoke a command expecting the most +recent data to be available and then have to abort to pull first. The +same can happen with Git, e.g. you might attempt to merge a branch that +you know exists but haven’t actually pulled yet. + +‘N f t’ (‘forge-pull-topic’) + This command uses a forge’s API to fetch a single pull-request and + stores it in the database. + + Normally you wouldn’t want to pull a single pull-request by itself, + but due to a bug in the Github API you might sometimes have to do + so. + + Fetching is implemented under the assumption that the API can be + asked to list the things that have changed since we last checked. + Unfortunately the APIs are not bug-free, so this is not always the + case. If in doubt, then re-fetch an individual topic to ensure it + is up-to-date using the command ‘forge-pull-topic’. + + +File: forge.info, Node: Branching, Next: Working with Topics, Prev: Pulling, Up: Usage + +4.2 Branching +============= + +Forge provides commands for creating and checking out a new branch or +work tree from a pull-request. These commands are available from the +same transient prefix commands as the suffix commands used to create and +check out branches and work trees in a more generic fashion +(‘magit-branch’ on ‘b’ and ‘magit-worktree’ on ‘%’). + +‘b N’ (‘forge-branch-pullreq’) + This command creates and configures a new branch from a + pull-request, creating and configuring a new remote if necessary. + + The name of the local branch is the same as the name of the remote + branch that you are being asked to merge, unless the contributor + could not be bothered to properly name the branch before opening + the pull-request. The most likely such case is when you are being + asked to merge something like "fork/master" into "origin/master". + In such cases the local branch will be named "pr-N", where ‘N’ is + the pull-request number. + + These variables are always set by this command: + + • ‘branch..pullRequest’ is set to the pull-request number. + • ‘branch..pullRequestRemote’ is set to the remote on + which the pull-request branch is located. + • ‘branch..pushRemote’ is set to the same remote as + ‘branch..pullRequestRemote’ if that is possible, + otherwise it is set to the upstream remote. + • ‘branch..description’ is set to the pull-request title. + • ‘branch..rebase’ is set to ‘true’ because there should + be no merge commits among the commits in a pull-request. + + This command also configures the upstream and the push-remote of + the local branch that it creates. + + The branch against which the pull-request was opened is always used + as the upstream. This makes it easy to see what commits you are + being asked to merge in the section titled something like "Unmerged + into origin/master". + + Like for other commands that create a branch, it depends on the + option ‘magit-branch-prefer-remote-upstream’ whether the remote + branch itself or the respective local branch is used as the + upstream, so this section may also be titled e.g. "Unmerged into + master". + + When necessary and possible, the remote pull-request branch is + configured to be used as the push-target. This makes it easy to + see what further changes the contributor has made since you last + reviewed their changes in the section titled something like + "Unpulled from origin/new-feature" or "Unpulled from + fork/new-feature". + + • If the pull-request branch is located in the upstream + repository, then you probably have set ‘remote.pushDefault’ to + that repository. However some users like to set that variable + to their personal fork, even if they have push access to the + upstream, so ‘branch..pushRemote’ is set anyway. + + • If the pull-request branch is located inside a fork, then you + are usually able to push to that branch, because Github by + default allows the recipient of a pull-request to push to the + remote pull-request branch even if it is located in a fork. + The contributor has to explicitly disable this. + + • If you are not allowed to push to the pull-request branch + on the fork, then a branch by the same name located in + the upstream repository is configured as the push-target. + + • A—sadly rather common—special case is when the + contributor didn’t bother to use a dedicated branch for + the pull-request. + + The most likely such case is when you are being asked to + merge something like "fork/master" into "origin/master". + The special push permission mentioned above is never + granted for the branch that is the repository’s default + branch, and that would almost certainly be the case in + this scenario. + + To enable you to easily push somewhere anyway, the local + branch is named "pr-N" (where ‘N’ is the pull-request + number) and the upstream repository is used as the + push-remote. + + • Finally, if you are allowed to push to the pull-request + branch and the contributor had the foresight to use a + dedicated branch, then the fork is configured as the + push-remote. + + The push-remote is configured using + ‘branch..pushRemote’, even if the used value is + identical to that of ‘remote.pushDefault’, just in case you + change the value of the latter later on. Additionally the + variable ‘branch..pullRequestRemote’ is set to the + remote on which the pull-request branch is located. + +‘b n’ (‘forge-checkout-pullreq’) + This command creates and configures a new branch from a + pull-request the same way ‘forge-branch-pullreq’ does. + Additionally it checks out the new branch. + +‘Z n’ (‘forge-checkout-worktree’) + This command creates and configures a new branch from a + pull-request the same way ‘forge-branch-pullreq’ does. + Additionally it checks out the new branch using a new working tree. + +User Options: forge-checkout-worktree-read-directory-function + This function is used by ‘forge-checkout-worktree’ to read read the + new worktree directory where it checks out to pull-request. It + takes the pull-request as the only argument and must return a + directory. + + When you delete a pull-request branch, which was created using one of +the above three commands, then ‘magit-branch-delete’ usually offers to +also delete the corresponding remote. It does not offer to delete a +remote if (1) the remote is the upstream remote, and/or (2) if other +branches are being fetched from the remote. + + Note that you have to delete the local branch (e.g. "feature") for +this to work. If you delete the tracking branch (e.g "fork/feature"), +then the remote is never removed. + + +File: forge.info, Node: Working with Topics, Next: Miscellaneous, Prev: Branching, Up: Usage + +4.3 Working with Topics +======================= + +We call both issues and pull-requests "topics". The contributions to +the conversation are called "posts". + +* Menu: + +* Visiting Topics:: +* Listing Topics and Notifications:: +* Creating Topics:: +* Editing Topics and Posts:: + + +File: forge.info, Node: Visiting Topics, Next: Listing Topics and Notifications, Up: Working with Topics + +4.3.1 Visiting Topics +--------------------- + +Magit’s status buffer contains lists of issues and pull-requests. +Topics are ordered by last modification time. All open issues and some +recently edited and closed topics are listed. + + Forge provides some commands that act on the listed topics. These +commands can also be used in other contexts, such as when point is on a +commit or branch section. + +‘C-c C-w’ (‘forge-browse-TYPE’) +‘C-c C-w’ (‘forge-browse-dwim’) +‘N b r’ (‘forge-browse-remote’) +‘N b I’ (‘forge-browse-issues’) +‘N b P’ (‘forge-browse-pullreqs’) +‘N b t’ (‘forge-browse-topic’) +‘N b i’ (‘forge-browse-issue’) +‘N b p’ (‘forge-browse-pullreq’) + These commands visit the topic, issue(s), pull-request(s), post, + branch, commit, or remote at point in a browser. + + This is implemented using various commands named + ‘forge-browse-TYPE’, and the key binding is defined by remapping + ‘magit-browse-thing’ (as defined in ‘magit-mode-map)’. For commit + sections this key is bound to ‘forge-browse-dwim’, which prefers a + topic over a branch and a branch over a commit. + +‘’ (‘forge-visit-TYPE’) +‘C-c C-v’ (‘forge-visit-topic’) +‘N v t’ (‘forge-visit-topic’) +‘N v i’ (‘forge-visit-issue’) +‘N v p’ (‘forge-visit-pullreq’) + These commands visit the pull-request(s), issue(s), or repository + in a separate buffer. + + The ‘RET’ binding is only available when point is on a issue or + pull-request section because that key is already bound to something + else for most of Magit’s own sections. ‘C-c C-v’ however is also + available on regular commit (e.g. in a log) and branch sections. + + This is implemented using various commands named ‘forge-visit-TYPE’ + and the key binding is defined by remapping ‘magit-visit-thing’ (as + defined in ‘magit-mode-map’). + + +File: forge.info, Node: Listing Topics and Notifications, Next: Creating Topics, Prev: Visiting Topics, Up: Working with Topics + +4.3.2 Listing Topics and Notifications +-------------------------------------- + +By default Forge lists a subset of topics directly in the Magit status +buffer. It also provides commands to list topics and notifications in +separate buffers. + + Forge adds the following two functions to +‘magit-status-sections-hook’: + + -- Function: forge-insert-pullreqs + This function inserts a list of the most recent and/or open + pull-requests. + + -- Function: forge-insert-issues + This function inserts a list of the most recent and/or open issues. + + -- User Option: forge-topic-list-limit + This option limits the number of topics listed by the above + functions. + + All unread topics are always shown. If the value of this option + has the form ‘(OPEN . CLOSED)’, then the integer ‘OPEN’ specifies + the maximal number of topics and ‘CLOSED’ specifies the maximal + number of closed topics. IF ‘CLOSED’ is negative then show no + closed topics until the command ‘forge-toggle-closed-visibility’ + changes the sign. + + -- Command: forge-toggle-closed-visibility + This command toggles whether the above two functions list recently + closed issues in the current buffer. + + The following three functions are also suitable for +‘magit-status-sections-hook’: + + -- Function: forge-insert-assigned-pullreqs + This function inserts a list of open pull-requests that are + assigned to you. + + -- Function: forge-insert-requested-reviews + This function inserts a list of open pull-requests that are + awaiting your review. + + -- Function: forge-insert-authored-pullreqs + This function inserts a list of open pull-requests that are + authored by you. + + -- Function: forge-insert-assigned-issues + This function inserts a list of open issues that are assigned to + you. + + -- Function: forge-insert-authored-issues + This function inserts a list of open issues that are authored by + you. + + The following commands list repositories, notifications and topics in +dedicated buffers: + +‘N l r’ (‘forge-list-repositories’) + This command lists all known repositories in a separate buffer. + +‘N l n’ (‘forge-list-notifications’) + This command lists all notifications for all forges in a separate + buffer. + +‘N l p’ (‘forge-list-pullreqs’) + This command lists the current repository’s pull-requests in a + separate buffer. + +‘N l i’ (‘forge-list-issues’) + This command lists the current repository’s issues in a separate + buffer. + + -- Command: forge-list-labeled-pullreqs + This command lists the current repository’s open pull-requests that + are labeled with a label read from the user. + + -- Command: forge-list-labeled-issues + This command lists the current repository’s open issues that are + labeled with a label read from the user. + + -- Command: forge-list-assigned-pullreqs + This command lists the current repository’s open pull-requests that + are assigned to you in a separate buffer. + + -- Command: forge-list-assigned-issues + This command lists the current repository’s open issues that are + assigned to you in a separate buffer. + + -- Command: forge-list-requested-reviews + This command lists pull-requests of the current repository that are + awaiting your review in a separate buffer. + + -- Command: forge-list-authored-pullreqs + This command lists the current repository’s open pull-requests that + are authored by you in a separate buffer. + + -- Command: forge-list-authored-issues + This command lists the current repository’s open issues that are + authored by you in a separate buffer. + + -- Command: forge-list-owned-pullreqs + This command lists open pull-requests from all the repositories + that you own. Options ‘forge-owned-accounts’ and + ‘forge-owned-ignored’ controls which repositories are considered to + be owned by you. Only Github is supported for now. + + -- Command: forge-list-owned-issues + This command lists open issues from all the repositories that you + own. Options ‘forge-owned-accounts’ and ‘forge-owned-ignored’ + controls which repositories are considered to be owned by you. + Only Github is supported for now. + + -- User Option: forge-owned-accounts + This is an alist of accounts that are owned by you. This should + include your username as well as any organization that you own. + Used by the commands ‘forge-list-owned-issues’, + ‘forge-list-owned-pullreqs’ and ‘forge-fork’. + + Each element has the form ‘(ACCOUNT . PLIST)’. The following + properties are currently being used: + + • ‘remote-name’ The default name suggested by ‘forge-fork’ for a + fork created within this account. If unspecified, then the + name of the account is used. + + Example: ‘(("tarsius") ("emacsmirror" remote-name "mirror"))’. + + -- User Option: forge-owned-ignored + This is a list of repository names that are considered to not be + owned by you even though they would have been considered to be + owned by you based on ‘forge-owned-accounts’. + + +File: forge.info, Node: Creating Topics, Next: Editing Topics and Posts, Prev: Listing Topics and Notifications, Up: Working with Topics + +4.3.3 Creating Topics +--------------------- + +‘N c p’ (‘forge-create-pullreq’) +‘C-c C-n [on "Pull requests" section]’ + This command creates a new pull-request for the current repository. + +‘N c i’ (‘forge-create-issue’) +‘C-c C-n [on "Issues" section]’ + This command creates a new issue for the current repository. + + +File: forge.info, Node: Editing Topics and Posts, Prev: Creating Topics, Up: Working with Topics + +4.3.4 Editing Topics and Posts +------------------------------ + +We call both issues and pull-requests "topics". The contributions to +the conversation are called "posts". The post that initiated the +conversation is also called a post. + + These commands are available only from the topic buffer (i.e. from +the buffer that shows the posts on a topic). Other commands that also +work in other buffers are available here also. For example ‘C-c C-w’ on +a post visits that post in a browser. + +‘C-c C-n’ (‘forge-create-post’) +‘C-c C-r’ + This command allows users to create a new post on an existing + topic. It opens a buffer in which the user can write the post. + When the post is done, then the user has to submit using ‘C-c C-c’. + + If the region is active and marks part of an existing post, then + that part of the post is quoted. Otherwise, or if a prefix + argument is used, then the complete post that point is currently on + is quoted. + +‘C-c C-e [on a post section]’ (‘forge-edit-post’) + This command visits an existing post in a separate buffer. When + the changes to the post are done, then the user has to submit using + ‘C-c C-c’. + +‘C-c C-e [on "Title" section]’ (‘forge-edit-topic-title’) + This command reads a new title for an existing topic in the + minibuffer. + +‘C-c C-e [on "State" section]’ (‘forge-edit-topic-state’) + This command toggles the state of an existing topic between "open" + and "closed". + +‘C-c C-e [on "Draft" section]’ (‘forge-edit-topic-draft’) + This command toggles whether an existing topic is a draft or not. + +‘C-c C-e [on "Labels" section]’ (‘forge-edit-topic-labels’) + This command reads a list of labels for an existing topic in the + minibuffer. + +‘C-c C-e [on "Marks" section]’ (‘forge-edit-topic-marks’) + This command reads a list of marks for an existing topic in the + minibuffer. + + Marks are like labels except that they are not shared with anyone + else. To create a mark that topics can subsequently be marked with + use the command ‘forge-create-mark’. Existing marks can be edited + using the command ‘forge-edit-mark’. + +‘C-c C-e [on "Assignees" section]’ (‘forge-edit-topic-assignees’) + This command reads a list of assignees for an existing topic in the + minibuffer. + +‘C-c C-e [on "Review-Requests" section]’ (‘forge-edit-topic-review-requests’) + This command reads a list of people who you would like to review an + existing topic in the minibuffer. + +‘C-c C-e [on "Note" section]’ +‘M-x forge-edit-topic-note’ + This lets you edit your private note about a topic. + +‘C-c C-k [on a comment section]’ (‘forge-delete-comment’) + This command deletes the comment at point. + +‘m M [if enabled]’ (‘forge-merge’) +‘N M [if enabled]’ + This command merges the current pull-request using the forge’s API. + If there is no current pull-request or with a prefix argument, then + it reads a pull-request to visit instead. + + The "merge method" to be used is read from the user. + + Use of this command is discouraged. Unless the remote repository + is configured to disallow that, you should instead merge locally + and then push the target branch. Forges detect that you have done + that and respond by automatically marking the pull-request as + merged. + + Creating a new post and editing an existing post are similar to +creating a new commit and editing the message of an existing commit. In +both cases the message has to be written in a separate buffer and then +the process has to be finished or canceled using a separate command. + + The following commands are available in buffers used to edit posts: + +‘C-c C-c’ (‘forge-post-submit’) + This command submits the post that is being edited in the current + buffer. + +‘C-c C-k’ (‘forge-post-cancel’) + This command cancels the post that is being edited in the current + buffer. + +‘C-c C-e’ (‘forge-post-dispatch’) + This prefix command features the above two commands as suffixes, + and when creating a pull-request also the following command. More + suffix commands will likely be added in the future. + +‘C-c C-e d’ (‘forge-post-toggle-draft’) + This command toggles whether the pull-request being created is a + draft. + + +File: forge.info, Node: Miscellaneous, Prev: Working with Topics, Up: Usage + +4.4 Miscellaneous +================= + +‘N c f’ (‘forge-fork’) + This command adds an additional remote to the current repository. + The remote can either point at an existing repository or one that + has to be created first by forking it to an account the user has + access to. + + Currently this only supports Github and Gitlab. + +‘N a’ (‘forge-add-repository’) + This command reads a repository from the user and adds it to the + database. The repository can be provided as a URL, a name, or in + the form OWNER/NAME. This is subject to ‘magit-clone-name-alist’. + + This command offers to either pull topics (now and in the future) + or to only pull individual topics when the user invokes + ‘forge-pull-topic’. + +‘N t t’ (‘forge-toggle-display-in-status-buffer’) + This command toggles whether any topics are displayed in the + current Magit status buffer. + +‘N t c’ (‘forge-toggle-closed-visibility’) + This command toggles whether closed topics are shown in the Magit + status buffer. + + -- Command: forge-add-user-repositories + This command reads a host and a username from the user and adds all + of that user’s repositories on that host to the local database. + + This may take a while. Only Github is supported at the moment. + + -- Command: forge-add-organization-repositories + This command reads a host and an organization from the user and + adds all the organization’s repositories on that host to the local + database. + + This may take a while. Only Github is supported at the moment. + + -- Command: forge-remove-repository + This command reads a repository and removes it from the local + database. + + -- Command: forge-remove-topic-locally + This command reads a topic and removes it from the local database. + The topic is not removed from the forge and, if it is later + modified, then it will be added to the database again. + + Due to how the supported APIs work, it would be too expensive to + automatically remove topics from the local database that were + removed from the forge. The only purpose of this command is to + allow you to manually clean up the local database. + + -- Command: forge-reset-database + This command moves the current database file to the trash and + creates a new empty database. + + This is useful after the database’s table schemata have changed, + which will happen a few times while the Forge functionality is + still under heavy development. + + +File: forge.info, Node: FAQ, Next: Keystroke Index, Prev: Usage, Up: Top + +Appendix A FAQ +************** + +This section lists some frequently asked questions. Please also see + for an extended list of common +issues. + +* Menu: + +* Is it possible to create a single pull-request without pulling everything?:: +* ‘error in process filter HTTP Error 502, "Bad gateway"’: error in process filter HTTP Error 502 "Bad gateway". + + +File: forge.info, Node: Is it possible to create a single pull-request without pulling everything?, Next: error in process filter HTTP Error 502 "Bad gateway", Up: FAQ + +A.1 Is it possible to create a single pull-request without pulling everything? +============================================================================== + +Yes. ‘M-x forge-add-repository’ offers to add a repository to the +database without also fetching all pull-requests and issues. + + +File: forge.info, Node: error in process filter HTTP Error 502 "Bad gateway", Prev: Is it possible to create a single pull-request without pulling everything?, Up: FAQ + +A.2 ‘error in process filter: HTTP Error: 502, "Bad gateway"’ +============================================================= + +This is a frequently occurring error. Adding some formatting the full +error is: + + error in process filter: ghub--signal-error: HTTP Error: 502, + "Bad gateway", "/graphql", + ((data . "null") + (errors ((message . "Something went wrong while executing your query. + This may be the result of a timeout, or it could be a GitHub bug. + Please include `CC2C:4FEA:A1771C1:CBF40CE:5C33F7E5` + when reporting this issue.")))) + + This indicates that something went wrong within Github’s network. +See +. +The appended error message also says as much: "This may be the result of +a timeout, or it could be a GitHub bug." + + It appears that this happens more often in big repositories, +especially during the initial pull, but this may be an illusion; it is +known to also happens for smaller, incremental requests. + + I believe that more data just means more requests and thus more +opportunities for things to go wrong. It seems unlikely that this is +due to us requesting too much data at once (in that case we would get a +different error from GraphQL, not HTTP). When fetching lots of data, +then we do not request one large response but make many requests and we +then collect the many responses (pagination forces us to do that). + + The timeout may be due to many requests from other people arriving at +some Github-internal bottleneck at the same time, or it may be due to +cold caches and overly aggressive timeouts. We just don’t know; it’s +their infrastructure. + + The second problem is that we currently simply error out if we get +this error. This could be changed and eventually it will be, but for +the time being your only option is to just try again, possibly +repeatedly and possibly after a delay to give whatever congestion may +exist on the other end a chance to clear or to give their caches a +chance to warm up. + + This was also discussed in +and . + + +File: forge.info, Node: Keystroke Index, Next: Function and Command Index, Prev: FAQ, Up: Top + +Appendix B Keystroke Index +************************** + +[index] +* Menu: + +* b N: Branching. (line 13) +* b n: Branching. (line 102) +* C-c C-c: Editing Topics and Posts. + (line 92) +* C-c C-e: Editing Topics and Posts. + (line 100) +* C-c C-e d: Editing Topics and Posts. + (line 105) +* C-c C-e [on "Assignees" section]: Editing Topics and Posts. + (line 56) +* C-c C-e [on "Draft" section]: Editing Topics and Posts. + (line 40) +* C-c C-e [on "Labels" section]: Editing Topics and Posts. + (line 43) +* C-c C-e [on "Marks" section]: Editing Topics and Posts. + (line 47) +* C-c C-e [on "Note" section]: Editing Topics and Posts. + (line 65) +* C-c C-e [on "Review-Requests" section]: Editing Topics and Posts. + (line 60) +* C-c C-e [on "State" section]: Editing Topics and Posts. + (line 36) +* C-c C-e [on "Title" section]: Editing Topics and Posts. + (line 32) +* C-c C-e [on a post section]: Editing Topics and Posts. + (line 27) +* C-c C-k: Editing Topics and Posts. + (line 96) +* C-c C-k [on a comment section]: Editing Topics and Posts. + (line 68) +* C-c C-n: Editing Topics and Posts. + (line 17) +* C-c C-n [on "Issues" section]: Creating Topics. (line 12) +* C-c C-n [on "Pull requests" section]: Creating Topics. (line 8) +* C-c C-r: Editing Topics and Posts. + (line 17) +* C-c C-v: Visiting Topics. (line 36) +* C-c C-w: Visiting Topics. (line 22) +* C-c C-w <1>: Visiting Topics. (line 22) +* f n: Pulling. (line 13) +* f N: Pulling. (line 25) +* m M [if enabled]: Editing Topics and Posts. + (line 72) +* N: Usage. (line 23) +* N a: Usage. (line 13) +* N a <1>: Miscellaneous. (line 15) +* N b I: Visiting Topics. (line 22) +* N b i: Visiting Topics. (line 22) +* N b P: Visiting Topics. (line 22) +* N b p: Visiting Topics. (line 22) +* N b r: Visiting Topics. (line 22) +* N b t: Visiting Topics. (line 22) +* N c f: Miscellaneous. (line 7) +* N c i: Creating Topics. (line 12) +* N c p: Creating Topics. (line 8) +* N f f: Pulling. (line 13) +* N f n: Pulling. (line 25) +* N f t: Pulling. (line 47) +* N l i: Listing Topics and Notifications. + (line 73) +* N l n: Listing Topics and Notifications. + (line 65) +* N l p: Listing Topics and Notifications. + (line 69) +* N l r: Listing Topics and Notifications. + (line 62) +* N M [if enabled]: Editing Topics and Posts. + (line 72) +* N r: Repository Detection. + (line 80) +* N t c: Miscellaneous. (line 28) +* N t t: Miscellaneous. (line 24) +* N v i: Visiting Topics. (line 36) +* N v p: Visiting Topics. (line 36) +* N v t: Visiting Topics. (line 36) +* RET: Visiting Topics. (line 36) +* Z n: Branching. (line 107) + + +File: forge.info, Node: Function and Command Index, Next: Variable Index, Prev: Keystroke Index, Up: Top + +Appendix C Function and Command Index +************************************* + +[index] +* Menu: + +* forge-add-organization-repositories: Miscellaneous. (line 37) +* forge-add-repository: Usage. (line 13) +* forge-add-repository <1>: Miscellaneous. (line 15) +* forge-add-user-repositories: Miscellaneous. (line 31) +* forge-branch-pullreq: Branching. (line 13) +* forge-browse-dwim: Visiting Topics. (line 22) +* forge-browse-issue: Visiting Topics. (line 22) +* forge-browse-issues: Visiting Topics. (line 22) +* forge-browse-pullreq: Visiting Topics. (line 22) +* forge-browse-pullreqs: Visiting Topics. (line 22) +* forge-browse-remote: Visiting Topics. (line 22) +* forge-browse-topic: Visiting Topics. (line 22) +* forge-browse-TYPE: Visiting Topics. (line 22) +* forge-checkout-pullreq: Branching. (line 102) +* forge-checkout-worktree: Branching. (line 107) +* forge-create-issue: Creating Topics. (line 12) +* forge-create-post: Editing Topics and Posts. + (line 17) +* forge-create-pullreq: Creating Topics. (line 8) +* forge-delete-comment: Editing Topics and Posts. + (line 68) +* forge-dispatch: Usage. (line 23) +* forge-edit-post: Editing Topics and Posts. + (line 27) +* forge-edit-topic-assignees: Editing Topics and Posts. + (line 56) +* forge-edit-topic-draft: Editing Topics and Posts. + (line 40) +* forge-edit-topic-labels: Editing Topics and Posts. + (line 43) +* forge-edit-topic-marks: Editing Topics and Posts. + (line 47) +* forge-edit-topic-note: Editing Topics and Posts. + (line 65) +* forge-edit-topic-review-requests: Editing Topics and Posts. + (line 60) +* forge-edit-topic-state: Editing Topics and Posts. + (line 36) +* forge-edit-topic-title: Editing Topics and Posts. + (line 32) +* forge-forge.remote: Repository Detection. + (line 80) +* forge-fork: Miscellaneous. (line 7) +* forge-insert-assigned-issues: Listing Topics and Notifications. + (line 50) +* forge-insert-assigned-pullreqs: Listing Topics and Notifications. + (line 38) +* forge-insert-authored-issues: Listing Topics and Notifications. + (line 54) +* forge-insert-authored-pullreqs: Listing Topics and Notifications. + (line 46) +* forge-insert-issues: Listing Topics and Notifications. + (line 17) +* forge-insert-pullreqs: Listing Topics and Notifications. + (line 13) +* forge-insert-requested-reviews: Listing Topics and Notifications. + (line 42) +* forge-list-assigned-issues: Listing Topics and Notifications. + (line 88) +* forge-list-assigned-pullreqs: Listing Topics and Notifications. + (line 84) +* forge-list-authored-issues: Listing Topics and Notifications. + (line 100) +* forge-list-authored-pullreqs: Listing Topics and Notifications. + (line 96) +* forge-list-issues: Listing Topics and Notifications. + (line 73) +* forge-list-labeled-issues: Listing Topics and Notifications. + (line 80) +* forge-list-labeled-pullreqs: Listing Topics and Notifications. + (line 76) +* forge-list-notifications: Listing Topics and Notifications. + (line 65) +* forge-list-owned-issues: Listing Topics and Notifications. + (line 110) +* forge-list-owned-pullreqs: Listing Topics and Notifications. + (line 104) +* forge-list-pullreqs: Listing Topics and Notifications. + (line 69) +* forge-list-repositories: Listing Topics and Notifications. + (line 62) +* forge-list-requested-reviews: Listing Topics and Notifications. + (line 92) +* forge-merge: Editing Topics and Posts. + (line 72) +* forge-post-cancel: Editing Topics and Posts. + (line 96) +* forge-post-dispatch: Editing Topics and Posts. + (line 100) +* forge-post-submit: Editing Topics and Posts. + (line 92) +* forge-post-toggle-draft: Editing Topics and Posts. + (line 105) +* forge-pull: Pulling. (line 13) +* forge-pull-notifications: Pulling. (line 25) +* forge-pull-topic: Pulling. (line 47) +* forge-remove-repository: Miscellaneous. (line 44) +* forge-remove-topic-locally: Miscellaneous. (line 48) +* forge-reset-database: Miscellaneous. (line 58) +* forge-toggle-closed-visibility: Listing Topics and Notifications. + (line 31) +* forge-toggle-closed-visibility <1>: Miscellaneous. (line 28) +* forge-toggle-display-in-status-buffer: Miscellaneous. (line 24) +* forge-visit-issue: Visiting Topics. (line 36) +* forge-visit-pullreq: Visiting Topics. (line 36) +* forge-visit-topic: Visiting Topics. (line 36) +* forge-visit-TYPE: Visiting Topics. (line 36) + + +File: forge.info, Node: Variable Index, Prev: Function and Command Index, Up: Top + +Appendix D Variable Index +************************* + +[index] +* Menu: + +* forge-owned-accounts: Listing Topics and Notifications. + (line 116) +* forge-owned-ignored: Listing Topics and Notifications. + (line 131) +* forge-topic-list-limit: Listing Topics and Notifications. + (line 20) +* forge.remote: Repository Detection. + (line 66) + + + +Tag Table: +Node: Top751 +Node: Introduction2435 +Node: Supported Forges and Hosts2998 +Node: Supported Forges4248 +Ref: Github4404 +Ref: Github Caveats4547 +Ref: Github Hosts5193 +Ref: Gitlab5249 +Ref: Gitlab Caveats5264 +Ref: Gitlab Hosts5389 +Node: Partially Supported Forges5509 +Ref: Gitea https//giteaio5715 +Ref: Gitea Hosts5815 +Ref: Gogs https//gogsio5871 +Ref: Gogs Hosts6074 +Ref: Bitbucket https//bitbucketorg6132 +Ref: Bitbucket Caveats6330 +Ref: Bitbucket Hosts7227 +Node: Supported Semi-Forges7292 +Ref: Gitweb https//git-scmcom/docs/gitweb7463 +Ref: Gitweb Caveats7542 +Ref: Cgit https//gitzx2c4com/cgit/about7782 +Ref: Cgit Caveats7859 +Ref: Cgit Hosts8208 +Ref: Stgit https//codemadnessorg/git/stagit/file/READMEhtml8335 +Ref: Stgit Caveats8452 +Ref: Stgit Hosts8738 +Ref: Srht https//metasrht8798 +Ref: Srht Caveats8847 +Ref: Srht Hosts9130 +Node: Getting Started9181 +Node: Loading Forge10179 +Node: Token Creation10574 +Node: Initial Pull11853 +Node: Repository Detection13248 +Node: Caveats17387 +Node: Usage18313 +Node: Pulling19785 +Node: Branching22468 +Node: Working with Topics28857 +Node: Visiting Topics29230 +Node: Listing Topics and Notifications31307 +Node: Creating Topics36631 +Node: Editing Topics and Posts37120 +Node: Miscellaneous41647 +Node: FAQ44270 +Node: Is it possible to create a single pull-request without pulling everything?44738 +Node: error in process filter HTTP Error 502 "Bad gateway"45204 +Node: Keystroke Index47575 +Node: Function and Command Index53265 +Node: Variable Index61223 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: diff --git a/elpa/ghub-20191007.1420/buck.el b/elpa/ghub-20191007.1420/buck.el deleted file mode 100644 index 94e7d81a..00000000 --- a/elpa/ghub-20191007.1420/buck.el +++ /dev/null @@ -1,128 +0,0 @@ -;;; buck.el --- minuscule client library for the Bitbucket API -*- lexical-binding: t -*- - -;; Copyright (C) 2016-2019 Jonas Bernoulli - -;; Author: Jonas Bernoulli -;; Homepage: https://github.com/magit/ghub -;; Keywords: tools - -;; 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 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. - -;; For a copy of the GPL see https://www.gnu.org/licenses/gpl.txt. - -;;; Commentary: - -;; Buck is a library that provides basic support for using the Bitbucket API -;; from Emacs packages. It abstracts access to API resources using only -;; a handful of functions that are not resource-specific. - -;; This library is implemented on top of Ghub. Unlike Ghub, Buck does -;; not support the guided creation of tokens because Bitbucket lacks the -;; features that would be necessary to implement that. Users have to -;; create tokens through the web interface. - -;;; Code: - -(require 'ghub) - -(defconst buck-default-host "api.bitbucket.org/2.0" - "The default host that is used if `buck.host' is not set.") - -;; HEAD and PATCH are not supported according to -;; https://developer.atlassian.com/bitbucket/api/2/reference/meta/uri-uuid - -(cl-defun buck-get (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `GET' request for RESOURCE, with optional query PARAMS. -Like calling `ghub-request' (which see) with \"GET\" as METHOD -and `bitbucket' as FORGE." - (ghub-request "GET" resource params :forge 'bitbucket - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun buck-put (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `PUT' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"PUT\" as METHOD -and `bitbucket' as FORGE." - (ghub-request "PUT" resource params :forge 'bitbucket - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun buck-post (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `POST' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"POST\" as METHOD -and `bitbucket' as FORGE." - (ghub-request "POST" resource params :forge 'bitbucket - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun buck-delete (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `DELETE' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"DELETE\" as METHOD -and `bitbucket' as FORGE." - (ghub-request "DELETE" resource params :forge 'bitbucket - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun buck-request (method resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a request for RESOURCE and return the response body. -Like calling `ghub-request' (which see) with `bitbucket' as FORGE." - (ghub-request method resource params :forge 'bitbucket - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun buck-repository-id (owner name &key username auth host) - "Return the id of the repository specified by OWNER, NAME and HOST." - (substring (cdr (assq 'uuid - (buck-get (format "/repositories/%s/%s" owner name) - nil - :username username :auth auth :host host))) - 1 -1)) - -;;; _ -(provide 'buck) -;;; buck.el ends here diff --git a/elpa/ghub-20191007.1420/dir b/elpa/ghub-20191007.1420/dir deleted file mode 100644 index 8392fa02..00000000 --- a/elpa/ghub-20191007.1420/dir +++ /dev/null @@ -1,18 +0,0 @@ -This is the file .../info/dir, which contains the -topmost node of the Info hierarchy, called (dir)Top. -The first time you invoke Info you start off looking at this node. - -File: dir, Node: Top This is the top of the INFO tree - - This (the Directory node) gives a menu of major topics. - Typing "q" exits, "H" lists all Info commands, "d" returns here, - "h" gives a primer for first-timers, - "mEmacs" visits the Emacs manual, etc. - - In Emacs, you can click mouse button 2 on a menu item or cross reference - to select it. - -* Menu: - -Emacs -* Ghub: (ghub). Minuscule client library for the Github API. diff --git a/elpa/ghub-20191007.1420/ghub-autoloads.el b/elpa/ghub-20191007.1420/ghub-autoloads.el deleted file mode 100644 index f87340ca..00000000 --- a/elpa/ghub-20191007.1420/ghub-autoloads.el +++ /dev/null @@ -1,51 +0,0 @@ -;;; ghub-autoloads.el --- automatically extracted autoloads -;; -;;; Code: -(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path)))) - -;;;### (autoloads nil "ghub" "ghub.el" (23994 46481 891444 634000)) -;;; Generated autoloads from ghub.el - -(autoload 'ghub-create-token "ghub" "\ -Create, store and return a new token. - -HOST is the Github instance, usually \"api.github.com\". -USERNAME is the name of a user on that instance. -PACKAGE is the package that will use the token. -SCOPES are the scopes the token is given access to. - -\(fn HOST USERNAME PACKAGE SCOPES)" t nil) - -(autoload 'ghub-token-scopes "ghub" "\ -Return and echo the scopes of the specified token. -This is intended for debugging purposes only. The user -has to provide several values including their password. - -\(fn HOST USERNAME PACKAGE)" t nil) - -(autoload 'ghub-clear-caches "ghub" "\ -Clear all caches that might negatively affect Ghub. - -If a library that is used by Ghub caches incorrect information -such as a mistyped password, then that can prevent Ghub from -asking the user for the correct information again. - -Set `url-http-real-basic-auth-storage' to nil -and call `auth-source-forget+'. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil nil ("buck.el" "ghub-graphql.el" "ghub-pkg.el" -;;;;;; "glab.el" "gogs.el" "gsexp.el" "gtea.el") (23994 46481 895331 -;;;;;; 836000)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; ghub-autoloads.el ends here diff --git a/elpa/ghub-20191007.1420/ghub-graphql.el b/elpa/ghub-20191007.1420/ghub-graphql.el deleted file mode 100644 index b39f1bc3..00000000 --- a/elpa/ghub-20191007.1420/ghub-graphql.el +++ /dev/null @@ -1,454 +0,0 @@ -;;; ghub-graphql.el --- access Github API using GrapthQL -*- lexical-binding: t -*- - -;; Copyright (C) 2016-2019 Jonas Bernoulli - -;; Author: Jonas Bernoulli -;; Homepage: https://github.com/magit/ghub - -;; 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 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. - -;; For a copy of the GPL see https://www.gnu.org/licenses/gpl.txt. - -;;; Code: - -(require 'dash) -(require 'ghub) -(require 'gsexp) -(require 'treepy) - -(eval-when-compile - (require 'subr-x)) - -;;; Api - -(cl-defun ghub-graphql (graphql &optional variables - &key username auth host - silent - callback errorback value extra) - "Make a GraphQL request using GRAPHQL and VARIABLES. -Return the response as a JSON-like alist. Even if the response -contains `errors', do not raise an error. GRAPHQL is a GraphQL -string. VARIABLES is a JSON-like alist. The other arguments -behave as for `ghub-request' (which see)." - (cl-assert (stringp graphql)) - (cl-assert (not (stringp variables))) - (ghub-request "POST" "/graphql" nil :payload - (json-encode `(("query" . ,graphql) - ,@(and variables `(("variables" ,@variables))))) - :silent silent - :username username :auth auth :host host - :callback callback :errorback errorback - :extra extra :value value)) - -(cl-defun ghub-graphql-rate-limit (&key username auth host) - "Return rate limit information." - (let-alist (ghub-graphql - "query { rateLimit { limit cost remaining resetAt }}" - nil :username username :auth auth :host host) - .data.rateLimit)) - -(cl-defun ghub--repository-id (owner name &key username auth host) - "Return the id of the repository specified by OWNER, NAME and HOST." - (let-alist (ghub-graphql - "query ($owner:String!, $name:String!) { - repository(owner:$owner, name:$name) { id } - }" - `((owner . ,owner) - (name . ,name)) - :username username :auth auth :host host) - .data.repository.id)) - -;;; Api (drafts) - -(defconst ghub-fetch-repository - '(query - (repository - [(owner $owner String!) - (name $name String!)] - name - id - createdAt - updatedAt - nameWithOwner - (parent nameWithOwner) - description - homepageUrl - (defaultBranchRef name) - isArchived - isFork - isLocked - isMirror - isPrivate - hasIssuesEnabled - hasWikiEnabled - (licenseInfo name) - (stargazers totalCount) - (watchers totalCount) - (assignableUsers [(:edges t)] - id - login - name) - (issues [(:edges t) - (:singular issue number) - (orderBy ((field UPDATED_AT) (direction DESC)))] - number - state - (author login) - title - createdAt - updatedAt - closedAt - locked - (milestone id) - body - (assignees [(:edges t)] - id) - (comments [(:edges t)] - databaseId - (author login) - createdAt - updatedAt - body) - (labels [(:edges t)] - id)) - (labels [(:edges t) - (:singular label id)] - id - name - color - description) - (pullRequests [(:edges t) - (:singular pullRequest number) - (orderBy ((field UPDATED_AT) (direction DESC)))] - number - state - (author login) - title - createdAt - updatedAt - closedAt - mergedAt - locked - maintainerCanModify - isCrossRepository - (milestone id) - body - (baseRef name - (repository nameWithOwner)) - (headRef name - (repository (owner login) - nameWithOwner)) - (assignees [(:edges t)] - id) - (reviewRequests [(:edges t)] - (requestedReviewer "... on User { id }\n")) - (comments [(:edges t)] - databaseId - (author login) - createdAt - updatedAt - body) - (labels [(:edges t)] - id))))) - -(cl-defun ghub-fetch-repository (owner name callback - &optional until - &key username auth host forge) - "Asynchronously fetch forge data about the specified repository. -Once all data has been collected, CALLBACK is called with the -data as the only argument." - (ghub--graphql-vacuum ghub-fetch-repository - `((owner . ,owner) - (name . ,name)) - callback until - :narrow '(repository) - :username username - :auth auth - :host host - :forge forge)) - -(cl-defun ghub-fetch-issue (owner name number callback - &optional until - &key username auth host forge) - "Asynchronously fetch forge data about the specified issue. -Once all data has been collected, CALLBACK is called with the -data as the only argument." - (ghub--graphql-vacuum (ghub--graphql-prepare-query - ghub-fetch-repository - `(repository issues (issue . ,number))) - `((owner . ,owner) - (name . ,name)) - callback until - :narrow '(repository issue) - :username username - :auth auth - :host host - :forge forge)) - -(cl-defun ghub-fetch-pullreq (owner name number callback - &optional until - &key username auth host forge) - "Asynchronously fetch forge data about the specified pull-request. -Once all data has been collected, CALLBACK is called with the -data as the only argument." - (ghub--graphql-vacuum (ghub--graphql-prepare-query - ghub-fetch-repository - `(repository pullRequests (pullRequest . ,number))) - `((owner . ,owner) - (name . ,name)) - callback until - :narrow '(repository pullRequest) - :username username - :auth auth - :host host - :forge forge)) - -;;; Internal - -(cl-defstruct (ghub--graphql-req - (:include ghub--req) - (:constructor ghub--make-graphql-req) - (:copier nil)) - (query nil :read-only t) - (query-str nil :read-only nil) - (variables nil :read-only t) - (until nil :read-only t) - (buffer nil :read-only t) - (pages 0 :read-only nil)) - -(cl-defun ghub--graphql-vacuum (query variables callback - &optional until - &key narrow username auth host forge) - "Make a GraphQL request using QUERY and VARIABLES. -See Info node `(ghub)GraphQL Support'." - (unless host - (setq host (ghub--host forge))) - (unless (or username (stringp auth) (eq auth 'none)) - (setq username (ghub--username host forge))) - (ghub--graphql-retrieve - (ghub--make-graphql-req - :url (url-generic-parse-url - (format "https://%s/graphql" - (if (string-suffix-p "/v3" host) - (substring host 0 -3) - host))) - :method "POST" - :headers (ghub--headers nil host auth username forge) - :handler 'ghub--graphql-handle-response - :query query - :variables variables - :until until - :buffer (current-buffer) - :callback (let ((buf (current-buffer))) - (if narrow - (lambda (data) - (let ((path narrow) key) - (while (setq key (pop path)) - (setq data (cdr (assq key data))))) - (ghub--graphql-set-mode-line buf nil) - (funcall callback data)) - (lambda (data) - (ghub--graphql-set-mode-line buf nil) - (funcall callback data))))))) - -(cl-defun ghub--graphql-retrieve (req &optional lineage cursor) - (let ((p (cl-incf (ghub--graphql-req-pages req)))) - (when (> p 1) - (ghub--graphql-set-mode-line req "Fetching page %s" p))) - (setf (ghub--graphql-req-query-str req) - (gsexp-encode - (ghub--graphql-prepare-query - (ghub--graphql-req-query req) - lineage cursor))) - (ghub--retrieve - (let ((json-false nil)) - (ghub--encode-payload - `((query . ,(ghub--graphql-req-query-str req)) - (variables . ,(ghub--graphql-req-variables req))))) - req)) - -(defun ghub--graphql-prepare-query (query &optional lineage cursor) - (when lineage - (setq query (ghub--graphql-narrow-query query lineage cursor))) - (let ((loc (ghub--alist-zip query)) - variables) - (cl-block nil - (while t - (let ((node (treepy-node loc))) - (when (vectorp node) - (let ((alist (cl-coerce node 'list)) - vars) - (when (cadr (assq :edges alist)) - (push (list 'first 100) vars) - (setq loc (treepy-up loc)) - (setq node (treepy-node loc)) - (setq loc (treepy-replace - loc `(,(car node) - ,(cadr node) - (pageInfo endCursor hasNextPage) - (edges (node ,@(cddr node)))))) - (setq loc (treepy-down loc)) - (setq loc (treepy-next loc))) - (dolist (elt alist) - (cond ((keywordp (car elt))) - ((= (length elt) 3) - (push (list (nth 0 elt) - (nth 1 elt)) vars) - (push (list (nth 1 elt) - (nth 2 elt)) variables)) - ((= (length elt) 2) - (push elt vars)))) - (setq loc (treepy-replace loc (vconcat (nreverse vars))))))) - (if (treepy-end-p loc) - (let ((node (copy-sequence (treepy-node loc)))) - (when variables - (push (cl-coerce variables 'vector) - (cdr node))) - (cl-return node)) - (setq loc (treepy-next loc))))))) - -(defun ghub--graphql-handle-response (status req) - (let ((buffer (current-buffer))) - (unwind-protect - (progn - (set-buffer-multibyte t) - (let* ((headers (ghub--handle-response-headers status req)) - (payload (ghub--handle-response-payload req)) - (payload (ghub--handle-response-error status payload req)) - (err (plist-get status :error)) - (errors (cdr (assq 'errors payload))) - (errors (and errors (cons 'ghub-graphql-error errors)))) - (if (or err errors) - (if-let ((errorback (ghub--req-errorback req))) - (funcall errorback (or err errors) headers status req) - (ghub--signal-error (or err errors))) - (ghub--graphql-walk-response req (assq 'data payload))))) - (when (buffer-live-p buffer) - (kill-buffer buffer))))) - -(defun ghub--graphql-walk-response (req data) - (let* ((loc (ghub--req-value req)) - (loc (if (not loc) - (ghub--alist-zip data) - (setq data (ghub--graphql-narrow-data - data (ghub--graphql-lineage loc))) - (setf (alist-get 'edges data) - (append (alist-get 'edges (treepy-node loc)) - (or (alist-get 'edges data) - (error "BUG: Expected new nodes")))) - (treepy-replace loc data)))) - (cl-block nil - (while t - (when (eq (car-safe (treepy-node loc)) 'edges) - (setq loc (treepy-up loc)) - (pcase-let ((`(,key . ,val) (treepy-node loc))) - (let-alist val - (let* ((cursor (and .pageInfo.hasNextPage - .pageInfo.endCursor)) - (until (cdr (assq (intern (format "%s-until" key)) - (ghub--graphql-req-until req)))) - (nodes (mapcar #'cdar .edges)) - (nodes (if until - (--take-while - (or (string> (cdr (assq 'updatedAt it)) until) - (setq cursor nil)) - nodes) - nodes))) - (if cursor - (progn - (setf (ghub--req-value req) loc) - (ghub--graphql-retrieve req - (ghub--graphql-lineage loc) - cursor) - (cl-return)) - (setq loc (treepy-replace loc (cons key nodes)))))))) - (if (not (treepy-end-p loc)) - (setq loc (treepy-next loc)) - (funcall (ghub--req-callback req) - (treepy-root loc)) - (cl-return)))))) - -(defun ghub--graphql-lineage (loc) - (let (lineage) - (while (treepy-up loc) - (push (car (treepy-node loc)) lineage) - (setq loc (treepy-up loc))) - lineage)) - -(defun ghub--graphql-narrow-data (data lineage) - (let (key) - (while (setq key (pop lineage)) - (if (consp (car lineage)) - (progn (pop lineage) - (setf data (cadr data))) - (setq data (assq key (cdr data)))))) - data) - -(defun ghub--graphql-narrow-query (query lineage cursor) - (if (consp (car lineage)) - (let* ((child (cddr query)) - (alist (cl-coerce (cadr query) 'list)) - (single (cdr (assq :singular alist)))) - `(,(car single) - ,(vector (list (cadr single) (cdr (car lineage)))) - ,@(if (cdr lineage) - (ghub--graphql-narrow-query child (cdr lineage) cursor) - child))) - (let* ((child (or (assq (car lineage) (cdr query)) - ;; Alias - (cl-find-if (lambda (c) - (eq (car-safe (car-safe c)) - (car lineage))) - query) - ;; Edges - (cl-find-if (lambda (c) - (and (listp c) - (vectorp (cadr c)) - (eq (cadr (assq :singular - (cl-coerce (cadr c) - 'list))) - (car lineage)))) - (cdr query)) - (error "BUG: Failed to narrow query"))) - (object (car query)) - (args (and (vectorp (cadr query)) - (cadr query)))) - `(,object - ,@(and args (list args)) - ,(cond ((cdr lineage) - (ghub--graphql-narrow-query child (cdr lineage) cursor)) - (cursor - `(,(car child) - ,(vconcat `((after ,cursor)) - (cadr child)) - ,@(cddr child))) - (t - child)))))) - -(defun ghub--alist-zip (root) - (let ((branchp (lambda (elt) (and (listp elt) (listp (cdr elt))))) - (make-node (lambda (_ children) children))) - (treepy-zipper branchp #'identity make-node root))) - -(defun ghub--graphql-set-mode-line (buf string &rest args) - (when (ghub--graphql-req-p buf) - (setq buf (ghub--graphql-req-buffer buf))) - (when (buffer-live-p buf) - (with-current-buffer buf - (setq mode-line-process - (and string (concat " " (apply #'format string args)))) - (force-mode-line-update t)))) - -;;; _ -(provide 'ghub-graphql) -;;; ghub-graphql.el ends here diff --git a/elpa/ghub-20191007.1420/ghub-pkg.el b/elpa/ghub-20191007.1420/ghub-pkg.el deleted file mode 100644 index 2cfdd4b5..00000000 --- a/elpa/ghub-20191007.1420/ghub-pkg.el +++ /dev/null @@ -1,8 +0,0 @@ -(define-package "ghub" "20191007.1420" "Minuscule client libraries for Git forge APIs." - '((emacs "25.1") - (dash "2.14.1") - (let-alist "1.0.5") - (treepy "0.1.1"))) -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/ghub-20191007.1420/ghub.el b/elpa/ghub-20191007.1420/ghub.el deleted file mode 100644 index ec73de58..00000000 --- a/elpa/ghub-20191007.1420/ghub.el +++ /dev/null @@ -1,1041 +0,0 @@ -;;; ghub.el --- minuscule client libraries for Git forge APIs -*- lexical-binding: t -*- - -;; Copyright (C) 2016-2019 Jonas Bernoulli - -;; Author: Jonas Bernoulli -;; Homepage: https://github.com/magit/ghub -;; Keywords: tools - -;; 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 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. - -;; For a copy of the GPL see https://www.gnu.org/licenses/gpl.txt. - -;;; Commentary: - -;; Ghub provides basic support for using the APIs of various Git forges -;; from Emacs packages. Originally it only supported the Github REST -;; API, but now it also supports the Github GraphQL API as well as the -;; REST APIs of Gitlab, Gitea, Gogs and Bitbucket. - -;; Ghub abstracts access to API resources using only a handful of basic -;; functions such as `ghub-get'. These are convenience wrappers around -;; `ghub-request'. Additional forge-specific wrappers like `glab-put', -;; `gtea-put', `gogs-post' and `buck-delete' are also available. Ghub -;; does not provide any resource-specific functions, with the exception -;; of `FORGE-repository-id'. - -;; When accessing Github, then Ghub handles the creation and storage of -;; access tokens using a setup wizard to make it easier for users to get -;; started. The tokens for other forges have to be created manually. - -;; Ghub is intentionally limited to only provide these two essential -;; features — basic request functions and guided setup — to avoid being -;; too opinionated, which would hinder wide adoption. It is assumed that -;; wide adoption would make life easier for users and maintainers alike, -;; because then all packages that talk to forge APIs could be configured -;; the same way. - -;; Please consult the manual (info "ghub") for more information. - -;;; Code: - -(require 'auth-source) -(require 'cl-lib) -(require 'gnutls) -(require 'json) -(require 'let-alist) -(require 'url) -(require 'url-auth) -(require 'url-http) - -(eval-when-compile - (require 'subr-x)) - -(defvar url-callback-arguments) -(defvar url-http-end-of-headers) -(defvar url-http-extra-headers) -(defvar url-http-response-status) - -;;; Settings - -(defconst ghub-default-host "api.github.com" - "The default host that is used if `ghub.host' is not set.") - -(defvar ghub-github-token-scopes '(repo) - "The Github API scopes that your private tools need. - -The token that is created based on the value of this variable -is used when `ghub-request' (or one of its wrappers) is called -without providing a value for AUTH. Packages should always -identify themselves using that argument, but when you use Ghub -directly in private tools, then that is not necessary and the -request is made on behalf of the `ghub' package itself, aka on -behalf of some private tool. - -By default the only requested scope is `repo' because that is -sufficient as well as required for most common uses. This and -other scopes are documented at URL `https://magit.vc/goto/2e586d36'. - -If your private tools need other scopes, then you have to add -them here *before* creating the token. Alternatively you can -edit the scopes of an existing token using the web interface -at URL `https://github.com/settings/tokens'.") - -(defvar ghub-override-system-name nil - "If non-nil, the string used to identify the local machine. -If this is nil, then the value returned by `system-name' is -used instead.") - -(defvar ghub-insecure-hosts nil - "List of hosts that use http instead of https.") - -;;; Request -;;;; Object - -(cl-defstruct (ghub--req - (:constructor ghub--make-req) - (:copier nil)) - (url nil :read-only nil) - (forge nil :read-only t) - (silent nil :read-only t) - (method nil :read-only t) - (headers nil :read-only t) - (handler nil :read-only t) - (unpaginate nil :read-only nil) - (noerror nil :read-only t) - (reader nil :read-only t) - (callback nil :read-only t) - (errorback nil :read-only t) - (value nil :read-only nil) - (extra nil :read-only nil)) - -(defalias 'ghub-req-extra 'ghub--req-extra) - -;;;; API - -(define-error 'ghub-error "Ghub/Url Error" 'error) -(define-error 'ghub-http-error "HTTP Error" 'ghub-error) - -(defvar ghub-response-headers nil - "The headers returned in response to the last request. -`ghub-request' returns the response body and stores the -response headers in this variable.") - -(cl-defun ghub-head (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `HEAD' request for RESOURCE, with optional query PARAMS. -Like calling `ghub-request' (which see) with \"HEAD\" as METHOD." - (ghub-request "HEAD" resource params - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun ghub-get (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `GET' request for RESOURCE, with optional query PARAMS. -Like calling `ghub-request' (which see) with \"GET\" as METHOD." - (ghub-request "GET" resource params - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun ghub-put (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `PUT' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"PUT\" as METHOD." - (ghub-request "PUT" resource params - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun ghub-post (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `POST' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"POST\" as METHOD." - (ghub-request "POST" resource params - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun ghub-patch (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `PATCH' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"PATCH\" as METHOD." - (ghub-request "PATCH" resource params - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun ghub-delete (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `DELETE' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"DELETE\" as METHOD." - (ghub-request "DELETE" resource params - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun ghub-request (method resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host forge - callback errorback value extra) - "Make a request for RESOURCE and return the response body. - -Also place the response headers in `ghub-response-headers'. - -METHOD is the HTTP method, given as a string. -RESOURCE is the resource to access, given as a string beginning - with a slash. - -PARAMS, QUERY, PAYLOAD and HEADERS are alists used to specify - data. The Github API documentation is vague on how data has - to be transmitted and for a particular resource usually just - talks about \"parameters\". Generally speaking when the METHOD - is \"HEAD\" or \"GET\", then they have to be transmitted as a - query, otherwise as a payload. -Use PARAMS to automatically transmit like QUERY or PAYLOAD would - depending on METHOD. -Use QUERY to explicitly transmit data as a query. -Use PAYLOAD to explicitly transmit data as a payload. - Instead of an alist, PAYLOAD may also be a string, in which - case it gets encoded as UTF-8 but is otherwise transmitted as-is. -Use HEADERS for those rare resources that require that the data - is transmitted as headers instead of as a query or payload. - When that is the case, then the API documentation usually - mentions it explicitly. - -If SILENT is non-nil, then don't message progress reports and - the like. - -If UNPAGINATE is t, then make as many requests as necessary to - get all values. If UNPAGINATE is a natural number, then get - at most that many pages. For any other non-nil value raise - an error. -If NOERROR is non-nil, then do not raise an error if the request - fails and return nil instead. If NOERROR is `return', then - return the error payload instead of nil. -If READER is non-nil, then it is used to read and return from the - response buffer. The default is `ghub--read-json-payload'. - For the very few resources that do not return JSON, you might - want to use `ghub--decode-payload'. - -If USERNAME is non-nil, then make a request on behalf of that - user. It is better to specify the user using the Git variable - `github.user' for \"api.github.com\", or `github.HOST.user' if - connecting to a Github Enterprise instance. - -Each package that uses `ghub' should use its own token. If AUTH - is nil, then the generic `ghub' token is used instead. This - is only acceptable for personal utilities. A packages that - is distributed to other users should always use this argument - to identify itself, using a symbol matching its name. - - Package authors who find this inconvenient should write a - wrapper around this function and possibly for the - method-specific functions as well. - - Some symbols have a special meaning. `none' means to make an - unauthorized request. `basic' means to make a password based - request. If the value is a string, then it is assumed to be - a valid token. `basic' and an explicit token string are only - intended for internal and debugging uses. - - If AUTH is a package symbol, then the scopes are specified - using the variable `AUTH-github-token-scopes'. It is an error - if that is not specified. See `ghub-github-token-scopes' for - an example. - -If HOST is non-nil, then connect to that Github instance. This - defaults to \"api.github.com\". When a repository is connected - to a Github Enterprise instance, then it is better to specify - that using the Git variable `github.host' instead of using this - argument. - -If FORGE is `gitlab', then connect to Gitlab.com or, depending - on HOST, to another Gitlab instance. This is only intended for - internal use. Instead of using this argument you should use - function `glab-request' and other `glab-*' functions. - -If CALLBACK and/or ERRORBACK is non-nil, then make one or more - asynchronous requests and call CALLBACK or ERRORBACK when - finished. If no error occurred, then call CALLBACK, unless - that is nil. - - If an error occurred, then call ERRORBACK, or if that is nil, - then CALLBACK. ERRORBACK can also be t, in which case an error - is signaled instead. NOERROR is ignored for all asynchronous - requests. - -Both callbacks are called with four arguments. - 1. For CALLBACK, the combined value of the retrieved pages. - For ERRORBACK, the error that occured when retrieving the - last page. - 2. The headers of the last page as an alist. - 3. Status information provided by `url-retrieve'. Its `:error' - property holds the same information as ERRORBACK's first - argument. - 4. A `ghub--req' struct, which can be passed to `ghub-continue' - (which see) to retrieve the next page, if any." - (cl-assert (or (booleanp unpaginate) (natnump unpaginate))) - (unless (string-prefix-p "/" resource) - (setq resource (concat "/" resource))) - (unless host - (setq host (ghub--host forge))) - (unless (or username (stringp auth) (eq auth 'none)) - (setq username (ghub--username host forge))) - (cond ((not params)) - ((member method '("GET" "HEAD")) - (when query - (error "PARAMS and QUERY are mutually exclusive for METHOD %S" - method)) - (setq query params)) - (t - (when payload - (error "PARAMS and PAYLOAD are mutually exclusive for METHOD %S" - method)) - (setq payload params))) - (when (or callback errorback) - (setq noerror t)) - (ghub--retrieve - (ghub--encode-payload payload) - (ghub--make-req - :url (url-generic-parse-url - (concat (if (member host ghub-insecure-hosts) "http://" "https://") - (if (and (equal resource "/graphql") - (string-suffix-p "/v3" host)) - (substring host 0 -3) - host) - resource - (and query (concat "?" (ghub--url-encode-params query))))) - :forge forge - :silent silent - ;; Encode in case caller used (symbol-name 'GET). #35 - :method (encode-coding-string method 'utf-8) - :headers (ghub--headers headers host auth username forge) - :handler 'ghub--handle-response - :unpaginate unpaginate - :noerror noerror - :reader reader - :callback callback - :errorback errorback - :value value - :extra extra))) - -(defun ghub-continue (req) - "If there is a next page, then retrieve that. - -This function is only intended to be called from callbacks. If -there is a next page, then retrieve that and return the buffer -that the result will be loaded into, or t if the process has -already completed. If there is no next page, then return nil. - -Callbacks are called with four arguments (see `ghub-request'). -The forth argument is a `ghub--req' struct, intended to be passed -to this function. A callback may use the struct's `extra' slot -to pass additional information to the callback that will be -called after the next request has finished. Use the function -`ghub-req-extra' to get and set the value of this slot." - (and (assq 'next (ghub-response-link-relations req)) - (or (ghub--retrieve nil req) t))) - -(cl-defun ghub-wait (resource &optional duration &key username auth host) - "Busy-wait up to DURATION seconds for RESOURCE to become available. - -DURATION specifies how many seconds to wait at most. It defaults -to 64 seconds. The first attempt is made immediately, the second -after two seconds, and each subsequent attempt is made after -waiting as long again as we already waited between all preceding -attempts combined. - -See `ghub-request' for information about the other arguments." - (unless duration - (setq duration 64)) - (with-local-quit - (let ((total 0)) - (while (not (ghub-get resource nil - :noerror t - :username username - :auth auth - :host host)) - (message "Waited (%3ss of %ss) for %s..." total duration resource) - (if (= total duration) - (error "Github is taking too long to create %s" resource) - (if (> total 0) - (let ((wait (min total (- duration total)))) - (sit-for wait) - (cl-incf total wait)) - (sit-for (setq total 2)))))))) - -(defun ghub-response-link-relations (req &optional headers payload) - "Return an alist of link relations in HEADERS. -If optional HEADERS is nil, then return those that were -previously stored in the variable `ghub-response-headers'. - -When accessing a Bitbucket instance then the link relations -are in PAYLOAD instead of HEADERS, making their API merely -RESTish and forcing this function to append those relations -to the value of `ghub-response-headers', for later use when -this function is called with nil for PAYLOAD." - (if (eq (ghub--req-forge req) 'bitbucket) - (if payload - (let* ((page (cl-mapcan (lambda (key) - (when-let ((elt (assq key payload))) - (list elt))) - '(size page pagelen next previous))) - (headers (cons (cons 'link-alist page) headers))) - (if (and req (or (ghub--req-callback req) - (ghub--req-errorback req))) - (setq-local ghub-response-headers headers) - (setq-default ghub-response-headers headers)) - page) - (cdr (assq 'link-alist ghub-response-headers))) - (when-let ((rels (cdr (assoc "Link" (or headers ghub-response-headers))))) - (mapcar (lambda (elt) - (pcase-let ((`(,url ,rel) (split-string elt "; "))) - (cons (intern (substring rel 5 -1)) - (substring url 1 -1)))) - (split-string rels ", "))))) - -(cl-defun ghub-repository-id (owner name &key username auth host forge noerror) - "Return the id of the specified repository. -Signal an error if the id cannot be determined." - (let ((fn (cl-case forge - ((nil ghub github) 'ghub--repository-id) - (gitlab 'glab-repository-id) - (gittea 'gtea-repository-id) - (gogs 'gogs-repository-id) - (bitbucket 'buck-repository-id) - (t (intern (format "%s-repository-id" forge)))))) - (unless (fboundp fn) - (error "ghub-repository-id: Forge type/abbreviation `%s' is unknown" - forge)) - (or (funcall fn owner name :username username :auth auth :host host) - (and (not noerror) - (error "Repository %S does not exist on %S.\n%s%S?" - (concat owner "/" name) - (or host (ghub--host forge)) - "Maybe it was renamed and you have to update " - "remote..url"))))) - -;;;; Internal - -(defvar ghub-use-workaround-for-emacs-bug - (and - ;; Note: For build sans gnutls, `libgnutls-version' is -1. - (>= libgnutls-version 30603) - (version<= emacs-version "26.2") - 'force) - "Whether to use a kludge that hopefully works around an Emacs bug. - -In Emacs versions before 26.3 there is a bug that causes network -connections to fail when using TLS1.3. If this variable is -non-nil, then Ghub works around that by binding -`gnutls-algorithm-priority' to \"NORMAL:-VERS-TLS1.3\", unless we -think it is unnecessary. If `force' then always use the -workaround. Currently the latter is the default except when -using Emacs 26.3+, or the libgnutls is earlier than 3.6.3 (when -it introduced TLS1.3). - -For more information see https://github.com/magit/ghub/issues/81 -and https://debbugs.gnu.org/cgi/bugreport.cgi?bug=34341.") - -(cl-defun ghub--retrieve (payload req) - (let ((url-request-extra-headers - (let ((headers (ghub--req-headers req))) - (if (functionp headers) (funcall headers) headers))) - (url-request-method (ghub--req-method req)) - (url-request-data payload) - (url-show-status nil) - (url (ghub--req-url req)) - (handler (ghub--req-handler req)) - (silent (ghub--req-silent req)) - (gnutls-algorithm-priority - (if (and ghub-use-workaround-for-emacs-bug - (or (eq ghub-use-workaround-for-emacs-bug 'force) - (and (not gnutls-algorithm-priority) - (>= libgnutls-version 30603) - (version<= emacs-version "26.2") - (memq (ghub--req-forge req) '(github nil))))) - "NORMAL:-VERS-TLS1.3" - gnutls-algorithm-priority))) - (if (or (ghub--req-callback req) - (ghub--req-errorback req)) - (url-retrieve url handler (list req) silent) - ;; When this function has already been called, then it is a - ;; no-op. Otherwise it sets `url-registered-auth-schemes' among - ;; other things. If we didn't ensure that it has been run, then - ;; `url-retrieve-synchronously' would do it, which would cause - ;; the value that we let-bind below to be overwritten, and the - ;; "default" value to be lost outside the let-binding. - (url-do-setup) - (with-current-buffer - (let ((url-registered-auth-schemes - '(("basic" ghub--basic-auth-errorback . 10)))) - (url-retrieve-synchronously url silent)) - (funcall handler (car url-callback-arguments) req))))) - -(defun ghub--handle-response (status req) - (let ((buffer (current-buffer))) - (unwind-protect - (progn - (set-buffer-multibyte t) - (let* ((unpaginate (ghub--req-unpaginate req)) - (headers (ghub--handle-response-headers status req)) - (payload (ghub--handle-response-payload req)) - (payload (ghub--handle-response-error status payload req)) - (value (ghub--handle-response-value payload req)) - (prev (ghub--req-url req)) - (next (cdr (assq 'next (ghub-response-link-relations - req headers payload))))) - (when (numberp unpaginate) - (cl-decf unpaginate)) - (setf (ghub--req-url req) - (url-generic-parse-url next)) - (setf (ghub--req-unpaginate req) unpaginate) - (or (and next - unpaginate - (or (eq unpaginate t) - (> unpaginate 0)) - (ghub-continue req)) - (let ((callback (ghub--req-callback req)) - (errorback (ghub--req-errorback req)) - (err (plist-get status :error))) - (cond ((and err errorback) - (setf (ghub--req-url req) prev) - (funcall (if (eq errorback t) - 'ghub--errorback - errorback) - err headers status req)) - (callback - (funcall callback value headers status req)) - (t value)))))) - (when (buffer-live-p buffer) - (kill-buffer buffer))))) - -(defun ghub--handle-response-headers (status req) - (goto-char (point-min)) - (forward-line 1) - (let (headers) - (when (memq url-http-end-of-headers '(nil 0)) - (setq url-debug t) - (let ((print-escape-newlines nil)) - (error "BUG: missing headers - See https://github.com/magit/ghub/issues/81. - headers: %S - status: %S - buffer: %S" - url-http-end-of-headers - status - (current-buffer)))) - (while (re-search-forward "^\\([^:]*\\): \\(.+\\)" - url-http-end-of-headers t) - (push (cons (match-string 1) - (match-string 2)) - headers)) - (setq headers (nreverse headers)) - (goto-char (1+ url-http-end-of-headers)) - (if (and req (or (ghub--req-callback req) - (ghub--req-errorback req))) - (setq-local ghub-response-headers headers) - (setq-default ghub-response-headers headers)) - headers)) - -(defun ghub--handle-response-error (status payload req) - (let ((noerror (ghub--req-noerror req)) - (err (plist-get status :error))) - (if err - (if noerror - (if (eq noerror 'return) - payload - (setcdr (last err) (list payload)) - nil) - (ghub--signal-error err payload req)) - payload))) - -(defun ghub--signal-error (err &optional payload req) - (pcase-let ((`(,symb . ,data) err)) - (if (eq symb 'error) - (if (eq (car-safe data) 'http) - (signal 'ghub-http-error - (let ((code (car (cdr-safe data)))) - (list code - (nth 2 (assq code url-http-codes)) - (and req (url-filename (ghub--req-url req))) - payload))) - (signal 'ghub-error data)) - (signal symb data)))) - -(defun ghub--errorback (err _headers _status req) - (ghub--signal-error err (nth 3 err) req)) - -(defun ghub--handle-response-value (payload req) - (setf (ghub--req-value req) - (nconc (ghub--req-value req) - (if-let ((nested (and (eq (ghub--req-forge req) 'bitbucket) - (assq 'values payload)))) - (cdr nested) - payload)))) - -(defun ghub--handle-response-payload (req) - (funcall (or (ghub--req-reader req) - 'ghub--read-json-payload) - url-http-response-status)) - -(defun ghub--read-json-payload (_status) - (let ((raw (ghub--decode-payload))) - (and raw - (condition-case nil - (let ((json-object-type 'alist) - (json-array-type 'list) - (json-key-type 'symbol) - (json-false nil) - (json-null nil)) - (json-read-from-string raw)) - (json-readtable-error - `((message - . ,(if (looking-at "") - (if (re-search-forward - "

\\(?:\\)?\\([^<]+\\)" nil t) - (match-string 1) - "error description missing") - (string-trim (buffer-substring (point) (point-max))))) - (documentation_url - . "https://github.com/magit/ghub/wiki/Github-Errors"))))))) - -(defun ghub--decode-payload (&optional _status) - (and (not (eobp)) - (decode-coding-string - (buffer-substring-no-properties (point) (point-max)) - 'utf-8))) - -(defun ghub--encode-payload (payload) - (and payload - (progn - (unless (stringp payload) - (setq payload (json-encode-list payload))) - (encode-coding-string payload 'utf-8)))) - -(defun ghub--url-encode-params (params) - (mapconcat (lambda (param) - (pcase-let ((`(,key . ,val) param)) - (concat (url-hexify-string (symbol-name key)) "=" - (if (integerp val) - (number-to-string val) - (url-hexify-string val))))) - params "&")) - -;;; Authentication -;;;; API - -;;;###autoload -(defun ghub-create-token (host username package scopes) - "Create, store and return a new token. - -HOST is the Github instance, usually \"api.github.com\". -USERNAME is the name of a user on that instance. -PACKAGE is the package that will use the token. -SCOPES are the scopes the token is given access to." - (interactive - (pcase-let ((`(,host ,username ,package) - (ghub--read-triplet))) - (list host username package - (split-string - (read-string - "Scopes (separated by commas): " - (mapconcat #'symbol-name - (symbol-value - (intern (format "%s-github-token-scopes" package))) - ",")) - "," t "[\s\t]+")))) - (let ((user (ghub--ident username package))) - (cl-destructuring-bind (save token) - (ghub--auth-source-get (list :save-function :secret) - :create t :host host :user user - :secret - (cdr (assq 'token - (ghub-post - "/authorizations" - `((scopes . ,scopes) - (note . ,(ghub--ident-github package))) - :username username :auth 'basic :host host)))) - ;; Build-in back-ends return a function that does the actual - ;; saving, while for some third-party back-ends ":create t" - ;; is enough. - (when (functionp save) - (funcall save)) - ;; If the Auth-Source cache contains the information that there - ;; is no value, then setting the value does not invalidate that - ;; now incorrect information. - ;; The (:max 1) is needed and has to be placed at the - ;; end for Emacs releases before 26.1. #24 #64 #72 - (auth-source-forget (list :host host :user user :max 1)) - token))) - -;;;###autoload -(defun ghub-token-scopes (host username package) - "Return and echo the scopes of the specified token. -This is intended for debugging purposes only. The user -has to provide several values including their password." - (interactive (ghub--read-triplet)) - (let ((scopes - (cdr (assq 'scopes (ghub--get-token-plist host username package))))) - (when (called-interactively-p 'any) - ;; Also show the input values to make it easy for package - ;; authors to verify that the user has done it correctly. - (message "Scopes for %s@%s: %S" - (ghub--ident username package) - host scopes)) - scopes)) - -;;;###autoload -(defun ghub-clear-caches () - "Clear all caches that might negatively affect Ghub. - -If a library that is used by Ghub caches incorrect information -such as a mistyped password, then that can prevent Ghub from -asking the user for the correct information again. - -Set `url-http-real-basic-auth-storage' to nil -and call `auth-source-forget+'." - (interactive) - (setq url-http-real-basic-auth-storage nil) - (auth-source-forget+)) - -;;;; Internal - -(defun ghub--headers (headers host auth username forge) - (push (cons "Content-Type" "application/json") headers) - (if (eq auth 'none) - headers - (unless (or username (stringp auth)) - (setq username (ghub--username host forge))) - (lambda () - (if (eq auth 'basic) - (cons (cons "Authorization" (ghub--basic-auth host username)) - headers) - (cons (ghub--auth host auth username forge) headers))))) - -(defun ghub--auth (host auth &optional username forge) - (unless username - (setq username (ghub--username host forge))) - (if (eq auth 'basic) - (cl-ecase forge - ((nil github gitea gogs bitbucket) - (cons "Authorization" (ghub--basic-auth host username))) - (gitlab - (error "Gitlab does not support basic authentication"))) - (cons (cl-ecase forge - ((nil github gitea gogs bitbucket) - "Authorization") - (gitlab - "Private-Token")) - (if (eq forge 'bitbucket) - ;; For some undocumented reason Bitbucket supports - ;; values of the form "token " only for GET - ;; requests. For PUT requests we have to use basic - ;; authentication. Note that the secret is a token - ;; (aka "app password"), not the actual password. - ;; The documentation fails to mention this little - ;; detail. See #97. - (concat "Basic " - (base64-encode-string - (concat username ":" - (ghub--token host username auth nil forge)))) - (concat - (and (not (eq forge 'gitlab)) "token ") - (encode-coding-string - (cl-typecase auth - (string auth) - (null (ghub--token host username 'ghub nil forge)) - (symbol (ghub--token host username auth nil forge)) - (t (signal 'wrong-type-argument - `((or stringp symbolp) ,auth)))) - 'utf-8)))))) - -(defun ghub--basic-auth (host username) - (let ((url (url-generic-parse-url - (if (member host ghub-insecure-hosts) "http://" "https://")))) - (setf (url-user url) username) - (url-basic-auth url t))) - -(defun ghub--basic-auth-errorback (url &optional prompt _overwrite _realm _args) - ;; This gets called twice. Do nothing the first time, - ;; when PROMPT is nil. See `url-get-authentication'. - (when prompt - (if (assoc "X-GitHub-OTP" (ghub--handle-response-headers nil nil)) - (progn - (setq url-http-extra-headers - `(("Pragma" . "no-cache") - ("Content-Type" . "application/json") - ("X-GitHub-OTP" . ,(ghub--read-2fa-code)) - ;; Without "Content-Type" and "Authorization". - ;; The latter gets re-added from the return value. - ,@(cddr url-http-extra-headers))) - ;; Return the cached values, they are correct. - (url-basic-auth url nil nil nil)) - ;; Remove the invalid cached values and fail, which - ;; is better than the invalid values sticking around. - (setq url-http-real-basic-auth-storage - (cl-delete (format "%s:%d" (url-host url) (url-port url)) - url-http-real-basic-auth-storage - :test #'equal :key #'car)) - nil))) - -(defun ghub--token (host username package &optional nocreate forge) - (let* ((user (ghub--ident username package)) - (token - (or (car (ghub--auth-source-get (list :secret) - :host host :user user)) - (progn - ;; Auth-Source caches the information that there is no - ;; value, but in our case that is a situation that needs - ;; fixing so we want to keep trying by invalidating that - ;; information. - ;; The (:max 1) is needed and has to be placed at the - ;; end for Emacs releases before 26.1. #24 #64 #72 - (auth-source-forget (list :host host :user user :max 1)) - (and (not nocreate) - (cl-ecase forge - ((nil github) - (ghub--confirm-create-token host username package)) - ((gitlab gitea gogs bitbucket) - (error "Required %s token (%S for %S) does not exist. -See https://magit.vc/manual/ghub/Support-for-Other-Forges.html for instructions." - (capitalize (symbol-name forge)) - user host)))))))) - (if (functionp token) (funcall token) token))) - -(cl-defmethod ghub--host (forge) - (cl-ecase forge - ((nil github) - (or (ignore-errors (car (process-lines "git" "config" "github.host"))) - ghub-default-host)) - (gitlab - (or (ignore-errors (car (process-lines "git" "config" "gitlab.host"))) - (bound-and-true-p glab-default-host))) - (gitea - (or (ignore-errors (car (process-lines "git" "config" "gitea.host"))) - (bound-and-true-p gtea-default-host))) - (gogs - (or (ignore-errors (car (process-lines "git" "config" "gogs.host"))) - (bound-and-true-p gogs-default-host))) - (bitbucket - (or (ignore-errors (car (process-lines "git" "config" "bitbucket.host"))) - (bound-and-true-p buck-default-host))))) - -(cl-defmethod ghub--username (host &optional forge) - (let ((var - (cl-ecase forge - ((nil github) - (if (equal host ghub-default-host) - "github.user" - (format "github.%s.user" host))) - (gitlab - (if (equal host "gitlab.com/api/v4") - "gitlab.user" - (format "gitlab.%s.user" host))) - (bitbucket - (if (equal host "api.bitbucket.org/2.0") - "bitbucket.user" - (format "bitbucket.%s.user" host))) - (gitea - (when (zerop (call-process "git" nil nil nil "config" "gitea.host")) - (error "gitea.host is set but always ignored")) - (format "gitea.%s.user" host)) - (gogs - (when (zerop (call-process "git" nil nil nil "config" "gogs.host")) - (error "gogs.host is set but always ignored")) - (format "gogs.%s.user" host))))) - (condition-case nil - (car (process-lines "git" "config" var)) - (error - (let ((user (read-string - (format "Git variable `%s' is unset. Set to: " var)))) - (if (equal user "") - (user-error "The empty string is not a valid username") - (call-process "git" nil nil nil "config" "--global" var user) - user)))))) - -(defun ghub--ident (username package) - (format "%s^%s" username package)) - -(defun ghub--ident-github (package) - (format "Emacs package %s @ %s" - package - (or ghub-override-system-name (system-name)))) - -(defun ghub--package-scopes (package) - (let ((var (intern (format "%s-github-token-scopes" package)))) - (if (boundp var) - (symbol-value var) - (error "%s fails to define %s" package var)))) - -(defun ghub--confirm-create-token (host username package) - (let* ((ident (ghub--ident-github package)) - (scopes (ghub--package-scopes package)) - (max-mini-window-height 40)) - (if (let ((message-log-max nil)) - (yes-or-no-p - (format - "Such a Github API token is not available: - - Host: %s - User: %s - Package: %s - - Scopes requested in `%s-github-token-scopes':\n%s - Store on Github as:\n %S - Store locally according to option `auth-sources':\n %S -%s -If in doubt, then abort and first view the section of -the Ghub documentation called \"Interactively Creating -and Storing a Token\". - -Otherwise confirm and then provide your Github username and -password at the next two prompts. Depending on the backend -you might have to provide a passphrase and confirm that you -really want to save the token. - -Create and store such a token? " - host username package package - (mapconcat (lambda (scope) (format " %s" scope)) scopes "\n") - ident auth-sources - (if (and (stringp (car auth-sources)) - (not (string-suffix-p ".gpg" (car auth-sources)))) - (format " -WARNING: The token will be stored unencrypted in %S. - If you don't want that, you have to abort and customize - the `auth-sources' option.\n" (car auth-sources)) - "")))) - (condition-case err - ;; Naively attempt to create the token since the user told us to - (ghub-create-token host username package scopes) - ;; The API _may_ respond with the fact that a token of the name - ;; we wanted already exists. At this point we're out of luck. We - ;; don't have a token (otherwise why would we be here?) and, if - ;; the user is using SMS 2FA, we have no way of telling GitHub - ;; to send a new 2FA code to the user other than sending a POST - ;; to /authorizations which is ugly. - ;; - ;; If they are not using SMS 2FA then we could try to delete the - ;; existing token (which will require them to hand us another - ;; OTP for the delete request) and then call create again, - ;; possibly requiring _another_ OTP if they don't do things fast - ;; enough, but this is only because non-SMS 2FA doesn't require - ;; any action on GitHub's part. - ;; - ;; GitHub does hand us a header that indicates what type of 2FA - ;; is in use, but it's not currently available in this location - ;; and would make the following code which is already quite - ;; complicated even more complicated. So in the interest of - ;; simplicity it's better to error out here and ask the user to - ;; take action. This situation should almost never arise anyway. - (ghub-http-error - (if (equal (alist-get 'code (car (alist-get 'errors (nth 4 err)))) - "already_exists") - (error "A token named %S already exists on Github. -Please visit https://github.com/settings/tokens and delete it." ident) - (signal (car err) (cdr err))))) - (user-error "Abort")))) - -(defun ghub--get-token-id (host username package) - (let ((ident (ghub--ident-github package))) - (cl-some (lambda (x) - (let-alist x - (and (equal .app.name ident) .id))) - (ghub-get "/authorizations" - '((per_page . 100)) - :unpaginate t - :username username :auth 'basic :host host)))) - -(defun ghub--get-token-plist (host username package) - (ghub-get (format "/authorizations/%s" - (ghub--get-token-id host username package)) - nil :username username :auth 'basic :host host)) - -(defun ghub--delete-token (host username package) - (ghub-delete (format "/authorizations/%s" - (ghub--get-token-id host username package)) - nil :username username :auth 'basic :host host)) - -(defun ghub--read-triplet () - (let ((host (read-string "Host: " (ghub--host)))) - (list host - (read-string "Username: " (ghub--username host)) - (intern (read-string "Package: " "ghub"))))) - -(defvar ghub--2fa-cache nil) - -(defun ghub--read-2fa-code () - (let ((code (read-string "Two-factor authentication code: " - (and ghub--2fa-cache - (< (float-time (time-subtract - (current-time) - (cdr ghub--2fa-cache))) - 25) - (car ghub--2fa-cache))))) - (setq ghub--2fa-cache (cons code (current-time))) - code)) - -(defun ghub--auth-source-get (keys &rest spec) - (declare (indent 1)) - (let ((plist (car (apply #'auth-source-search - (append spec (list :max 1)))))) - (mapcar (lambda (k) - (plist-get plist k)) - keys))) - -(advice-add 'auth-source-netrc-parse-next-interesting :around - 'auth-source-netrc-parse-next-interesting@save-match-data) -(defun auth-source-netrc-parse-next-interesting@save-match-data (fn) - "Save match-data for the benefit of caller `auth-source-netrc-parse-one'. -Without wrapping this function in `save-match-data' the caller -won't see the secret from a line that is followed by a commented -line." - (save-match-data (funcall fn))) - -;;; _ -(provide 'ghub) -(require 'ghub-graphql) -;;; ghub.el ends here diff --git a/elpa/ghub-20191007.1420/ghub.info b/elpa/ghub-20191007.1420/ghub.info deleted file mode 100644 index 5d0bdb48..00000000 --- a/elpa/ghub-20191007.1420/ghub.info +++ /dev/null @@ -1,1319 +0,0 @@ -This is ghub.info, produced by makeinfo version 6.5 from ghub.texi. - - Copyright (C) 2017-2019 Jonas Bernoulli - - You can redistribute this document 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 document 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. - -INFO-DIR-SECTION Emacs -START-INFO-DIR-ENTRY -* Ghub: (ghub). Minuscule client library for the Github API. -END-INFO-DIR-ENTRY - - -File: ghub.info, Node: Top, Next: Introduction, Up: (dir) - -Ghub User and Developer Manual -****************************** - -Ghub provides basic support for using the APIs of various Git forges -from Emacs packages. Originally it only supported the Github REST API, -but now it also supports the Github GraphQL API as well as the REST APIs -of Gitlab, Gitea, Gogs and Bitbucket. - - Ghub abstracts access to API resources using only a handful of basic -functions such as ‘ghub-get‘. These are convenience wrappers around -‘ghub-request‘. Additional forge-specific wrappers like ‘glab-put‘, -‘gtea-put‘, ‘gogs-post‘ and ‘buck-delete‘ are also available. Ghub does -not provide any resource-specific functions, with the exception of -‘FORGE-repository-id‘. - - When accessing Github, then Ghub handles the creation and storage of -access tokens using a setup wizard to make it easier for users to get -started. The tokens for other forges have to be created manually. - - Ghub is intentionally limited to only provide these two essential -features — basic request functions and guided setup — to avoid being too -opinionated, which would hinder wide adoption. It is assumed that wide -adoption would make life easier for users and maintainers alike, because -then all packages that talk to forge APIs could be configured the same -way. - -This manual is for Ghub version 3.2.0 (v3.2.0-35-g9d75d30+1). - - Copyright (C) 2017-2019 Jonas Bernoulli - - You can redistribute this document 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 document 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. - -* Menu: - -* Introduction:: -* Getting Started:: -* Using Ghub in Personal Scripts:: -* Using Ghub in a Package:: -* API:: -* GraphQL Support:: -* Support for Other Forges:: - -— The Detailed Node Listing — - -Getting Started - -* Setting the Username:: -* Interactively Creating and Storing a Token:: -* Manually Creating and Storing a Token:: -* How Ghub uses Auth-Source:: - -API - -* Making Requests:: -* Authentication:: -* Configuration Variables:: - -Support for Other Forges - -* Forge Functions and Variables:: -* Forge Limitations and Notes:: - - - -File: ghub.info, Node: Introduction, Next: Getting Started, Prev: Top, Up: Top - -1 Introduction -************** - -Ghub provides basic support for using the APIs of various Git forges -from Emacs packages. Originally it only supported the Github REST API, -but now it also supports the Github GraphQL API as well as the REST APIs -of Gitlab, Gitea, Gogs and Bitbucket. - - Ghub abstracts access to API resources using only a handful of basic -functions such as ‘ghub-get‘. These are convenience wrappers around -‘ghub-request‘. Additional forge-specific wrappers like ‘glab-put‘, -‘gtea-put‘, ‘gogs-post‘ and ‘buck-delete‘ are also available. Ghub does -not provide any resource-specific functions, with the exception of -‘FORGE-repository-id‘. - - When accessing Github, then Ghub handles the creation and storage of -access tokens using a setup wizard to make it easier for users to get -started. The tokens for other forges have to be created manually. - - Ghub is intentionally limited to only provide these two essential -features — basic request functions and guided setup — to avoid being too -opinionated, which would hinder wide adoption. It is assumed that wide -adoption would make life easier for users and maintainers alike, because -then all packages that talk to forge APIs could be configured the same -way. - - Fancier interfaces can be implemented on top of Ghub, and one such -wrapper — named simply Ghub+ — has already been implemented. The -benefit of basing various opinionated interfaces on top of a single -library that provides only the core functionality is that choosing the -programming interface no longer dictates how access tokens are handled. -Users can then use multiple packages that access the Github API without -having to learn the various incompatible ways packages expect the -appropriate token to be made available to them. - - Ghub uses the built-in ‘auth-source’ library to store access tokens. -That library is very flexible and supports multiple backends, which -means that it is up to the user how secrets are stored. They can, among -other things, choose between storing secrets in plain text for ease of -use, or encrypted for better security. - - Previously (as in until this library is widely adopted) it was up to -package authors to decide if things should be easy or secure. (Note -that ‘auth-source’ defaults to "easy" — you have been warned.) - - Ghub expects package authors to use a dedicated access token instead -of sharing a single token between all packages that rely on it. That -means that users cannot configure Ghub once and later start using a new -package without any additional setup. But Ghub helps with that. - - When the user invokes some command that ultimately results in -‘ghub-request’ being called and the appropriate token is not available -yet, then the user is guided through the process of creating and storing -a new token, and at the end of that process the request is carried out -as if the token had been available to begin with. - - -File: ghub.info, Node: Getting Started, Next: Using Ghub in Personal Scripts, Prev: Introduction, Up: Top - -2 Getting Started -***************** - -Each package that uses Ghub uses its own token. Despite that, chances -are good that after successfully configuring one package you can just -start using another package pretty much instantly. - - If the necessary token to access a Github instance is not available -when a package makes an API request, then a setup wizard pops up, and -after answering a few questions you are good to go. Even the request -that caused the wizard to be summoned should succeed and for most users -this should be true even when configuring the very first token. - - However, in some situations some manual configuration is necessary -*before* using the wizard, or the wizard cannot be used at all: - - • If you don’t want to use the wizard then you don’t have to and can - create tokens manually as described in *note Manually Creating and - Storing a Token::. - - • Unfortunately only Github supports the creation of tokens by using - the API. If you want to access another forge, then you have to - create the token manually as describe in *note Manually Creating - and Storing a Token::. Also see *note Support for Other Forges::. - - • If you want to access a Github Enterprise instance, then you have - to tell Ghub about that before the wizard makes its appearance by - setting the Git variable ‘github.host’. You also have to tell Ghub - your username for that instance using the variable - ‘github.HOST.user’ even if it is the same as on Github.com. - - These variables are documented in *note Configuration Variables::. - Also see *note Setting the Username::. TL;DR: If your Github - Enterprise instance is hosted at ‘git.example.com’ and your - username on that instance is ‘jtribbiani’, then set ‘github.host’ - to ‘git.example.com/api/v3’ in every repository cloned from that - instance (i.e. _do not_ set it globally) and _globally_ set - ‘github.git.example.com/api/v3.user’ to ‘jtribbiani’. The latter - is necessary even if your username on Github.com is the same. - - For some Github Enterprice instances ‘/api’ has to be used instead - of ‘/api/v3’ as shown above. If the wizard fails in both cases, - then try creating the token manually. - - • If the variable ‘github.user’ (or ‘github.HOST.user’ for an - Enterprise instance) is unset when the wizard is first summoned, - then you are asked to provide your username. That value is then - stored *globally* to avoid having to ask you that question once per - repository. If you have multiple accounts on Github.com (or a - Github Enterprise instance), then you have to explicitly tell Ghub - about that. This can be done by setting the repository-local - values of the appropriate variable *before* the wizard is invoked. - - • You might forget to do the above, which is why it is important to - carefully read the output of the wizard. If it turns out that you - forgot to set a variable, then you must abort, set the variable, - and repeat the request to trigger the wizard again. - - • The setup wizard should work even if you have enabled two-factor - authentication. However if your Github Enterprise instance - enforces Single Sign-On as an additional security measure, then you - are out of luck and have to create the token manually as described - in *note Manually Creating and Storing a Token::. - - The variables mentioned above — and others — are documented in *note -Configuration Variables:: and the setup wizard is documented in *note -Interactively Creating and Storing a Token::. - -* Menu: - -* Setting the Username:: -* Interactively Creating and Storing a Token:: -* Manually Creating and Storing a Token:: -* How Ghub uses Auth-Source:: - - -File: ghub.info, Node: Setting the Username, Next: Interactively Creating and Storing a Token, Up: Getting Started - -2.1 Setting the Username -======================== - -If you haven’t set the Git variable ‘github.user’ yet when making a -request, then you will be asked: - - Git variable `github.user' is unset. Set to: - - You are expected to provide your Github username here. The provided -value will be saved globally (using ‘git config --global github.user -USERNAME’). - - If you need to identify as another user in a particular repository, -then you have to set that variable locally, *before* making a request: - - cd /path/to/repo - git config github.user USERNAME - - For Github Enterprise instances you have to specify where the API can -be accessed *before* you try to access it and a different variable has -to be used to set the username. For example if the API is available at -‘https://example.com/api/v3’, then you should do this: - - # Do this once - git config --global github.example.com/api/v3.user EMPLOYEE - - # Do this for every corporate repository - cd /path/to/repo - git config github.host example.com/api/v3 - - If you do not set ‘github.example.com/api/v3.user’, then you will be -asked to provide the value when trying to make a request, but you do -have to manually set ‘github.host’, or Ghub assumes that you are trying -to access ‘api.github.com’. - - -File: ghub.info, Node: Interactively Creating and Storing a Token, Next: Manually Creating and Storing a Token, Prev: Setting the Username, Up: Getting Started - -2.2 Interactively Creating and Storing a Token -============================================== - -Ghub uses a different token for every package as well as for every -machine from which you access the Github API (and obviously also for -every Github instance and user). This allows packages to only request -the scopes that they actually need and also gives users the opportunity -to refuse access to certain scopes if they expect to not use the -features that need them. - - Usually you don’t have to worry about creating and storing a token -yourself and can just make a request. Note however that you don’t have -to use the setup wizard described below. Alternatively you can perform -the setup manually as described in the next section. - - If you make a request and the required token is not available yet, -then the setup wizard will first ask you something like this: - - Such a Github API token is not available: - - Host: api.github.com - User: USERNAME - Package: PACKAGE - - Scopes requested in `PACKAGE-github-token-scopes': - repo - Store on Github as: - "Emacs package PACKAGE @ LOCAL-MACHINE" - Store locally according to option `auth-sources': - ("~/.authinfo" "~/.authinfo.gpg" "~/.netrc") - - If in doubt, then abort and first view the section of - the Ghub documentation called "Interactively Creating - and Storing a Token". - - Create and store such a token? (yes or no) - - If you don’t have any doubts, then answer "yes". Lets address some -of the doubts that you might have: - - • ‘Host’ usually is "api.github.com" and that is usually what you - want. If you are trying to access a Github Enterprise instance, - then it should be something else and you have to set the value - manually before the setup wizard is summoned, as described in the - parent section. - - • ‘User’ should be your Github.com (or Github Enterprise instance) - username. If it is something else and it doesn’t look like a - simple typo, then you should read the parent section again. In - either case you have to abort. - - • ‘Package’ should be the name of the package you are using to access - the Github API. - - If it is ‘ghub’, then the package author disregarded that - convention and you should probably report a bug in the issue - tracker of that package. - - Or you yourself are using ‘ghub-request’ or one of its wrappers - directly, in which case this is expected and perfectly fine. In - that case you might however want to abort and change the value of - the variable ‘ghub-github-token-scopes’ before triggering the - wizard again. - - • Each ‘PACKAGE’ has to specify the tokens that it needs using a - variable named ‘PACKAGE-github-token-scopes’. The doc-string of - that variable should document why the various scopes are needed. - - The meaning of the various scopes are documented at - . - - • The value of ‘auth-sources’ is shown. The default value causes - secrets to be stored in plain text. Because this might be - unexpected, Ghub additionally displays a warning when appropriate. - - WARNING: The token will be stored unencrypted in "~/.authinfo". - If you don't want that, you have to abort and customize - the `auth-sources' option. - - Whether that is something that needs fixing, is up to you. If your - answer is yes, then you should abort and see *note How Ghub uses - Auth-Source:: for instructions on how to save the token more - securely. - - • When creating a token it is necessary to provide a token - description. Ghub uses descriptions that have the form "Emacs - package PACKAGE @ LOCAL-MACHINE". - - Github uses the token description to identify the token, not merely - as something useful to humans. Token descriptions therefore have - to be unique and in rare cases you get an additional prompt, asking - you something like: - - A token named "Emacs package PACKAGE @ LOCAL-MACHINE" - already exists on Github. Replace it? - - You might see this message when you have lost the old token and - want to replace it with a new one, in which case you should - obviously just proceed. - - Or two of your computers have the same hostname, which is bad - practice because it gains you nothing but leads to issues such as - this. Or you are dual-booting on this machine and use the same - hostname in all operating systems, which is a somewhat reasonable - thing to do, but never-the-less leads to issues like this. - - In either case you will have to use something other than the value - returned by ‘system-name’ to identify the current machine or - operating system. Or you can continue to identify different things - using the same identifier, in which case you have to manually - distribute the token. - - The former is recommended and also easier to do, using the variable - ‘ghub-override-system-name’. See *note Configuration Variables:: - for details. - - After the above prompt you are also asked for your username and -password. If you have enabled two-factor authentication, then you also -have to provide the authentication code at least twice. If you make -sure the code is still good for a while when asked for it first, then -you can just press ‘RET’ at the later prompt(s). - - -File: ghub.info, Node: Manually Creating and Storing a Token, Next: How Ghub uses Auth-Source, Prev: Interactively Creating and Storing a Token, Up: Getting Started - -2.3 Manually Creating and Storing a Token -========================================= - -If you cannot or don’t want to use the wizard then you have to (1) -figure out what scopes a package wants, (2) create such a token using -the web interface and (3) store the token where Ghub expects to find it. - - A package named ‘PACKAGE’ has to specify the scopes that it wants in -the variable named ‘PACKAGE-github-token-scopes’. The doc-string of -such variables should document what the various scopes are needed for. - - To create or edit a token go to . -For Gitlab.com use . - - Finally store the token in a place where Ghub looks for it, as -described in *note How Ghub uses Auth-Source::. - - If you store the token in a file like ‘~/.authinfo’, then note that -‘auth-source’’s parsing of that file is brittle. Make sure the file -ends with a newline character, that there are no empty or invalid lines, -and that all comments are prefixed with ‘#’. - - -File: ghub.info, Node: How Ghub uses Auth-Source, Prev: Manually Creating and Storing a Token, Up: Getting Started - -2.4 How Ghub uses Auth-Source -============================= - -Please see *note (auth)Top:: for all the gory details about Auth-Source. -Some Ghub-specific information and important notes follow. - - The variable ‘auth-sources’ controls how and where Auth-Source stores -new secrets and where it looks for known secrets. The default value is -‘("~/.authinfo" "~/.authinfo.gpg" "~/.netrc")’, which means that it -looks in all of these files in order to find secrets and that it stores -new secrets in ‘~/.authinfo’ because that is the first element of the -list. It doesn’t matter which files already do or don’t exist when -storing a new secret, the first file is always used. - - Secrets are stored in ‘~/.authinfo’ in plain text. If you don’t want -that (good choice), then you have to customize ‘auth-sources’, e.g. by -flipping the positions of the first two elements. - - Auth-Source also supports storing secrets in various key-chains. -Refer to its documentation for more information. - - Some Auth-Source backends only support storing three values per -entry, the "machine", the "login" and the "password". Because Ghub uses -separate tokens for each package, it has to squeeze four values into -those three slots, and it does that by using "USERNAME^PACKAGE" as the -"login". - - Assuming your username is "ziggy",the package is named "stardust", -and you want to access *Github.com* an entry in one of the three -mentioned files would then look like this: - - machine api.github.com login ziggy^stardust password 012345abcdef... - - Assuming your username is "ziggy",the package is named "stardust", -and you want to access *Gitlab.com* an entry in one of the three -mentioned files would then look like this: - - machine gitlab.com/api/v4 login ziggy^stardust password 012345abcdef... - - -File: ghub.info, Node: Using Ghub in Personal Scripts, Next: Using Ghub in a Package, Prev: Getting Started, Up: Top - -3 Using Ghub in Personal Scripts -******************************** - -You can use ‘ghub-request’ and its wrapper functions in your personal -scripts, of course. Unlike when you use Ghub from a package that you -distribute for others to use, you don’t have to specify a package in -personal scripts. - - ;; This is perfectly acceptable in personal scripts ... - (ghub-get "/user") - - ;; ... and actually equal to - (ghub-get "/user" nil :auth 'ghub) - - ;; In packages you have to specify the package using AUTH. - (ghub-get "/user" nil :auth 'foobar) - - When you do not specify the ‘AUTH’ argument, then a request is made -on behalf of the ‘ghub’ package itself. Like for any package that uses -Ghub, ‘ghub’ has to declare what scopes it needs, using, in this case, -the variable ‘ghub-github-token-scopes’. - - The default value of that variable is ‘(repo)’ and you might want to -add additional scopes. You can later add additional scopes to an -existing token, using the web interface at -. - - If you do that, then you might want to also set the variable -accordingly, but note that Ghub only consults that when *creating* a new -token. If you want to know a token’s effective scopes use the command -‘ghub-token-scopes’, described in the next section. - - -File: ghub.info, Node: Using Ghub in a Package, Next: API, Prev: Using Ghub in Personal Scripts, Up: Top - -4 Using Ghub in a Package -************************* - -Every package should use its own token. This allows you as the author -of some package to only request access to API scopes that are actually -needed, which in turn might make it easier for users to trust your -package not to do unwanted things. - - The scopes used by ‘PACKAGE’ have to be defined using the variable -‘PACKAGE-github-token-scopes’, and you have to tell ‘ghub-request’ on -behalf of which package a request is being made by passing the symbol -‘PACKAGE’ as the value of its ‘AUTH’ argument. - - (ghub-request "GET" "/user" nil :auth 'PACKAGE) - - -- Variable: PACKAGE-github-token-scopes - - This variable defines the token scopes requested by the package - named ‘PACKAGE’. The doc-string should explain what the various - scopes are needed for to prevent users from giving ‘PACKAGE’ fewer - permissions than it absolutely needs and also to give them greater - confidence that ‘PACKAGE’ is only requesting the permissions that - it actually needs. - - The value of this variable does not necessarily correspond to the - scopes that the respective token actually gives access to. There - is nothing that prevents users from changing the value *after* - creating the token or from editing the token’s scopes later on. - - So it is pointless to check the value of this variable before - making a request. You also should not query the API to reliably - determine the supported tokens before making a query. Doing the - latter would mean that every request becomes two requests and that - the first request would have to be done using the user’s password - instead of a token. - - -- Command: ghub-token-scopes - - Because we cannot be certain that the user hasn’t messed up the - scopes, Ghub provides this command to make it easy to debug such - issues without having to rely on users being thoughtful enough to - correctly determine the used scopes manually. - - Just tell users to run ‘M-x ghub-token-scopes’ and to provide the - correct values for the ‘HOST’, ‘USERNAME’ and ‘PACKAGE’ when - prompted, and to then post the output. - - It is to be expected that users will occasionally mess that up so - this command outputs not only the scopes but also the user input so - that you can have greater confidence in the validity of the user’s - answer. - - Scopes for USERNAME^PACKAGE@HOST: (SCOPE...) - - -File: ghub.info, Node: API, Next: GraphQL Support, Prev: Using Ghub in a Package, Up: Top - -5 API -***** - -This section describes the Ghub API. In other words it describes the -public functions and variables provided by the Ghub package and not the -APIs of the supported forges, which can be accessed by using those -functions. The forge APIs are documented at: - - • Github: - - • Gitlab: - - • Gitea: and - - - • Gogs: - - • Bitbucket: - - -* Menu: - -* Making Requests:: -* Authentication:: -* Configuration Variables:: - - -File: ghub.info, Node: Making Requests, Next: Authentication, Up: API - -5.1 Making Requests -=================== - - -- Function: ghub-request method resource &optional params &key query - payload headers unpaginate noerror reader username auth host - callback errorback url value error extra method* - - This function makes a request for ‘RESOURCE’ using ‘METHOD’. - ‘PARAMS’, ‘QUERY’, ‘PAYLOAD’ and/or ‘HEADERS’ are alists holding - additional request data. The response body is returned and the - response headers are stored in the variable - ‘ghub-response-headers’. - - • ‘METHOD’ is the HTTP method, given as a string. - - • ‘RESOURCE’ is the resource to access, given as a string - beginning with a slash. - - • ‘PARAMS’, ‘QUERY’, ‘PAYLOAD’ and ‘HEADERS’ are alists and are - used to specify request data. All these arguments are alists - that resemble the JSON expected and returned by the Github - API. The keys are symbols and the values stored in the ‘cdr’ - (not the ‘cadr’) can be strings, integers, or lists of strings - and integers. - - The Github API documentation is vague on how data has to be - transmitted and for a particular resource usually just talks - about "parameters". Generally speaking when the ‘METHOD’ is - "HEAD" or "GET", then they have to be transmitted as a query, - otherwise as a payload. - - • Use ‘PARAMS’ to automatically transmit like ‘QUERY’ or - ‘PAYLOAD’ would depending on ‘METHOD’. - - • Use ‘QUERY’ to explicitly transmit data as a query. - - • Use ‘PAYLOAD’ to explicitly transmit data as a payload. - Instead of an alist, ‘PAYLOAD’ may also be a string, in - which case it gets encoded as UTF-8 but is otherwise - transmitted as-is. - - • Use ‘HEADERS’ for those rare resources that require that - the data is transmitted as headers instead of as a query - or payload. When that is the case, then the Github API - documentation usually mentions it explicitly. - - • If ‘SILENT’ is non-nil, then progress reports and the like are - not messaged. - - • If ‘UNPAGINATE’ is t, then this function make as many requests - as necessary to get all values. If ‘UNPAGINATE’ is a natural - number, then it gets at most that many pages. For any other - non-nil value it raises an error. - - • If ‘NOERROR’ is non-nil, then no error is raised if the - request fails and ‘nil’ is returned instead. If ‘NOERROR’ is - ‘return’, then the error payload is returned instead of ‘nil’. - - • If ‘READER’ is non-nil, then it is used to read and return - from the response buffer. The default is - ‘ghub--read-json-payload’. For the very few resources that do - not return JSON, you might want to use ‘ghub--decode-payload’. - - • If ‘USERNAME’ is non-nil, then the request is made on behalf - of that user. It is better to specify the user using the Git - variable ‘github.user’ for "api.github.com", or - ‘github.HOST.user’ if connecting to a Github Enterprise - instance. - - • Each package that uses Ghub should use its own token. If - ‘AUTH’ is ‘nil’ or unspecified, then the generic ‘ghub’ token - is used instead. This is only acceptable for personal - utilities. A packages that is distributed to other users - should always use this argument to identify itself, using a - symbol matching its name. - - Package authors who find this inconvenient should write a - wrapper around this function and possibly for the - method-specific functions as well. - - Beside ‘nil’, some other symbols have a special meaning too. - ‘none’ means to make an unauthorized request. ‘basic’ means - to make a password based request. If the value is a string, - then it is assumed to be a valid token. ‘basic’ and an - explicit token string are only intended for internal and - debugging uses. - - If ‘AUTH’ is a package symbol, then the scopes are specified - using the variable ‘AUTH-github-token-scopes’. It is an error - if that is not specified. See ‘ghub-github-token-scopes’ for - an example. - - • If ‘HOST’ is non-nil, then connect to that Github instance. - This defaults to "api.github.com". When a repository is - connected to a Github Enterprise instance, then it is better - to specify that using the Git variable ‘github.host’ instead - of using this argument. - - • If ‘FORGE’ is ‘gitlab’, then connect to Gitlab.com or, - depending on ‘HOST’, to another Gitlab instance. This is only - intended for internal use. Instead of using this argument you - should use function ‘glab-request’ and other ‘glab-*’ - functions. - - • If ‘CALLBACK’ and/or ‘ERRORBACK’ is non-nil, then this - function makes one or more asynchronous requests and calls - ‘CALLBACK’ or ‘ERRORBACK’ when finished. If no error - occurred, then it calls ‘CALLBACK’, unless that is ‘nil’. - - If an error occurred, then it calls ‘ERRORBACK’, or if that is - nil, then ‘CALLBACK’. ‘ERRORBACK’ can also be ‘t’, in which - case it signals instead. ‘NOERROR’ is ignored for all - asynchronous requests. - - Both callbacks are called with four arguments. - - • For ‘CALLBACK’, the combined value of the retrieved - pages. For ‘ERRORBACK’, the error that occured when - retrieving the last page. - - • The headers of the last page as an alist. - - • Status information provided by ‘url-retrieve’. Its - ‘:error’ property holds the same information as the first - argument to ‘ERRORBACK’. - - • A ‘ghub--req’ struct, which can be passed to - ‘ghub-continue’ (which see) to retrieve the next page, if - any. - - -- Function: ghub-continue args - - If there is a next page, then this function retrieves that. - - This function is only intended to be called from callbacks. If - there is a next page, then that is retrieved and the buffer that - the result will be loaded into is returned, or t if the process has - already completed. If there is no next page, then return nil. - - Callbacks are called with four arguments (see ‘ghub-request’). The - forth argument is a ‘ghub--req’ struct, intended to be passed to - this function. A callback may use the struct’s ‘extra’ slot to - pass additional information to the callback that will be called - after the next request. Use the function ‘ghub-req-extra’ to get - and set the value of that slot. - - As an example, using ‘ghub-continue’ in a callback like so: - - (ghub-get "/users/tarsius/repos" nil - :callback (lambda (value _headers _status req) - (unless (ghub-continue req) - (setq my-value value)))) - - is equivalent to: - - (ghub-get "/users/tarsius/repos" nil - :unpaginate t - :callback (lambda (value _headers _status _req) - (setq my-value value))) - - To demonstrate how to pass information from one callback to the - next, here we record when we start fetching each page: - - (ghub-get "/users/tarsius/repos" nil - :extra (list (current-time)) - :callback (lambda (value _headers _status req) - (push (current-time) (ghub-req-extra req)) - (unless (ghub-continue req) - (setq my-times (ghub-req-extra req)) - (setq my-value value)))) - - -- Variable: ghub-response-headers - - A select few Github API resources respond by transmitting data in - the response header instead of in the response body. Because there - are so few of these inconsistencies, ‘ghub-request’ always returns - the response body. - - To access the response headers use this variable after - ‘ghub-request’ has returned. - - -- Function: ghub-response-link-relations req headers payload - - This function returns an alist of the link relations in ‘HEADERS’, - or if optional ‘HEADERS’ is nil, then those in - ‘ghub-response-headers’. - - When accessing a Bitbucket instance then the link relations are in - ‘PAYLOAD’ instead of ‘HEADERS’, making their API merely RESTish and - forcing this function to append those relations to the value of - ‘ghub-response-headers’, for later use when this function is called - with ‘nil’ for ‘PAYLOAD’. - - -- Variable: ghub-override-system-name - - If non-nil, the value of this variable is used to override the - value returned by ‘system-name’ for the purpose of identifying the - local machine, which is necessary because Ghub uses separate tokens - for each machine. Also see *note Configuration Variables::. - - -- Variable: ghub-github-token-scopes - -- Variable: PACKAGE-github-token-scopes - - Such a variable defines the token scopes requested by the - respective package ‘PACKAGE’ given by the first word in the - variable name. ‘ghub’ itself is treated like any other package. - Also see *note Using Ghub in a Package::. - - -- Function: ghub-head resource &optional params &key query payload - headers unpaginate noerror reader username auth host callback - errorback - -- Function: ghub-get resource &optional params &key query payload - headers unpaginate noerror reader username auth host callback - errorback - - These functions are simple wrappers around ‘ghub-request’. Their - signature is identical to that of the latter, except that they do - not have an argument named ‘METHOD’. The HTTP method is instead - given by the second word in the function name. - - As described in the documentation for ‘ghub-request’, it depends on - the used method whether the value of the ‘PARAMS’ argument is used - as the query or the payload. For the "HEAD" and "GET" methods it - is used as the query. - - -- Function: ghub-put resource &optional params &key query payload - headers unpaginate noerror reader username auth host callback - errorback - -- Function: ghub-post resource &optional params &key query payload - headers unpaginate noerror reader username auth host callback - errorback - -- Function: ghub-patch resource &optional params &key query payload - headers unpaginate noerror reader username auth host callback - errorback - -- Function: ghub-delete resource &optional params &key query payload - headers unpaginate noerror reader username auth host callback - errorback - - These functions are simple wrappers around ‘ghub-request’. Their - signature is identical to that of the latter, except that they do - not have an argument named ‘METHOD’. The HTTP method is instead - given by the second word in the function name. - - As described in the documentation for ‘ghub-request’, it depends on - the used method whether the value of the ‘PARAMS’ argument is used - as the query or the payload. For the "PUT", "POST", "PATCH" and - "DELETE" methods it is used as the payload. - - -- Function: ghub-wait resource &optional duration &key username auth - host - - Some API requests result in an immediate successful response even - when the requested action has not actually been carried out yet. - An example is the request for the creation of a new repository, - which doesn’t cause the repository to immediately become available. - The Github API documentation usually mentions this when describing - an affected resource. - - If you want to do something with some resource right after making a - request for its creation, then you might have to wait for it to - actually be created. This function can be used to do so. It - repeatedly tries to access the resource until it becomes available - or until the timeout exceeds. In the latter case it signals - ‘ghub-error’. - - ‘RESOURCE’ specifies the resource that this function waits for. - - ‘DURATION’ specifies the maximum number of seconds to wait for, - defaulting to 64 seconds. Emacs will block during that time, but - the user can abort using ‘C-g’. - - The first attempt is made immediately and will often succeed. If - not, then another attempt is made after two seconds, and each - subsequent attempt is made after waiting as long as we already - waited between all preceding attempts combined. - - See ‘ghub-request’’s documentation above for information about the - other arguments. - - -- Function: ghub-graphql graphql &optional variables &key username - auth host callback - - This function makes a GraphQL request using ‘GRAPHQL’ and - ‘VARIABLES’ as inputs. ‘GRAPHQL’ is a GraphQL string. ‘VARIABLES’ - is a JSON-like alist. The other arguments behave as for - ‘ghub-request’ (which see). - - The response is returned as a JSON-like alist. Even if the - response contains ‘errors’, this function does not raise an error. - Cursor-handling is likewise left to the caller. - - -File: ghub.info, Node: Authentication, Next: Configuration Variables, Prev: Making Requests, Up: API - -5.2 Authentication -================== - - -- Command: ghub-create-token - - This command creates a new token using the values it reads from the - user and then stores it according to the variable ‘auth-sources’. - It can also be called non-interactively, but you shouldn’t do that - yourself. - - This is useful if you want to fully setup things before attempting - to make the initial request, if you want to provide fewer than the - requested scopes or customize ‘auth-sources’ first, or if something - has gone wrong when using the wizard that is used when making a - request without doing this first. (Note that instead of using this - command you can also just repeat the initial request after making - the desired adjustments — that is easier.) - - This command reads, in order, the ‘HOST’ (Github instance), the - ‘USERNAME’, the ‘PACKAGE’, and the ‘SCOPES’ in the minibuffer, - providing reasonable default choices. ‘SCOPES’ defaults to the - scopes that ‘PACKAGE’ requests using the variable - ‘PACKAGE-github-token-scopes’. - - -- Command: ghub-token-scopes - - Users are free to give a token access to fewer scopes than what the - respective package requested. That can, of course, lead to issues, - and package maintainers have to be able to quickly determine if - such a (mis-)configuration is the root cause when users report - issues. - - This command reads the required values in the minibuffer and then - shows a message containing these values along with the scopes of - the respective token. It also returns the scopes (only) when - called non-interactively. Also see *note Using Ghub in a - Package::. - - -File: ghub.info, Node: Configuration Variables, Prev: Authentication, Up: API - -5.3 Configuration Variables -=========================== - -The username and, unless you only use Github.com itself, the Github -Enterprise instance have to be configured using Git variables. In rare -cases it might also be necessary to specify the identity of the local -machine, which is done using a lisp variable. - - -- Variable: github.user - - The Github.com username. This should be set globally and if you - have multiple Github.com user accounts, then you should set this - locally only for those repositories that you want to access using - the secondary identity. - - -- Variable: github.HOST.user - - This variable serves the same purpose as ‘github.user’ but for the - Github Enterprise instance identified by ‘HOST’. - - The reason why separate variables are used is that this makes it - possible to set both values globally instead of having to set one - of the values locally in each and every repository that is - connected to the Github Enterprise instance, not Github.com. - - -- Variable: github.host - - This variable should only be set locally for a repository and - specifies the Github Enterprise edition that that repository is - connected to. You should not set this globally because then each - and every repository becomes connected to the specified Github - Enterprise instance, including those that should actually be - connected to Github.com. - - When this is undefined, then "api.github.com" is used (defined in - the constant ‘ghub-default-host’, which you should never attempt to - change.) - - -- Variable: ghub-override-system-name - - Ghub uses a different token for each quadruple ‘(USERNAME PACKAGE - HOST LOCAL-MACHINE)’. Theoretically it could reuse tokens to some - extent but that would be more difficult to implement, less - flexible, and less secure (though slightly more convenient). - - A token is identified on the respective Github instance (Github.com - or a Github Enterprise instance) using the pair ‘(PACKAGE . - LOCAL-MACHINE)’, or more precisely the string "Emacs package - PACKAGE @ LOCAL-MACHINE". ‘USERNAME’ and ‘HOST’ do not have to be - encoded because the token is stored for ‘USERNAME’ on ‘HOST’ and - cannot be used by another user and/or on another instance. - - There is one potential problem though; for any given ‘(PACKAGE . - LOCAL-MACHINE)’ there can only be one token identified by "Emacs - package PACKAGE @ LOCAL-MACHINE"; Github does not allow multiple - tokens with the same description because it uses the description as - the identifier (it could use some hash instead, but alas it does - not). - - If you have multiple machines and some of them have the same name, - then you should probably change that as this is not how things - ought to be. However if you dual-boot, then it might make sense to - give that machine the same name regardless of what operating system - you have booted into. - - You could use the same token on both operating systems, but setting - that up might be somewhat difficult because it is not possible to - download an existing token from Github. You could, of course, - locally copy the token, but that is inconvenient and would make it - harder to only revoke the token used on your infected Windows - installation without also revoking it for your totally safe *BSD - installation. - - Alternatively you can set this variable to a unique value, that - will then be used to identify the local machine instead of the - value returned by ‘system-name’. - - -File: ghub.info, Node: GraphQL Support, Next: Support for Other Forges, Prev: API, Up: Top - -6 GraphQL Support -***************** - - -- Function: ghub-graphql graphql &optional variables &key username - auth host callback silent callback errorback value extra - - This function makes a GraphQL request using ‘GRAPHQL’ and - ‘VARIABLES’ as inputs. ‘GRAPHQL’ is a GraphQL string. ‘VARIABLES’ - is a JSON-like alist. The other arguments behave as for - ‘ghub-request’ (which see). - - The response is returned as a JSON-like alist. Even if the - response contains ‘errors’, this function does not raise an error. - Cursor-handling is likewise left to the caller. - - ‘ghub-graphql’ is a thin convenience wrapper around ‘ghub-request’, -similar to ‘ghub-post’ and friends. While the latter only hard-code the -value of the ‘METHOD’ argument, the former also hard-codes ‘RESOURCE’ -and constructs ‘PAYLOAD’ from ‘GRAPHEQL’ and ‘VARIABLES’. It also drops -‘UNPAGINATE’, ‘NOERROR’, ‘READER’ (internal functions expect alist-ified -JSON) and ‘FORGE’ (only Github currently supports GraphQL). - - ‘ghub-graphql’ does not account for the fact that pagination works -differently in GraphQL than it does in REST, so users of this function -have to deal with that themselves. Likewise error handling works -differently and has to be done by the caller too. - - An early attempt at implementing automatic unpaginating for GraphQL -can be found in the ‘faithful-graphql’ branch, provided I haven’t -deleted that by now. On that branch I try to do things as intended by -the designers of GraphQL, using variables and fragments, and drowning in -a sea of boilerplate. - - The problem with that approach is that it only works for applications -that fetch specific information on demand and actually want things to be -paginated. I am convinced that GraphQL is very nice for web apps. - - However the Forge package for which I am implementing all of this has -very different needs. It wants to fetch "all the data" and "cache" it -locally, so that it is available even when there is no internet -connection. GraphQL was designed around the idea that you should be -able to "ask for what you need and get exactly that". But when that -boils down to "look, if I persist, then you are going to hand me over -all the data anyway, so just caught it up already", then things start to -fall apart. If Github’s GraphQL allowed pagination to be turned off -completely, then teaching ‘ghub-graphql’ about error handling would be -enough. - - But it doesn’t and when doing things as intended, then that leads to -huge amounts of repetitive boilerplate, which is so boring to write that -doing it without introducing bugs left and right is near impossible; so -I decided to give up on GraphQL variables, fragments and conditions, and -instead implement something more powerful, though also more opinionated. - - -- Function: ghub--graphql-vacuum query variables callback &optional - until &key narrow username auth host forge - - This function is an opinionated alternative to ‘ghub-graphql’. It - relies and dark magic to get the job done. - - It makes an initial request using ‘QUERY’. It then looks for - paginated edges in the returned data and makes more requests to - resolve them. In order to do so it automatically transforms the - initial ‘QUERY’ into another query suitable for that particular - edge. The data retrieved by subsequent requests is then injected - into the data of the original request before that is returned or - passed to the callback. If subsequently retrieved data features - new paginated edges, then those are followed recursively. - - The end result is essentially the same as using ‘ghub-graphql’, if - only it were possible to say "do not paginate anything". The - implementation is much more complicated because it is not possible - to do that. - - ‘QUERY’ is a GraphQL query expressed as an s-expression. The - ‘graphql’ package is used to turn that into a GraphQL query string, - but the format is somewhat different than as documented for that - package. Also only a subset of the GraphQL features are supported; - fragments for example are not, and magical stuff happens to - variables. This is not documented yet, I am afraid. Look at - existing callers. - - ‘VARIABLES’ is a JSON-like alist as for ‘ghub-graphql’. - - ‘UNTIL’ is an alist ‘((EDGE-until . VALUE)...)’. When unpaginating - ‘EDGE’ try not to fetch beyond the element whose first field has - the value ‘VALUE’ and remove that element as well as all "lesser" - elements from the retrieved data if necessary. Look at - ‘forge--pull-repository’ for an example. This is only useful if - you "cache" the response locally and want to avoid fetching data - again that you already have. - - Other arguments behave as for ‘ghub-graphql’ and ‘ghub-request’, - more or less. - - Using ‘ghub--graphql-vacuum’, the following resource specific -functions are implemented. These functions are not part of the public -API yet and are very much subject to change. - - -- Function: ghub-fetch-repository owner name callback &optional until - &key username auth host forge - - This function asynchronously fetches forge data about the specified - repository. Once all data has been collected, ‘CALLBACK’ is called - with the data as the only argument. - - -- Function: ghub-fetch-issue owner name callback &optional until &key - username auth host forge - - This function asynchronously fetches forge data about the specified - issue. Once all data has been collected, ‘CALLBACK’ is called with - the data as the only argument. - - -- Function: ghub-fetch-pullreq owner name callback &optional until - &key username auth host forge - - This function asynchronously fetches forge data about the specified - pull-request. Once all data has been collected, ‘CALLBACK’ is - called with the data as the only argument. - - Note that in order to avoid duplication all of these functions base -their initial query on the query stored in ‘ghub-fetch-repository’. The -latter two pass that query through ‘ghub--graphql-prepare-query’, which -then used ‘ghub--graphql-narrow-query’ to remove parts the caller is not -interested in. These two functions are also used internally, when -unpaginating, but as demonstrated here they can be useful even before -making an initial request. - - -File: ghub.info, Node: Support for Other Forges, Prev: GraphQL Support, Up: Top - -7 Support for Other Forges -************************** - -* Menu: - -* Forge Functions and Variables:: -* Forge Limitations and Notes:: - - -File: ghub.info, Node: Forge Functions and Variables, Next: Forge Limitations and Notes, Up: Support for Other Forges - -7.1 Forge Functions and Variables -================================= - -Originally Ghub supported only Github but now it also supports Gitlab, -Gitea, Gogs and Bitbucket. The function ‘ghub-request’ and all the -‘ghub-METHOD’ convenience wrappers default to acting on a Github forge -but can be told to act on another forge using their FORGE argument. - - The FORGE argument only specifies what kind of forge to act on, not -which instance. The HOST argument can be used to select the instance. -For some forges a default instance is defined: - - • Forge ‘github’ defaults to host ‘api.github.com’. - - • Forge ‘gitlab’ defaults to host ‘gitlab.com/api/v4’. - - • Forge ‘bitbucket’ defaults to host ‘api.bitbucket.org/2.0’. - - • No canonical host exists for the ‘gitea’ and ‘gogs’ forges and - ‘localhost:3000/api/v1’ is used as the default host in both cases. - - Together the FORGE and HOST arguments specify the forge type and -instance. In addition to that, it is also necessary to specify on whose -behalf the request is being made, which can be done using the USERNAME -and AUTH arguments. - - Having to specify these arguments for every request is inconvenient. -Additional variables and convenience functions can be used to make that -unnecessary in most cases. - - These variables can be set globally and/or for a specific repository -as explained in *note Configuration Variables:: with a focus on Github -instances. To summarize: - - • For the Git variable ‘github.user’ specifies - the user. - - • For another ‘github’ instance the Git variable ‘github.HOST.user’ - specifies the user. The HOST in that variable name is the same as - the value of the HOST argument of the called function. - - • Instead of specifying the HOST in every function call, the Git - variable ‘github.host’ can be used. This should only be set - locally. - -For ‘gitlab’ and ‘bitbucket’ forges similar variables are available: - - • ‘gitlab.user’ specifies the user. - - • ‘gitlab.HOST.user’ specifies the user for the HOST ‘gitlab’ - instance. - - • ‘gitlab.host’ specifies the ‘gitlab’ host, unless the HOST argument - is non-nil - - • ‘bitbucket.user’ specifies the user. - - • ‘bitbucket.HOST.user’ specifies the user for the HOST ‘bitbucket’ - instance. - - • ‘bitbucket.host’ specifies the ‘bitbucket’ host, unless the HOST - argument is non-nil. - - For ‘gitea’ and ‘gogs’ forges some similar variables are available, -however for some of the ‘ghub.*’ variables no equivalent variable exist -for these two forges: - - • ‘gitea.user’ is *not* used because no canonical ‘gitea’ instance - exists. - - • ‘gitea.HOST.user’ specifies the user for the HOST ‘gitea’ instance. - - • ‘gitea.host’ specifies the ‘gitea’ host, unless the HOST argument - is non-nil - - • ‘gogs.user’ is *not* used because no canonical ‘gitea’ instance - exists. - - • ‘gogs.HOST.user’ specifies the user for the HOST ‘gogs’ instance. - - • ‘gogs.host’ specifies the ‘gogs’ host, unless the HOST argument is - non-nil - - ‘ghub-request’ and ‘ghub-METHOD’ can be used to make a request for -any of the supported forge types, but except when making a request for a -‘github’ instance, then that requires the use of the FORGE argument. - - To avoid that, functions named ‘FORGE-request’ and ‘FORGE-METHOD’ are -also available. The following forms are equivalent, for example: - - (ghub-get ... :auth 'PACKAGE :forge 'gitlab) - (glab-get ... :auth 'PACKAGE) - - These forms would remain equivalent even if you did not specify a -value for the AUTH arguments — but you should not do that if you plan to -share your code with others (see *note Using Ghub in a Package::). If -you do omit AUTH, then the request is made on behalf of the ‘ghub’ -package, *regardless* of the symbol prefix of the function you use to do -so. - - All ‘FORGE-request’ and ‘FORGE-METHOD’ functions, including but not -limited to ‘ghub-METHOD’, are very simple wrappers around -‘ghub-request’. They take fewer arguments than ‘ghub-request’ and -instead pass constant values for the arguments METHOD and/or FORGE. - - -File: ghub.info, Node: Forge Limitations and Notes, Prev: Forge Functions and Variables, Up: Support for Other Forges - -7.2 Forge Limitations and Notes -=============================== - - • The token creation wizard is only available for ‘github’ forges, - because all other forges do not support using the API to create an - API token. As a consequence, if the user makes a request and the - necessary token cannot be found, then that results in an error. - Tokens can be created at: - - • Gitlab: - - • Bitbucket: - - - • Gitea: - - • Gogs: - - Also see *note Manually Creating and Storing a Token:: and *note - How Ghub uses Auth-Source::. - - • As mentioned in the previous node, the variables ‘gitea.host’ and - ‘gogs.host’ are not taken into account. - - • Gitea and Gogs do not support limiting a token to certain scopes. - - • The Bitbucket API is fairly broken. Some resources only work if a - slash is appended while others only work if no slash is appended. - I am unable to access any private repositories and some resources - don’t work for me at all. Also the API is only RESTish; pagination - information is part of the response body instead of the header. - Due to such issues it is possible that I will eventually have to - remove support for Bitbucket altogether. - - • The Gitlab API documentation is not always accurate, though I don’t - have an example at hand. It also isn’t structured well, making it - occationally difficult to find the information one is looking for. - - • Where one would use ‘user/repo’ when accessing another forge, one - has to use ‘user%2Frepo’ when accessing Gitlab, e.g.: - - (glab-get "/projects/python-mode-devs%2Fpython-mode") - - - -Tag Table: -Node: Top764 -Node: Introduction3280 -Node: Getting Started6322 -Node: Setting the Username10250 -Node: Interactively Creating and Storing a Token11675 -Node: Manually Creating and Storing a Token17326 -Node: How Ghub uses Auth-Source18551 -Node: Using Ghub in Personal Scripts20484 -Node: Using Ghub in a Package21940 -Node: API24558 -Node: Making Requests25355 -Node: Authentication39454 -Node: Configuration Variables41299 -Node: GraphQL Support45019 -Node: Support for Other Forges51684 -Node: Forge Functions and Variables51901 -Node: Forge Limitations and Notes56420 - -End Tag Table - - -Local Variables: -coding: utf-8 -End: diff --git a/elpa/ghub-20191007.1420/glab.el b/elpa/ghub-20191007.1420/glab.el deleted file mode 100644 index 8aec40e4..00000000 --- a/elpa/ghub-20191007.1420/glab.el +++ /dev/null @@ -1,155 +0,0 @@ -;;; glab.el --- minuscule client library for the Gitlab API -*- lexical-binding: t -*- - -;; Copyright (C) 2016-2019 Jonas Bernoulli - -;; Author: Jonas Bernoulli -;; Homepage: https://github.com/magit/ghub -;; Keywords: tools - -;; 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 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. - -;; For a copy of the GPL see https://www.gnu.org/licenses/gpl.txt. - -;;; Commentary: - -;; Glab is a library that provides basic support for using the Gitlab API -;; from Emacs packages. It abstracts access to API resources using only -;; a handful of functions that are not resource-specific. - -;; This library is implemented on top of Ghub. Unlike Ghub, Glab does -;; not support the guided creation of tokens because Gitlab lacks the -;; features that would be necessary to implement that. Users have to -;; create tokens through the web interface. - -;;; Code: - -(require 'ghub) - -(defconst glab-default-host "gitlab.com/api/v4" - "The default host that is used if `glab.host' is not set.") - -(cl-defun glab-head (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `HEAD' request for RESOURCE, with optional query PARAMS. -Like calling `ghub-request' (which see) with \"HEAD\" as METHOD -and `gitlab' as FORGE." - (ghub-request "HEAD" resource params :forge 'gitlab - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun glab-get (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `GET' request for RESOURCE, with optional query PARAMS. -Like calling `ghub-request' (which see) with \"GET\" as METHOD -and `gitlab' as FORGE." - (ghub-request "GET" resource params :forge 'gitlab - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun glab-put (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `PUT' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"PUT\" as METHOD -and `gitlab' as FORGE." - (ghub-request "PUT" resource params :forge 'gitlab - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun glab-post (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `POST' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"POST\" as METHOD -and `gitlab' as FORGE." - (ghub-request "POST" resource params :forge 'gitlab - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun glab-patch (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `PATCH' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"PATCH\" as METHOD -and `gitlab' as FORGE." - (ghub-request "PATCH" resource params :forge 'gitlab - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun glab-delete (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `DELETE' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"DELETE\" as METHOD -and `gitlab' as FORGE." - (ghub-request "DELETE" resource params :forge 'gitlab - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun glab-request (method resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a request for RESOURCE and return the response body. -Like calling `ghub-request' (which see) with `gitlab' as FORGE." - (ghub-request method resource params :forge 'gitlab - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun glab-repository-id (owner name &key username auth host) - "Return the id of the repository specified by OWNER, NAME and HOST." - (number-to-string - (cdr (assq 'id (glab-get (format "/projects/%s%%2F%s" - (replace-regexp-in-string "/" "%2F" owner) - name) - nil :username username :auth auth :host host))))) - -;;; _ -(provide 'glab) -;;; glab.el ends here diff --git a/elpa/ghub-20191007.1420/gogs.el b/elpa/ghub-20191007.1420/gogs.el deleted file mode 100644 index 7ce7fcdc..00000000 --- a/elpa/ghub-20191007.1420/gogs.el +++ /dev/null @@ -1,140 +0,0 @@ -;;; gogs.el --- minuscule client library for the Gogs API -*- lexical-binding: t -*- - -;; Copyright (C) 2016-2019 Jonas Bernoulli - -;; Author: Jonas Bernoulli -;; Homepage: https://github.com/magit/ghub -;; Keywords: tools - -;; 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 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. - -;; For a copy of the GPL see https://www.gnu.org/licenses/gpl.txt. - -;;; Commentary: - -;; Gogs is a library that provides basic support for using the Gogs API -;; from Emacs packages. It abstracts access to API resources using only -;; a handful of functions that are not resource-specific. - -;; This library is implemented on top of Ghub. Unlike Ghub, Gogs does -;; not support the guided creation of tokens because Gogs lacks the -;; features that would be necessary to implement that. Users have to -;; create tokens through the web interface. - -;;; Code: - -(require 'ghub) - -(defconst gogs-default-host "localhost:3000/api/v1" - "The default Gogs host.") - -;; HEAD does not appear to be supported. - -(cl-defun gogs-get (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `GET' request for RESOURCE, with optional query PARAMS. -Like calling `ghub-request' (which see) with \"GET\" as METHOD -and `gogs' as FORGE." - (ghub-request "GET" resource params :forge 'gogs - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun gogs-put (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `PUT' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"PUT\" as METHOD -and `gogs' as FORGE." - (ghub-request "PUT" resource params :forge 'gogs - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun gogs-post (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `POST' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"POST\" as METHOD -and `gogs' as FORGE." - (ghub-request "POST" resource params :forge 'gogs - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun gogs-patch (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `PATCH' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"PATCH\" as METHOD -and `gogs' as FORGE." - (ghub-request "PATCH" resource params :forge 'gogs - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun gogs-delete (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `DELETE' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"DELETE\" as METHOD -and `gogs' as FORGE." - (ghub-request "DELETE" resource params :forge 'gogs - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun gogs-request (method resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a request for RESOURCE and return the response body. -Like calling `ghub-request' (which see) with `gogs' as FORGE." - (ghub-request method resource params :forge 'gogs - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun gogs-repository-id (owner name &key username auth host) - "Return the id of the repository specified by OWNER, NAME and HOST." - (number-to-string - (cdr (assq 'id (gogs-get (format "/repos/%s/%s" owner name) - nil :username username :auth auth :host host))))) - -;;; _ -(provide 'gogs) -;;; gogs.el ends here diff --git a/elpa/ghub-20191007.1420/gsexp.el b/elpa/ghub-20191007.1420/gsexp.el deleted file mode 100644 index ced9dcfd..00000000 --- a/elpa/ghub-20191007.1420/gsexp.el +++ /dev/null @@ -1,94 +0,0 @@ -;;; gsexp.el --- GraphQl as S-expressions -*- lexical-binding: t -*- - -;; Copyright (C) 2016-2019 Jonas Bernoulli - -;; Author: Jonas Bernoulli -;; Homepage: https://github.com/magit/ghub -;; Keywords: tools - -;; 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 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. - -;; For a copy of the GPL see https://www.gnu.org/licenses/gpl.txt. - -;;; Commentary: - -;; This library encodes S-expressions as GraphQl documents. Currently -;; it is rather incomplete and only intended for use by `ghub-graphql' -;; but I might fill the gaps and add documentation eventually. I am -;; not in a hurry though. - -;;; Code: - -(require 'cl-lib) - -(defun gsexp-encode (document) - (gsexp--pp (gsexp--encode-field document))) - -(defun gsexp--encode-field (field) - (cond - ((stringp field) - field) - ((symbolp field) - (symbol-name field)) - ((listp (car field)) - (concat (format "%s: " (caar field)) - (gsexp--encode-field (cons (cadar field) - (cdr field))))) - (t - (concat (symbol-name (pop field)) - (and (vectorp (car field)) - (format " (\n%s)" - (mapconcat #'gsexp--encode-argument - (append (pop field) nil) - ",\n"))) - (and field - (format " {\n%s\n}" - (mapconcat #'gsexp--encode-field field "\n"))))))) - -(cl-defun gsexp--encode-argument ((argument value)) - (format "%s: %s" argument (gsexp--encode-value value))) - -(defun gsexp--encode-value (value) - (cond - ((numberp value) - (number-to-string value)) - ((symbolp value) ; including variables, enums, booleans and null - (symbol-name value)) - ((stringp value) - (prin1-to-string value)) - ((vectorp value) - (format "(%s)" (mapconcat #'gsexp--encode-value value ""))) - ((listp value) - (format "{%s}" (mapconcat - (pcase-lambda (`(,name ,value)) - (format "%s: %s" name (gsexp--encode-value value))) - value ", "))) - (t (error "Invalid field value: %S" value)))) - -(defun gsexp--pp (string) - (with-temp-buffer - (save-excursion - (insert string)) - (while (< (point) (point-max)) - (unless (and (bolp) (eolp)) - (save-excursion - (let ((level (car (syntax-ppss (point-at-bol))))) - (when (looking-at "\\s-*\\s)") - (cl-decf level)) - (indent-line-to (* 2 level))))) - (forward-line 1)) - (buffer-string))) - -;;; _ -(provide 'gsexp) -;;; gsexp.el ends here diff --git a/elpa/ghub-20191007.1420/gtea.el b/elpa/ghub-20191007.1420/gtea.el deleted file mode 100644 index 81223bd4..00000000 --- a/elpa/ghub-20191007.1420/gtea.el +++ /dev/null @@ -1,140 +0,0 @@ -;;; gtea.el --- minuscule client library for the Gitea API -*- lexical-binding: t -*- - -;; Copyright (C) 2016-2019 Jonas Bernoulli - -;; Author: Jonas Bernoulli -;; Homepage: https://github.com/magit/ghub -;; Keywords: tools - -;; 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 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. - -;; For a copy of the GPL see https://www.gnu.org/licenses/gpl.txt. - -;;; Commentary: - -;; Gtea is a library that provides basic support for using the Gitea API -;; from Emacs packages. It abstracts access to API resources using only -;; a handful of functions that are not resource-specific. - -;; This library is implemented on top of Ghub. Unlike Ghub, Gtea does -;; not support the guided creation of tokens because Gitea lacks the -;; features that would be necessary to implement that. Users have to -;; create tokens through the web interface. - -;;; Code: - -(require 'ghub) - -(defconst gtea-default-host "localhost:3000/api/v1" - "The default Gitea host.") - -;; HEAD does not appear to be supported. - -(cl-defun gtea-get (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `GET' request for RESOURCE, with optional query PARAMS. -Like calling `ghub-request' (which see) with \"GET\" as METHOD -and `gitea' as FORGE." - (ghub-request "GET" resource params :forge 'gitea - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun gtea-put (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `PUT' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"PUT\" as METHOD -and `gitea' as FORGE." - (ghub-request "PUT" resource params :forge 'gitea - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun gtea-post (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `POST' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"POST\" as METHOD -and `gitea' as FORGE." - (ghub-request "POST" resource params :forge 'gitea - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun gtea-patch (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `PATCH' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"PATCH\" as METHOD -and `gitea' as FORGE." - (ghub-request "PATCH" resource params :forge 'gitea - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun gtea-delete (resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a `DELETE' request for RESOURCE, with optional payload PARAMS. -Like calling `ghub-request' (which see) with \"DELETE\" as METHOD -and `gitea' as FORGE." - (ghub-request "DELETE" resource params :forge 'gitea - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun gtea-request (method resource &optional params - &key query payload headers - silent unpaginate noerror reader - username auth host - callback errorback extra) - "Make a request for RESOURCE and return the response body. -Like calling `ghub-request' (which see) with `gitea' as FORGE." - (ghub-request method resource params :forge 'gitea - :query query :payload payload :headers headers - :silent silent :unpaginate unpaginate - :noerror noerror :reader reader - :username username :auth auth :host host - :callback callback :errorback errorback :extra extra)) - -(cl-defun gtea-repository-id (owner name &key username auth host) - "Return the id of the repository specified by OWNER, NAME and HOST." - (number-to-string - (cdr (assq 'id (gtea-get (format "/repos/%s/%s" owner name) - nil :username username :auth auth :host host))))) - -;;; _ -(provide 'gtea) -;;; gtea.el ends here diff --git a/elpa/git-commit-20201222.1527/git-commit-autoloads.el b/elpa/git-commit-20201222.1527/git-commit-autoloads.el deleted file mode 100644 index d7f7c2ad..00000000 --- a/elpa/git-commit-20201222.1527/git-commit-autoloads.el +++ /dev/null @@ -1,52 +0,0 @@ -;;; git-commit-autoloads.el --- automatically extracted autoloads -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "git-commit" "git-commit.el" (0 0 0 0)) -;;; Generated autoloads from git-commit.el - -(defvar global-git-commit-mode t "\ -Non-nil if Global Git-Commit mode is enabled. -See the `global-git-commit-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `global-git-commit-mode'.") - -(custom-autoload 'global-git-commit-mode "git-commit" nil) - -(autoload 'global-git-commit-mode "git-commit" "\ -Edit Git commit messages. -This global mode arranges for `git-commit-setup' to be called -when a Git commit message file is opened. That usually happens -when Git uses the Emacsclient as $GIT_EDITOR to have the user -provide such a commit message. - -If called interactively, enable Global Git-Commit mode if ARG is -positive, and disable it if ARG is zero or negative. If called -from Lisp, also enable the mode if ARG is omitted or nil, and -toggle it if ARG is `toggle'; disable the mode otherwise. - -\(fn &optional ARG)" t nil) - -(defconst git-commit-filename-regexp "/\\(\\(\\(COMMIT\\|NOTES\\|PULLREQ\\|MERGEREQ\\|TAG\\)_EDIT\\|MERGE_\\|\\)MSG\\|\\(BRANCH\\|EDIT\\)_DESCRIPTION\\)\\'") - -(autoload 'git-commit-setup-check-buffer "git-commit" nil nil nil) - -(autoload 'git-commit-setup "git-commit" nil nil nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "git-commit" '("git-commit-"))) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; git-commit-autoloads.el ends here diff --git a/elpa/git-commit-20201222.1527/git-commit-pkg.el b/elpa/git-commit-20201222.1527/git-commit-pkg.el deleted file mode 100644 index b16ecb59..00000000 --- a/elpa/git-commit-20201222.1527/git-commit-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; Generated package description from /Users/andreas/.emacs.d/elpa/git-commit-20201222.1527/git-commit.el -*- no-byte-compile: t -*- -(define-package "git-commit" "20201222.1527" "Edit Git commit messages" '((emacs "25.1") (dash "20200524") (transient "20200601") (with-editor "20200522")) :commit "c5e11811197ef8c667a605e5d9dd8ec77247bd13" :keywords '("git" "tools" "vc") :maintainer '("Jonas Bernoulli" . "jonas@bernoul.li") :url "https://github.com/magit/magit") diff --git a/elpa/git-commit-20201222.1527/git-commit.el b/elpa/git-commit-20201222.1527/git-commit.el deleted file mode 100644 index fc147885..00000000 --- a/elpa/git-commit-20201222.1527/git-commit.el +++ /dev/null @@ -1,1025 +0,0 @@ -;;; git-commit.el --- Edit Git commit messages -*- lexical-binding: t; -*- - -;; Copyright (C) 2010-2020 The Magit Project Contributors -;; -;; You should have received a copy of the AUTHORS.md file which -;; lists all contributors. If not, see http://magit.vc/authors. - -;; Authors: Jonas Bernoulli -;; Sebastian Wiesner -;; Florian Ragwitz -;; Marius Vollmer -;; Maintainer: Jonas Bernoulli - -;; Package-Requires: ((emacs "25.1") (dash "20200524") (transient "20200601") (with-editor "20200522")) -;; Package-Version: 20201222.1527 -;; Package-Commit: c5e11811197ef8c667a605e5d9dd8ec77247bd13 -;; Keywords: git tools vc -;; Homepage: https://github.com/magit/magit - -;; 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 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 this file. If not, see . - -;;; Commentary: - -;; This package assists the user in writing good Git commit messages. - -;; While Git allows for the message to be provided on the command -;; line, it is preferable to tell Git to create the commit without -;; actually passing it a message. Git then invokes the `$GIT_EDITOR' -;; (or if that is undefined `$EDITOR') asking the user to provide the -;; message by editing the file ".git/COMMIT_EDITMSG" (or another file -;; in that directory, e.g. ".git/MERGE_MSG" for merge commits). - -;; When `global-git-commit-mode' is enabled, which it is by default, -;; then opening such a file causes the features described below, to -;; be enabled in that buffer. Normally this would be done using a -;; major-mode but to allow the use of any major-mode, as the user sees -;; fit, it is done here by running a setup function, which among other -;; things turns on the preferred major-mode, by default `text-mode'. - -;; Git waits for the `$EDITOR' to finish and then either creates the -;; commit using the contents of the file as commit message, or, if the -;; editor process exited with a non-zero exit status, aborts without -;; creating a commit. Unfortunately Emacsclient (which is what Emacs -;; users should be using as `$EDITOR' or at least as `$GIT_EDITOR') -;; does not differentiate between "successfully" editing a file and -;; aborting; not out of the box that is. - -;; By making use of the `with-editor' package this package provides -;; both ways of finish an editing session. In either case the file -;; is saved, but Emacseditor's exit code differs. -;; -;; C-c C-c Finish the editing session successfully by returning -;; with exit code 0. Git then creates the commit using -;; the message it finds in the file. -;; -;; C-c C-k Aborts the edit editing session by returning with exit -;; code 1. Git then aborts the commit. - -;; Aborting the commit does not cause the message to be lost, but -;; relying solely on the file not being tampered with is risky. This -;; package additionally stores all aborted messages for the duration -;; of the current session (i.e. until you close Emacs). To get back -;; an aborted message use M-p and M-n while editing a message. -;; -;; M-p Replace the buffer contents with the previous message -;; from the message ring. Of course only after storing -;; the current content there too. -;; -;; M-n Replace the buffer contents with the next message from -;; the message ring, after storing the current content. - -;; Some support for pseudo headers as used in some projects is -;; provided by these commands: -;; -;; C-c C-s Insert a Signed-off-by header. -;; C-c C-a Insert a Acked-by header. -;; C-c C-m Insert a Modified-by header. -;; C-c C-t Insert a Tested-by header. -;; C-c C-r Insert a Reviewed-by header. -;; C-c C-o Insert a Cc header. -;; C-c C-p Insert a Reported-by header. -;; C-c C-i Insert a Suggested-by header. - -;; When Git requests a commit message from the user, it does so by -;; having her edit a file which initially contains some comments, -;; instructing her what to do, and providing useful information, such -;; as which files were modified. These comments, even when left -;; intact by the user, do not become part of the commit message. This -;; package ensures these comments are propertizes as such and further -;; prettifies them by using different faces for various parts, such as -;; files. - -;; Finally this package highlights style errors, like lines that are -;; too long, or when the second line is not empty. It may even nag -;; you when you attempt to finish the commit without having fixed -;; these issues. The style checks and many other settings can easily -;; be configured: -;; -;; M-x customize-group RET git-commit RET - -;;; Code: -;;;; Dependencies - -(require 'dash) -(require 'log-edit) -(require 'magit-git nil t) -(require 'magit-utils nil t) -(require 'ring) -(require 'server) -(require 'transient) -(require 'with-editor) - -(eval-when-compile - (require 'recentf) - (require 'subr-x)) - -;;;; Declarations - -(defvar diff-default-read-only) -(defvar flyspell-generic-check-word-predicate) -(defvar font-lock-beg) -(defvar font-lock-end) - -(declare-function magit-completing-read "magit-utils" - (prompt collection &optional predicate require-match - initial-input hist def fallback)) -(declare-function magit-expand-git-file-name "magit-git" (filename)) -(declare-function magit-git-lines "magit-git" (&rest args)) -(declare-function magit-list-local-branch-names "magit-git" ()) -(declare-function magit-list-remote-branch-names "magit-git" - (&optional remote relative)) - -;;; Options -;;;; Variables - -(defgroup git-commit nil - "Edit Git commit messages." - :prefix "git-commit-" - :link '(info-link "(magit)Editing Commit Messages") - :group 'tools) - -;;;###autoload -(define-minor-mode global-git-commit-mode - "Edit Git commit messages. -This global mode arranges for `git-commit-setup' to be called -when a Git commit message file is opened. That usually happens -when Git uses the Emacsclient as $GIT_EDITOR to have the user -provide such a commit message." - :group 'git-commit - :type 'boolean - :global t - :init-value t - :initialize (lambda (symbol exp) - (custom-initialize-default symbol exp) - (when global-git-commit-mode - (add-hook 'find-file-hook 'git-commit-setup-check-buffer))) - (if global-git-commit-mode - (add-hook 'find-file-hook 'git-commit-setup-check-buffer) - (remove-hook 'find-file-hook 'git-commit-setup-check-buffer))) - -(defcustom git-commit-major-mode 'text-mode - "Major mode used to edit Git commit messages. -The major mode configured here is turned on by the minor mode -`git-commit-mode'." - :group 'git-commit - :type '(choice (function-item text-mode) - (function-item markdown-mode) - (function-item org-mode) - (function :tag "Another mode") - (const :tag "No major mode"))) - -(defcustom git-commit-setup-hook - '(git-commit-save-message - git-commit-setup-changelog-support - git-commit-turn-on-auto-fill - git-commit-propertize-diff - bug-reference-mode - with-editor-usage-message) - "Hook run at the end of `git-commit-setup'." - :group 'git-commit - :type 'hook - :get (and (featurep 'magit-utils) 'magit-hook-custom-get) - :options '(git-commit-save-message - git-commit-setup-changelog-support - magit-generate-changelog - git-commit-turn-on-auto-fill - git-commit-turn-on-flyspell - git-commit-propertize-diff - bug-reference-mode - with-editor-usage-message)) - -(defcustom git-commit-post-finish-hook nil - "Hook run after the user finished writing a commit message. - -\\\ -This hook is only run after pressing \\[with-editor-finish] in a buffer used -to edit a commit message. If a commit is created without the -user typing a message into a buffer, then this hook is not run. - -This hook is not run until the new commit has been created. If -doing so takes Git longer than one second, then this hook isn't -run at all. For certain commands such as `magit-rebase-continue' -this hook is never run because doing so would lead to a race -condition. - -This hook is only run if `magit' is available. - -Also see `magit-post-commit-hook'." - :group 'git-commit - :type 'hook - :get (and (featurep 'magit-utils) 'magit-hook-custom-get)) - -(defcustom git-commit-finish-query-functions - '(git-commit-check-style-conventions) - "List of functions called to query before performing commit. - -The commit message buffer is current while the functions are -called. If any of them returns nil, then the commit is not -performed and the buffer is not killed. The user should then -fix the issue and try again. - -The functions are called with one argument. If it is non-nil, -then that indicates that the user used a prefix argument to -force finishing the session despite issues. Functions should -usually honor this wish and return non-nil." - :options '(git-commit-check-style-conventions) - :type 'hook - :group 'git-commit) - -(defcustom git-commit-style-convention-checks '(non-empty-second-line) - "List of checks performed by `git-commit-check-style-conventions'. -Valid members are `non-empty-second-line' and `overlong-summary-line'. -That function is a member of `git-commit-finish-query-functions'." - :options '(non-empty-second-line overlong-summary-line) - :type '(list :convert-widget custom-hook-convert-widget) - :group 'git-commit) - -(defcustom git-commit-summary-max-length 68 - "Column beyond which characters in the summary lines are highlighted. - -The highlighting indicates that the summary is getting too long -by some standards. It does in no way imply that going over the -limit a few characters or in some cases even many characters is -anything that deserves shaming. It's just a friendly reminder -that if you can make the summary shorter, then you might want -to consider doing so." - :group 'git-commit - :safe 'numberp - :type 'number) - -(defcustom git-commit-fill-column nil - "Override `fill-column' in commit message buffers. - -If this is non-nil, then it should be an integer. If that is the -case and the buffer-local value of `fill-column' is not already -set by the time `git-commit-turn-on-auto-fill' is called as a -member of `git-commit-setup-hook', then that function sets the -buffer-local value of `fill-column' to the value of this option. - -This option exists mostly for historic reasons. If you are not -already using it, then you probably shouldn't start doing so." - :group 'git-commit - :safe 'numberp - :type '(choice (const :tag "use regular fill-column") - number)) - -(make-obsolete-variable 'git-commit-fill-column 'fill-column - "Magit 2.11.0" 'set) - -(defcustom git-commit-known-pseudo-headers - '("Signed-off-by" "Acked-by" "Modified-by" "Cc" - "Suggested-by" "Reported-by" "Tested-by" "Reviewed-by" - "Co-authored-by") - "A list of Git pseudo headers to be highlighted." - :group 'git-commit - :safe (lambda (val) (and (listp val) (-all-p 'stringp val))) - :type '(repeat string)) - -;;;; Faces - -(defgroup git-commit-faces nil - "Faces used for highlighting Git commit messages." - :prefix "git-commit-" - :group 'git-commit - :group 'faces) - -(defface git-commit-summary - '((t :inherit font-lock-type-face)) - "Face used for the summary in commit messages." - :group 'git-commit-faces) - -(defface git-commit-overlong-summary - '((t :inherit font-lock-warning-face)) - "Face used for the tail of overlong commit message summaries." - :group 'git-commit-faces) - -(defface git-commit-nonempty-second-line - '((t :inherit font-lock-warning-face)) - "Face used for non-whitespace on the second line of commit messages." - :group 'git-commit-faces) - -(defface git-commit-keyword - '((t :inherit font-lock-string-face)) - "Face used for keywords in commit messages. -In this context a \"keyword\" is text surrounded by brackets." - :group 'git-commit-faces) - -(define-obsolete-face-alias 'git-commit-note - 'git-commit-keyword "Git-Commit 3.0.0") - -(defface git-commit-pseudo-header - '((t :inherit font-lock-string-face)) - "Face used for pseudo headers in commit messages." - :group 'git-commit-faces) - -(defface git-commit-known-pseudo-header - '((t :inherit font-lock-keyword-face)) - "Face used for the keywords of known pseudo headers in commit messages." - :group 'git-commit-faces) - -(defface git-commit-comment-branch-local - (if (featurep 'magit) - '((t :inherit magit-branch-local)) - '((t :inherit font-lock-variable-name-face))) - "Face used for names of local branches in commit message comments." - :group 'git-commit-faces) - -(define-obsolete-face-alias 'git-commit-comment-branch - 'git-commit-comment-branch-local "Git-Commit 2.12.0") - -(defface git-commit-comment-branch-remote - (if (featurep 'magit) - '((t :inherit magit-branch-remote)) - '((t :inherit font-lock-variable-name-face))) - "Face used for names of remote branches in commit message comments. -This is only used if Magit is available." - :group 'git-commit-faces) - -(defface git-commit-comment-detached - '((t :inherit git-commit-comment-branch-local)) - "Face used for detached `HEAD' in commit message comments." - :group 'git-commit-faces) - -(defface git-commit-comment-heading - '((t :inherit git-commit-known-pseudo-header)) - "Face used for headings in commit message comments." - :group 'git-commit-faces) - -(defface git-commit-comment-file - '((t :inherit git-commit-pseudo-header)) - "Face used for file names in commit message comments." - :group 'git-commit-faces) - -(defface git-commit-comment-action - '((t :inherit bold)) - "Face used for actions in commit message comments." - :group 'git-commit-faces) - -;;; Keymap - -(defvar git-commit-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "M-p") 'git-commit-prev-message) - (define-key map (kbd "M-n") 'git-commit-next-message) - (define-key map (kbd "C-c C-i") 'git-commit-insert-pseudo-header) - (define-key map (kbd "C-c C-a") 'git-commit-ack) - (define-key map (kbd "C-c M-i") 'git-commit-suggested) - (define-key map (kbd "C-c C-m") 'git-commit-modified) - (define-key map (kbd "C-c C-o") 'git-commit-cc) - (define-key map (kbd "C-c C-p") 'git-commit-reported) - (define-key map (kbd "C-c C-r") 'git-commit-review) - (define-key map (kbd "C-c C-s") 'git-commit-signoff) - (define-key map (kbd "C-c C-t") 'git-commit-test) - (define-key map (kbd "C-c M-s") 'git-commit-save-message) - map) - "Key map used by `git-commit-mode'.") - -;;; Menu - -(require 'easymenu) -(easy-menu-define git-commit-mode-menu git-commit-mode-map - "Git Commit Mode Menu" - '("Commit" - ["Previous" git-commit-prev-message t] - ["Next" git-commit-next-message t] - "-" - ["Ack" git-commit-ack :active t - :help "Insert an 'Acked-by' header"] - ["Sign-Off" git-commit-signoff :active t - :help "Insert a 'Signed-off-by' header"] - ["Modified-by" git-commit-modified :active t - :help "Insert a 'Modified-by' header"] - ["Tested-by" git-commit-test :active t - :help "Insert a 'Tested-by' header"] - ["Reviewed-by" git-commit-review :active t - :help "Insert a 'Reviewed-by' header"] - ["CC" git-commit-cc t - :help "Insert a 'Cc' header"] - ["Reported" git-commit-reported :active t - :help "Insert a 'Reported-by' header"] - ["Suggested" git-commit-suggested t - :help "Insert a 'Suggested-by' header"] - ["Co-authored-by" git-commit-co-authored t - :help "Insert a 'Co-authored-by' header"] - "-" - ["Save" git-commit-save-message t] - ["Cancel" with-editor-cancel t] - ["Commit" with-editor-finish t])) - -;;; Hooks - -;;;###autoload -(defconst git-commit-filename-regexp "/\\(\ -\\(\\(COMMIT\\|NOTES\\|PULLREQ\\|MERGEREQ\\|TAG\\)_EDIT\\|MERGE_\\|\\)MSG\ -\\|\\(BRANCH\\|EDIT\\)_DESCRIPTION\\)\\'") - -(eval-after-load 'recentf - '(add-to-list 'recentf-exclude git-commit-filename-regexp)) - -(add-to-list 'with-editor-file-name-history-exclude git-commit-filename-regexp) - -(defun git-commit-setup-font-lock-in-buffer () - (and buffer-file-name - (string-match-p git-commit-filename-regexp buffer-file-name) - (git-commit-setup-font-lock))) - -(add-hook 'after-change-major-mode-hook 'git-commit-setup-font-lock-in-buffer) - -;;;###autoload -(defun git-commit-setup-check-buffer () - (and buffer-file-name - (string-match-p git-commit-filename-regexp buffer-file-name) - (git-commit-setup))) - -(defvar git-commit-mode) - -(defun git-commit-file-not-found () - ;; cygwin git will pass a cygwin path (/cygdrive/c/foo/.git/...), - ;; try to handle this in window-nt Emacs. - (--when-let - (and (or (string-match-p git-commit-filename-regexp buffer-file-name) - (and (boundp 'git-rebase-filename-regexp) - (string-match-p git-rebase-filename-regexp - buffer-file-name))) - (not (file-accessible-directory-p - (file-name-directory buffer-file-name))) - (if (require 'magit-git nil t) - ;; Emacs prepends a "c:". - (magit-expand-git-file-name (substring buffer-file-name 2)) - ;; Fallback if we can't load `magit-git'. - (and (string-match "\\`[a-z]:/\\(cygdrive/\\)?\\([a-z]\\)/\\(.*\\)" - buffer-file-name) - (concat (match-string 2 buffer-file-name) ":/" - (match-string 3 buffer-file-name))))) - (when (file-accessible-directory-p (file-name-directory it)) - (let ((inhibit-read-only t)) - (insert-file-contents it t) - t)))) - -(when (eq system-type 'windows-nt) - (add-hook 'find-file-not-found-functions #'git-commit-file-not-found)) - -(defconst git-commit-usage-message "\ -Type \\[with-editor-finish] to finish, \ -\\[with-editor-cancel] to cancel, and \ -\\[git-commit-prev-message] and \\[git-commit-next-message] \ -to recover older messages") - -;;;###autoload -(defun git-commit-setup () - (when (fboundp 'magit-toplevel) - ;; `magit-toplevel' is autoloaded and defined in magit-git.el, - ;; That library declares this functions without loading - ;; magit-process.el, which defines it. - (require 'magit-process nil t)) - ;; Pretend that git-commit-mode is a major-mode, - ;; so that directory-local settings can be used. - (let ((default-directory - (or (and (not (file-exists-p ".dir-locals.el")) - ;; When $GIT_DIR/.dir-locals.el doesn't exist, - ;; fallback to $GIT_WORK_TREE/.dir-locals.el, - ;; because the maintainer can use the latter - ;; to enforce conventions, while s/he has no - ;; control over the former. - (fboundp 'magit-toplevel) ; silence byte-compiler - (magit-toplevel)) - default-directory))) - (let ((buffer-file-name nil) ; trick hack-dir-local-variables - (major-mode 'git-commit-mode)) ; trick dir-locals-collect-variables - (hack-dir-local-variables) - (hack-local-variables-apply))) - (when git-commit-major-mode - (let ((auto-mode-alist (list (cons (concat "\\`" - (regexp-quote buffer-file-name) - "\\'") - git-commit-major-mode))) - ;; The major-mode hook might want to consult these minor - ;; modes, while the minor-mode hooks might want to consider - ;; the major mode. - (git-commit-mode t) - (with-editor-mode t)) - (normal-mode t))) - ;; Show our own message using our hook. - (setq with-editor-show-usage nil) - (setq with-editor-usage-message git-commit-usage-message) - (unless with-editor-mode - ;; Maybe already enabled when using `shell-command' or an Emacs shell. - (with-editor-mode 1)) - (add-hook 'with-editor-finish-query-functions - 'git-commit-finish-query-functions nil t) - (add-hook 'with-editor-pre-finish-hook - 'git-commit-save-message nil t) - (add-hook 'with-editor-pre-cancel-hook - 'git-commit-save-message nil t) - (when (and (fboundp 'magit-rev-parse) - (not (memq last-command - '(magit-sequencer-continue - magit-sequencer-skip - magit-am-continue - magit-am-skip - magit-rebase-continue - magit-rebase-skip)))) - (add-hook 'with-editor-post-finish-hook - (apply-partially 'git-commit-run-post-finish-hook - (magit-rev-parse "HEAD")) - nil t) - (when (fboundp 'magit-wip-maybe-add-commit-hook) - (magit-wip-maybe-add-commit-hook))) - (setq with-editor-cancel-message - 'git-commit-cancel-message) - (make-local-variable 'log-edit-comment-ring-index) - (git-commit-mode 1) - (git-commit-setup-font-lock) - (when (boundp 'save-place) - (setq save-place nil)) - (save-excursion - (goto-char (point-min)) - (when (looking-at "\\`\\(\\'\\|\n[^\n]\\)") - (open-line 1))) - (with-demoted-errors "Error running git-commit-setup-hook: %S" - (run-hooks 'git-commit-setup-hook)) - (set-buffer-modified-p nil)) - -(defun git-commit-run-post-finish-hook (previous) - (when (and git-commit-post-finish-hook - (require 'magit nil t) - (fboundp 'magit-rev-parse)) - (cl-block nil - (let ((break (time-add (current-time) - (seconds-to-time 1)))) - (while (equal (magit-rev-parse "HEAD") previous) - (if (time-less-p (current-time) break) - (sit-for 0.01) - (message "No commit created after 1 second. Not running %s." - 'git-commit-post-finish-hook) - (cl-return)))) - (run-hooks 'git-commit-post-finish-hook)))) - -(define-minor-mode git-commit-mode - "Auxiliary minor mode used when editing Git commit messages. -This mode is only responsible for setting up some key bindings. -Don't use it directly, instead enable `global-git-commit-mode'." - :lighter "") - -(put 'git-commit-mode 'permanent-local t) - -(defun git-commit-setup-changelog-support () - "Treat ChangeLog entries as unindented paragraphs." - (when (fboundp 'log-indent-fill-entry) ; New in Emacs 27. - (setq-local fill-paragraph-function #'log-indent-fill-entry)) - (setq-local fill-indent-according-to-mode t) - (setq-local paragraph-start (concat paragraph-start "\\|\\*\\|("))) - -(defun git-commit-turn-on-auto-fill () - "Unconditionally turn on Auto Fill mode. -If `git-commit-fill-column' is non-nil, and `fill-column' -doesn't already have a buffer-local value, then set that -to `git-commit-fill-column'." - (when (and (numberp git-commit-fill-column) - (not (local-variable-p 'fill-column))) - (setq fill-column git-commit-fill-column)) - (setq-local comment-auto-fill-only-comments nil) - (turn-on-auto-fill)) - -(defun git-commit-turn-on-flyspell () - "Unconditionally turn on Flyspell mode. -Also prevent comments from being checked and -finally check current non-comment text." - (require 'flyspell) - (turn-on-flyspell) - (setq flyspell-generic-check-word-predicate - 'git-commit-flyspell-verify) - (let ((end) - (comment-start-regex (format "^\\(%s\\|$\\)" comment-start))) - (save-excursion - (goto-char (point-max)) - (while (and (not (bobp)) (looking-at comment-start-regex)) - (forward-line -1)) - (unless (looking-at comment-start-regex) - (forward-line)) - (setq end (point))) - (flyspell-region (point-min) end))) - -(defun git-commit-flyspell-verify () - (not (= (char-after (line-beginning-position)) - (aref comment-start 0)))) - -(defun git-commit-finish-query-functions (force) - (run-hook-with-args-until-failure - 'git-commit-finish-query-functions force)) - -(defun git-commit-check-style-conventions (force) - "Check for violations of certain basic style conventions. - -For each violation ask the user if she wants to proceed anyway. -Option `git-commit-check-style-conventions' controls which -conventions are checked." - (or force - (save-excursion - (goto-char (point-min)) - (re-search-forward (git-commit-summary-regexp) nil t) - (if (equal (match-string 1) "") - t ; Just try; we don't know whether --allow-empty-message was used. - (and (or (not (memq 'overlong-summary-line - git-commit-style-convention-checks)) - (equal (match-string 2) "") - (y-or-n-p "Summary line is too long. Commit anyway? ")) - (or (not (memq 'non-empty-second-line - git-commit-style-convention-checks)) - (not (match-string 3)) - (y-or-n-p "Second line is not empty. Commit anyway? "))))))) - -(defun git-commit-cancel-message () - (message - (concat "Commit canceled" - (and (memq 'git-commit-save-message with-editor-pre-cancel-hook) - ". Message saved to `log-edit-comment-ring'")))) - -;;; History - -(defun git-commit-prev-message (arg) - "Cycle backward through message history, after saving current message. -With a numeric prefix ARG, go back ARG comments." - (interactive "*p") - (when (and (git-commit-save-message) (> arg 0)) - (setq log-edit-comment-ring-index - (log-edit-new-comment-index - arg (ring-length log-edit-comment-ring)))) - (save-restriction - (goto-char (point-min)) - (narrow-to-region (point) - (if (re-search-forward (concat "^" comment-start) nil t) - (max 1 (- (point) 2)) - (point-max))) - (log-edit-previous-comment arg))) - -(defun git-commit-next-message (arg) - "Cycle forward through message history, after saving current message. -With a numeric prefix ARG, go forward ARG comments." - (interactive "*p") - (git-commit-prev-message (- arg))) - -(defun git-commit-save-message () - "Save current message to `log-edit-comment-ring'." - (interactive) - (when-let ((message (git-commit-buffer-message))) - (when-let ((index (ring-member log-edit-comment-ring message))) - (ring-remove log-edit-comment-ring index)) - (ring-insert log-edit-comment-ring message))) - -(defun git-commit-buffer-message () - (let ((flush (concat "^" comment-start)) - (str (buffer-substring-no-properties (point-min) (point-max)))) - (with-temp-buffer - (insert str) - (goto-char (point-min)) - (when (re-search-forward (concat flush " -+ >8 -+$") nil t) - (delete-region (point-at-bol) (point-max))) - (goto-char (point-min)) - (flush-lines flush) - (goto-char (point-max)) - (unless (eq (char-before) ?\n) - (insert ?\n)) - (setq str (buffer-string))) - (unless (string-match "\\`[ \t\n\r]*\\'" str) - (when (string-match "\\`\n\\{2,\\}" str) - (setq str (replace-match "\n" t t str))) - (when (string-match "\n\\{2,\\}\\'" str) - (setq str (replace-match "\n" t t str))) - str))) - -;;; Headers - -(transient-define-prefix git-commit-insert-pseudo-header () - "Insert a commit message pseudo header." - [["Insert ... by yourself" - ("a" "Ack" git-commit-ack) - ("m" "Modified" git-commit-modified) - ("r" "Reviewed" git-commit-review) - ("s" "Signed-off" git-commit-signoff) - ("t" "Tested" git-commit-test)] - ["Insert ... by someone" - ("C-c" "Cc" git-commit-cc) - ("C-r" "Reported" git-commit-reported) - ("C-i" "Suggested" git-commit-suggested) - ("C-a" "Co-authored" git-commit-co-authored)]]) - -(defun git-commit-ack (name mail) - "Insert a header acknowledging that you have looked at the commit." - (interactive (git-commit-self-ident)) - (git-commit-insert-header "Acked-by" name mail)) - -(defun git-commit-modified (name mail) - "Insert a header to signal that you have modified the commit." - (interactive (git-commit-self-ident)) - (git-commit-insert-header "Modified-by" name mail)) - -(defun git-commit-review (name mail) - "Insert a header acknowledging that you have reviewed the commit." - (interactive (git-commit-self-ident)) - (git-commit-insert-header "Reviewed-by" name mail)) - -(defun git-commit-signoff (name mail) - "Insert a header to sign off the commit." - (interactive (git-commit-self-ident)) - (git-commit-insert-header "Signed-off-by" name mail)) - -(defun git-commit-test (name mail) - "Insert a header acknowledging that you have tested the commit." - (interactive (git-commit-self-ident)) - (git-commit-insert-header "Tested-by" name mail)) - -(defun git-commit-cc (name mail) - "Insert a header mentioning someone who might be interested." - (interactive (git-commit-read-ident "Cc")) - (git-commit-insert-header "Cc" name mail)) - -(defun git-commit-reported (name mail) - "Insert a header mentioning the person who reported the issue." - (interactive (git-commit-read-ident "Reported-by")) - (git-commit-insert-header "Reported-by" name mail)) - -(defun git-commit-suggested (name mail) - "Insert a header mentioning the person who suggested the change." - (interactive (git-commit-read-ident "Suggested-by")) - (git-commit-insert-header "Suggested-by" name mail)) - -(defun git-commit-co-authored (name mail) - "Insert a header mentioning the person who co-authored the commit." - (interactive (git-commit-read-ident "Co-authored-by")) - (git-commit-insert-header "Co-authored-by" name mail)) - -(defun git-commit-self-ident () - (list (or (getenv "GIT_AUTHOR_NAME") - (getenv "GIT_COMMITTER_NAME") - (ignore-errors (car (process-lines "git" "config" "user.name"))) - user-full-name - (read-string "Name: ")) - (or (getenv "GIT_AUTHOR_EMAIL") - (getenv "GIT_COMMITTER_EMAIL") - (getenv "EMAIL") - (ignore-errors (car (process-lines "git" "config" "user.email"))) - (read-string "Email: ")))) - -(defvar git-commit-read-ident-history nil) - -(defun git-commit-read-ident (prompt) - (if (require 'magit-git nil t) - (let ((str (magit-completing-read - prompt - (sort (delete-dups - (magit-git-lines "log" "-n9999" "--format=%aN <%ae>")) - 'string<) - nil nil nil 'git-commit-read-ident-history))) - (save-match-data - (if (string-match "\\`\\([^<]+\\) *<\\([^>]+\\)>\\'" str) - (list (save-match-data (string-trim (match-string 1 str))) - (string-trim (match-string 2 str))) - (user-error "Invalid input")))) - (list (read-string "Name: ") - (read-string "Email: ")))) - -(defun git-commit-insert-header (header name email) - (setq header (format "%s: %s <%s>" header name email)) - (save-excursion - (goto-char (point-max)) - (cond ((re-search-backward "^[-a-zA-Z]+: [^<]+? <[^>]+>" nil t) - (end-of-line) - (insert ?\n header) - (unless (= (char-after) ?\n) - (insert ?\n))) - (t - (while (re-search-backward (concat "^" comment-start) nil t)) - (unless (looking-back "\n\n" nil) - (insert ?\n)) - (insert header ?\n))) - (unless (or (eobp) (= (char-after) ?\n)) - (insert ?\n)))) - -;;; Font-Lock - -(defvar-local git-commit-need-summary-line t - "Whether the text should have a heading that is separated from the body. - -For commit messages that is a convention that should not -be violated. For notes it is up to the user. If you do -not want to insist on an empty second line here, then use -something like: - - (add-hook \\='git-commit-setup-hook - (lambda () - (when (equal (file-name-nondirectory (buffer-file-name)) - \"NOTES_EDITMSG\") - (setq git-commit-need-summary-line nil))))") - -(defun git-commit-summary-regexp () - (if git-commit-need-summary-line - (concat - ;; Leading empty lines and comments - (format "\\`\\(?:^\\(?:\\s-*\\|%s.*\\)\n\\)*" comment-start) - ;; Summary line - (format "\\(.\\{0,%d\\}\\)\\(.*\\)" git-commit-summary-max-length) - ;; Non-empty non-comment second line - (format "\\(?:\n%s\\|\n\\(.+\\)\\)?" comment-start)) - "\\(EASTER\\) \\(EGG\\)")) - -(defun git-commit-extend-region-summary-line () - "Identify the multiline summary-regexp construct. -Added to `font-lock-extend-region-functions'." - (save-excursion - (save-match-data - (goto-char (point-min)) - (when (looking-at (git-commit-summary-regexp)) - (let ((summary-beg (match-beginning 0)) - (summary-end (match-end 0))) - (when (or (< summary-beg font-lock-beg summary-end) - (< summary-beg font-lock-end summary-end)) - (setq font-lock-beg (min font-lock-beg summary-beg)) - (setq font-lock-end (max font-lock-end summary-end)))))))) - -(defvar-local git-commit--branch-name-regexp nil) - -(defconst git-commit-comment-headings - '("Changes to be committed:" - "Untracked files:" - "Changed but not updated:" - "Changes not staged for commit:" - "Unmerged paths:" - "Author:" - "Date:")) - -(defconst git-commit-font-lock-keywords-1 - '(;; Pseudo headers - (eval . `(,(format "^\\(%s:\\)\\( .*\\)" - (regexp-opt git-commit-known-pseudo-headers)) - (1 'git-commit-known-pseudo-header) - (2 'git-commit-pseudo-header))) - ("^[-a-zA-Z]+: [^<]+? <[^>]+>" - (0 'git-commit-pseudo-header)) - ;; Summary - (eval . `(,(git-commit-summary-regexp) - (1 'git-commit-summary))) - ;; - Keyword [aka "text in brackets"] (overrides summary) - ("\\[.+?\\]" - (0 'git-commit-keyword t)) - ;; - Non-empty second line (overrides summary and note) - (eval . `(,(git-commit-summary-regexp) - (2 'git-commit-overlong-summary t t) - (3 'git-commit-nonempty-second-line t t))))) - -(defconst git-commit-font-lock-keywords-2 - `(,@git-commit-font-lock-keywords-1 - ;; Comments - (eval . `(,(format "^%s.*" comment-start) - (0 'font-lock-comment-face append))) - (eval . `(,(format "^%s On branch \\(.*\\)" comment-start) - (1 'git-commit-comment-branch-local t))) - (eval . `(,(format "^%s \\(HEAD\\) detached at" comment-start) - (1 'git-commit-comment-detached t))) - (eval . `(,(format "^%s %s" comment-start - (regexp-opt git-commit-comment-headings t)) - (1 'git-commit-comment-heading t))) - (eval . `(,(format "^%s\t\\(?:\\([^:\n]+\\):\\s-+\\)?\\(.*\\)" comment-start) - (1 'git-commit-comment-action t t) - (2 'git-commit-comment-file t))))) - -(defconst git-commit-font-lock-keywords-3 - `(,@git-commit-font-lock-keywords-2 - ;; More comments - (eval - ;; Your branch is ahead of 'master' by 3 commits. - ;; Your branch is behind 'master' by 2 commits, and can be fast-forwarded. - . `(,(format - "^%s Your branch is \\(?:ahead\\|behind\\) of '%s' by \\([0-9]*\\)" - comment-start git-commit--branch-name-regexp) - (1 'git-commit-comment-branch-local t) - (2 'git-commit-comment-branch-remote t) - (3 'bold t))) - (eval - ;; Your branch is up to date with 'master'. - ;; Your branch and 'master' have diverged, - . `(,(format - "^%s Your branch \\(?:is up-to-date with\\|and\\) '%s'" - comment-start git-commit--branch-name-regexp) - (1 'git-commit-comment-branch-local t) - (2 'git-commit-comment-branch-remote t))) - (eval - ;; and have 1 and 2 different commits each, respectively. - . `(,(format - "^%s and have \\([0-9]*\\) and \\([0-9]*\\) commits each" - comment-start) - (1 'bold t) - (2 'bold t))))) - -(defvar git-commit-font-lock-keywords git-commit-font-lock-keywords-2 - "Font-Lock keywords for Git-Commit mode.") - -(defun git-commit-setup-font-lock () - (let ((table (make-syntax-table (syntax-table)))) - (when comment-start - (modify-syntax-entry (string-to-char comment-start) "." table)) - (modify-syntax-entry ?# "." table) - (modify-syntax-entry ?\" "." table) - (modify-syntax-entry ?\' "." table) - (modify-syntax-entry ?` "." table) - (set-syntax-table table)) - (setq-local comment-start - (or (with-temp-buffer - (call-process "git" nil (current-buffer) nil - "config" "core.commentchar") - (unless (bobp) - (goto-char (point-min)) - (buffer-substring (point) (line-end-position)))) - "#")) - (setq-local comment-start-skip (format "^%s+[\s\t]*" comment-start)) - (setq-local comment-end-skip "\n") - (setq-local comment-use-syntax nil) - (setq-local git-commit--branch-name-regexp - (if (and (featurep 'magit-git) - ;; When using cygwin git, we may end up in a - ;; non-existing directory, which would cause - ;; any git calls to signal an error. - (file-accessible-directory-p default-directory)) - (progn - ;; Make sure the below functions are available. - (require 'magit) - ;; Font-Lock wants every submatch to succeed, - ;; so also match the empty string. Do not use - ;; `regexp-quote' because that is slow if there - ;; are thousands of branches outweighing the - ;; benefit of an efficient regep. - (format "\\(\\(?:%s\\)\\|\\)\\(\\(?:%s\\)\\|\\)" - (mapconcat #'identity - (magit-list-local-branch-names) - "\\|") - (mapconcat #'identity - (magit-list-remote-branch-names) - "\\|"))) - "\\([^']*\\)")) - (setq-local font-lock-multiline t) - (add-hook 'font-lock-extend-region-functions - #'git-commit-extend-region-summary-line - t t) - (font-lock-add-keywords nil git-commit-font-lock-keywords)) - -(defun git-commit-propertize-diff () - (require 'diff-mode) - (save-excursion - (goto-char (point-min)) - (when (re-search-forward "^diff --git" nil t) - (beginning-of-line) - (let ((buffer (current-buffer))) - (insert - (with-temp-buffer - (insert - (with-current-buffer buffer - (prog1 (buffer-substring-no-properties (point) (point-max)) - (delete-region (point) (point-max))))) - (let ((diff-default-read-only nil)) - (diff-mode)) - (let (font-lock-verbose font-lock-support-mode) - (if (fboundp 'font-lock-ensure) - (font-lock-ensure) - (with-no-warnings - (font-lock-fontify-buffer)))) - (let (next (pos (point-min))) - (while (setq next (next-single-property-change pos 'face)) - (put-text-property pos next 'font-lock-face - (get-text-property pos 'face)) - (setq pos next)) - (put-text-property pos (point-max) 'font-lock-face - (get-text-property pos 'face))) - (buffer-string))))))) - -;;; Elisp Text Mode - -(define-derived-mode git-commit-elisp-text-mode text-mode "ElText" - "Major mode for editing commit messages of elisp projects. -This is intended for use as `git-commit-major-mode' for projects -that expect `symbols' to look like this. I.e. like they look in -Elisp doc-strings, including this one. Unlike in doc-strings, -\"strings\" also look different than the other text." - (setq font-lock-defaults '(git-commit-elisp-text-mode-keywords))) - -(defvar git-commit-elisp-text-mode-keywords - `((,(concat "[`‘]\\(" lisp-mode-symbol-regexp "\\)['’]") - (1 font-lock-constant-face prepend)) - ("\"[^\"]*\"" (0 font-lock-string-face prepend)))) - -;;; _ -(provide 'git-commit) -;;; git-commit.el ends here diff --git a/elpa/git-commit-20220130.2254/git-commit-autoloads.el b/elpa/git-commit-20230103.2224/git-commit-autoloads.el similarity index 85% rename from elpa/git-commit-20220130.2254/git-commit-autoloads.el rename to elpa/git-commit-20230103.2224/git-commit-autoloads.el index 82dd69dd..a194e2bb 100644 --- a/elpa/git-commit-20220130.2254/git-commit-autoloads.el +++ b/elpa/git-commit-20230103.2224/git-commit-autoloads.el @@ -1,4 +1,4 @@ -;;; git-commit-autoloads.el --- automatically extracted autoloads +;;; git-commit-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- ;; ;;; Code: @@ -16,7 +16,7 @@ fundamental-mode git-commit-elisp-text-mode)))) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "git-commit" '("git-commit-" "global-git-commit-mode"))) +(register-definition-prefixes "git-commit" '("git-commit-" "global-git-commit-mode")) ;;;*** diff --git a/elpa/git-commit-20220130.2254/git-commit-pkg.el b/elpa/git-commit-20230103.2224/git-commit-pkg.el similarity index 75% rename from elpa/git-commit-20220130.2254/git-commit-pkg.el rename to elpa/git-commit-20230103.2224/git-commit-pkg.el index 39d93df1..51fa86db 100644 --- a/elpa/git-commit-20220130.2254/git-commit-pkg.el +++ b/elpa/git-commit-20230103.2224/git-commit-pkg.el @@ -1,8 +1,9 @@ -(define-package "git-commit" "20220130.2254" "Edit Git commit messages." +(define-package "git-commit" "20230103.2224" "Edit Git commit messages." '((emacs "25.1") + (compat "28.1.1.2") (transient "20210920") (with-editor "20211001")) - :commit "bab9257d7e859567fa6648f3085f1de17963d4fd" :authors + :commit "f47b68929f01a1b8299f3160b0ab02d69d59fcb7" :authors '(("Jonas Bernoulli" . "jonas@bernoul.li") ("Sebastian Wiesner" . "lunaryorn@gmail.com") ("Florian Ragwitz" . "rafl@debian.org") diff --git a/elpa/git-commit-20220130.2254/git-commit.el b/elpa/git-commit-20230103.2224/git-commit.el similarity index 82% rename from elpa/git-commit-20220130.2254/git-commit.el rename to elpa/git-commit-20230103.2224/git-commit.el index faca0157..2c90a6f4 100644 --- a/elpa/git-commit-20220130.2254/git-commit.el +++ b/elpa/git-commit-20230103.2224/git-commit.el @@ -1,34 +1,40 @@ -;;; git-commit.el --- Edit Git commit messages -*- lexical-binding: t; -*- +;;; git-commit.el --- Edit Git commit messages -*- lexical-binding:t; coding:utf-8 -*- -;; Copyright (C) 2010-2022 The Magit Project Contributors -;; -;; You should have received a copy of the AUTHORS.md file which -;; lists all contributors. If not, see http://magit.vc/authors. +;; Copyright (C) 2008-2023 The Magit Project Contributors ;; Author: Jonas Bernoulli -;; Sebastian Wiesner -;; Florian Ragwitz -;; Marius Vollmer +;; Sebastian Wiesner +;; Florian Ragwitz +;; Marius Vollmer ;; Maintainer: Jonas Bernoulli -;; Keywords: git tools vc ;; Homepage: https://github.com/magit/magit -;; Package-Requires: ((emacs "25.1") (transient "0.3.6") (with-editor "3.0.5")) -;; Package-Version: 3.3.0-git +;; Keywords: git tools vc + +;; Package-Version: 3.3.0.50-git +;; Package-Requires: ( +;; (emacs "25.1") +;; (compat "28.1.1.2") +;; (transient "0.3.6") +;; (with-editor "3.0.5")) + ;; SPDX-License-Identifier: GPL-3.0-or-later -;; 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. +;; Magit 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 file is distributed in the hope that it will be useful, +;; Magit 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 file. If not, see . +;; along with Magit. If not, see . + +;; You should have received a copy of the AUTHORS.md file, which +;; lists all contributors. If not, see https://magit.vc/authors. ;;; Commentary: @@ -110,15 +116,10 @@ ;; M-x customize-group RET git-commit RET ;;; Code: -;;;; Dependencies (require 'seq) (require 'subr-x) -(require 'magit-git nil t) -(require 'magit-mode nil t) -(require 'magit-utils nil t) - (require 'log-edit) (require 'ring) (require 'rx) @@ -126,23 +127,22 @@ (require 'transient) (require 'with-editor) -(defvar recentf-exclude) - -;;;; Declarations +;; For historic reasons Magit isn't a hard dependency. +(unless (and (require 'magit-base nil t) + (require 'magit-git nil t)) + (declare-function magit-completing-read "magit-base" + ( prompt collection &optional predicate require-match + initial-input hist def fallback)) + (declare-function magit-expand-git-file-name "magit-git" (filename)) + (declare-function magit-git-lines "magit-git" (&rest args)) + (declare-function magit-hook-custom-get "magit-base" (symbol)) + (declare-function magit-list-local-branch-names "magit-git" ())) (defvar diff-default-read-only) (defvar flyspell-generic-check-word-predicate) (defvar font-lock-beg) (defvar font-lock-end) - -(declare-function magit-completing-read "magit-utils" - (prompt collection &optional predicate require-match - initial-input hist def fallback)) -(declare-function magit-expand-git-file-name "magit-git" (filename)) -(declare-function magit-git-lines "magit-git" (&rest args)) -(declare-function magit-list-local-branch-names "magit-git" ()) -(declare-function magit-list-remote-branch-names "magit-git" - (&optional remote relative)) +(defvar recentf-exclude) ;;; Options ;;;; Variables @@ -175,12 +175,12 @@ full loading." :initialize (lambda (symbol exp) (custom-initialize-default symbol exp) (when global-git-commit-mode - (add-hook 'find-file-hook 'git-commit-setup-check-buffer))) + (add-hook 'find-file-hook #'git-commit-setup-check-buffer))) (if global-git-commit-mode - (add-hook 'find-file-hook 'git-commit-setup-check-buffer) - (remove-hook 'find-file-hook 'git-commit-setup-check-buffer))) + (add-hook 'find-file-hook #'git-commit-setup-check-buffer) + (remove-hook 'find-file-hook #'git-commit-setup-check-buffer))) -(defcustom git-commit-major-mode 'text-mode +(defcustom git-commit-major-mode #'text-mode "Major mode used to edit Git commit messages. The major mode configured here is turned on by the minor mode `git-commit-mode'." @@ -210,7 +210,7 @@ The major mode configured here is turned on by the minor mode "Hook run at the end of `git-commit-setup'." :group 'git-commit :type 'hook - :get (and (featurep 'magit-utils) 'magit-hook-custom-get) + :get (and (featurep 'magit-base) #'magit-hook-custom-get) :options '(git-commit-save-message git-commit-setup-changelog-support magit-generate-changelog @@ -230,17 +230,28 @@ to edit a commit message. If a commit is created without the user typing a message into a buffer, then this hook is not run. This hook is not run until the new commit has been created. If -doing so takes Git longer than one second, then this hook isn't -run at all. For certain commands such as `magit-rebase-continue' -this hook is never run because doing so would lead to a race -condition. +that takes Git longer than `git-commit-post-finish-hook-timeout' +seconds, then this hook isn't run at all. For certain commands +such as `magit-rebase-continue' this hook is never run because +doing so would lead to a race condition. This hook is only run if `magit' is available. Also see `magit-post-commit-hook'." :group 'git-commit :type 'hook - :get (and (featurep 'magit-utils) 'magit-hook-custom-get)) + :get (and (featurep 'magit-base) #'magit-hook-custom-get)) + +(defcustom git-commit-post-finish-hook-timeout 1 + "Time in seconds to wait for git to create a commit. + +The hook `git-commit-post-finish-hook' (which see) is run only +after git is done creating a commit. If it takes longer than +`git-commit-post-finish-hook-timeout' seconds to create the +commit, then the hook is not run at all." + :group 'git-commit + :safe 'numberp + :type 'number) (defcustom git-commit-finish-query-functions '(git-commit-check-style-conventions) @@ -302,7 +313,7 @@ already using it, then you probably shouldn't start doing so." (defcustom git-commit-known-pseudo-headers '("Signed-off-by" "Acked-by" "Modified-by" "Cc" "Suggested-by" "Reported-by" "Tested-by" "Reviewed-by" - "Co-authored-by") + "Co-authored-by" "Co-developed-by") "A list of Git pseudo headers to be highlighted." :group 'git-commit :safe (lambda (val) (and (listp val) (seq-every-p #'stringp val))) @@ -402,20 +413,20 @@ This is only used if Magit is available." (defvar git-commit-mode-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "M-p") 'git-commit-prev-message) - (define-key map (kbd "M-n") 'git-commit-next-message) - (define-key map (kbd "C-c M-p") 'git-commit-search-message-backward) - (define-key map (kbd "C-c M-n") 'git-commit-search-message-forward) - (define-key map (kbd "C-c C-i") 'git-commit-insert-pseudo-header) - (define-key map (kbd "C-c C-a") 'git-commit-ack) - (define-key map (kbd "C-c M-i") 'git-commit-suggested) - (define-key map (kbd "C-c C-m") 'git-commit-modified) - (define-key map (kbd "C-c C-o") 'git-commit-cc) - (define-key map (kbd "C-c C-p") 'git-commit-reported) - (define-key map (kbd "C-c C-r") 'git-commit-review) - (define-key map (kbd "C-c C-s") 'git-commit-signoff) - (define-key map (kbd "C-c C-t") 'git-commit-test) - (define-key map (kbd "C-c M-s") 'git-commit-save-message) + (define-key map (kbd "M-p") #'git-commit-prev-message) + (define-key map (kbd "M-n") #'git-commit-next-message) + (define-key map (kbd "C-c M-p") #'git-commit-search-message-backward) + (define-key map (kbd "C-c M-n") #'git-commit-search-message-forward) + (define-key map (kbd "C-c C-i") #'git-commit-insert-pseudo-header) + (define-key map (kbd "C-c C-a") #'git-commit-ack) + (define-key map (kbd "C-c M-i") #'git-commit-suggested) + (define-key map (kbd "C-c C-m") #'git-commit-modified) + (define-key map (kbd "C-c C-o") #'git-commit-cc) + (define-key map (kbd "C-c C-p") #'git-commit-reported) + (define-key map (kbd "C-c C-r") #'git-commit-review) + (define-key map (kbd "C-c C-s") #'git-commit-signoff) + (define-key map (kbd "C-c C-t") #'git-commit-test) + (define-key map (kbd "C-c M-s") #'git-commit-save-message) map) "Key map used by `git-commit-mode'.") @@ -446,6 +457,8 @@ This is only used if Magit is available." :help "Insert a 'Suggested-by' header"] ["Co-authored-by" git-commit-co-authored t :help "Insert a 'Co-authored-by' header"] + ["Co-developed-by" git-commit-co-developed t + :help "Insert a 'Co-developed-by' header"] "-" ["Save" git-commit-save-message t] ["Cancel" with-editor-cancel t] @@ -467,7 +480,7 @@ This is only used if Magit is available." (string-match-p git-commit-filename-regexp buffer-file-name) (git-commit-setup-font-lock))) -(add-hook 'after-change-major-mode-hook 'git-commit-setup-font-lock-in-buffer) +(add-hook 'after-change-major-mode-hook #'git-commit-setup-font-lock-in-buffer) (defun git-commit-setup-check-buffer () (and buffer-file-name @@ -531,15 +544,15 @@ to recover older messages") ;; Pretend that git-commit-mode is a major-mode, ;; so that directory-local settings can be used. (let ((default-directory - (or (and (not (file-exists-p ".dir-locals.el")) - ;; When $GIT_DIR/.dir-locals.el doesn't exist, - ;; fallback to $GIT_WORK_TREE/.dir-locals.el, - ;; because the maintainer can use the latter - ;; to enforce conventions, while s/he has no - ;; control over the former. - (fboundp 'magit-toplevel) ; silence byte-compiler - (magit-toplevel)) - default-directory))) + (or (and (not (file-exists-p ".dir-locals.el")) + ;; When $GIT_DIR/.dir-locals.el doesn't exist, + ;; fallback to $GIT_WORK_TREE/.dir-locals.el, + ;; because the maintainer can use the latter + ;; to enforce conventions, while s/he has no + ;; control over the former. + (fboundp 'magit-toplevel) ; silence byte-compiler + (magit-toplevel)) + default-directory))) (let ((buffer-file-name nil) ; trick hack-dir-local-variables (major-mode 'git-commit-mode)) ; trick dir-locals-collect-variables (hack-dir-local-variables) @@ -551,11 +564,14 @@ to recover older messages") ;; Maybe already enabled when using `shell-command' or an Emacs shell. (with-editor-mode 1)) (add-hook 'with-editor-finish-query-functions - 'git-commit-finish-query-functions nil t) + #'git-commit-finish-query-functions nil t) (add-hook 'with-editor-pre-finish-hook - 'git-commit-save-message nil t) + #'git-commit-save-message nil t) (add-hook 'with-editor-pre-cancel-hook - 'git-commit-save-message nil t) + #'git-commit-save-message nil t) + (when (fboundp 'magit-commit--reset-command) + (add-hook 'with-editor-post-finish-hook #'magit-commit--reset-command) + (add-hook 'with-editor-post-cancel-hook #'magit-commit--reset-command)) (when (and (fboundp 'magit-rev-parse) (not (memq last-command '(magit-sequencer-continue @@ -565,13 +581,13 @@ to recover older messages") magit-rebase-continue magit-rebase-skip)))) (add-hook 'with-editor-post-finish-hook - (apply-partially 'git-commit-run-post-finish-hook + (apply-partially #'git-commit-run-post-finish-hook (magit-rev-parse "HEAD")) nil t) (when (fboundp 'magit-wip-maybe-add-commit-hook) (magit-wip-maybe-add-commit-hook))) (setq with-editor-cancel-message - 'git-commit-cancel-message) + #'git-commit-cancel-message) (git-commit-mode 1) (git-commit-setup-font-lock) (git-commit-prepare-message-ring) @@ -591,7 +607,8 @@ to recover older messages") (fboundp 'magit-rev-parse)) (cl-block nil (let ((break (time-add (current-time) - (seconds-to-time 1)))) + (seconds-to-time + git-commit-post-finish-hook-timeout)))) (while (equal (magit-rev-parse "HEAD") previous) (if (time-less-p (current-time) break) (sit-for 0.01) @@ -643,7 +660,7 @@ finally check current non-comment text." (require 'flyspell) (turn-on-flyspell) (setq flyspell-generic-check-word-predicate - 'git-commit-flyspell-verify) + #'git-commit-flyspell-verify) (let ((end) (comment-start-regex (format "^\\(%s\\|$\\)" comment-start))) (save-excursion @@ -781,7 +798,7 @@ Save current message first." (insert str) (goto-char (point-min)) (when (re-search-forward (concat flush " -+ >8 -+$") nil t) - (delete-region (point-at-bol) (point-max))) + (delete-region (line-beginning-position) (point-max))) (goto-char (point-min)) (flush-lines flush) (goto-char (point-max)) @@ -795,21 +812,29 @@ Save current message first." (setq str (replace-match "\n" t t str))) str))) +;;; Utilities + +(defsubst git-commit-executable () + (if (fboundp 'magit-git-executable) + (magit-git-executable) + "git")) + ;;; Headers (transient-define-prefix git-commit-insert-pseudo-header () "Insert a commit message pseudo header." [["Insert ... by yourself" - ("a" "Ack" git-commit-ack) - ("m" "Modified" git-commit-modified) - ("r" "Reviewed" git-commit-review) - ("s" "Signed-off" git-commit-signoff) - ("t" "Tested" git-commit-test)] + ("a" "Ack" git-commit-ack) + ("m" "Modified" git-commit-modified) + ("r" "Reviewed" git-commit-review) + ("s" "Signed-off" git-commit-signoff) + ("t" "Tested" git-commit-test)] ["Insert ... by someone" - ("C-c" "Cc" git-commit-cc) - ("C-r" "Reported" git-commit-reported) - ("C-i" "Suggested" git-commit-suggested) - ("C-a" "Co-authored" git-commit-co-authored)]]) + ("C-c" "Cc" git-commit-cc) + ("C-r" "Reported" git-commit-reported) + ("C-i" "Suggested" git-commit-suggested) + ("C-a" "Co-authored" git-commit-co-authored) + ("C-d" "Co-developed" git-commit-co-developed)]]) (defun git-commit-ack (name mail) "Insert a header acknowledging that you have looked at the commit." @@ -856,16 +881,25 @@ Save current message first." (interactive (git-commit-read-ident "Co-authored-by")) (git-commit-insert-header "Co-authored-by" name mail)) +(defun git-commit-co-developed (name mail) + "Insert a header mentioning the person who co-developed the commit." + (interactive (git-commit-read-ident "Co-developed-by")) + (git-commit-insert-header "Co-developed-by" name mail)) + (defun git-commit-self-ident () (list (or (getenv "GIT_AUTHOR_NAME") (getenv "GIT_COMMITTER_NAME") - (ignore-errors (car (process-lines "git" "config" "user.name"))) + (with-demoted-errors "Error running 'git config user.name': %S" + (car (process-lines + (git-commit-executable) "config" "user.name"))) user-full-name (read-string "Name: ")) (or (getenv "GIT_AUTHOR_EMAIL") (getenv "GIT_COMMITTER_EMAIL") (getenv "EMAIL") - (ignore-errors (car (process-lines "git" "config" "user.email"))) + (with-demoted-errors "Error running 'git config user.email': %S" + (car (process-lines + (git-commit-executable) "config" "user.email"))) (read-string "Email: ")))) (defvar git-commit-read-ident-history nil) @@ -876,7 +910,7 @@ Save current message first." prompt (sort (delete-dups (magit-git-lines "log" "-n9999" "--format=%aN <%ae>")) - 'string<) + #'string<) nil nil nil 'git-commit-read-ident-history))) (save-match-data (if (string-match "\\`\\([^<]+\\) *<\\([^>]+\\)>\\'" str) @@ -966,7 +1000,7 @@ Added to `font-lock-extend-region-functions'." (eval . `(,(git-commit-summary-regexp) (1 'git-commit-summary))) ;; - Keyword [aka "text in brackets"] (overrides summary) - ("\\[.+?\\]" + ("\\[[^][]+?\\]" (0 'git-commit-keyword t)) ;; - Non-empty second line (overrides summary and note) (eval . `(,(git-commit-summary-regexp) @@ -1027,49 +1061,53 @@ Added to `font-lock-extend-region-functions'." "Font-Lock keywords for Git-Commit mode.") (defun git-commit-setup-font-lock () - (let ((table (make-syntax-table (syntax-table)))) - (when comment-start - (modify-syntax-entry (string-to-char comment-start) "." table)) - (modify-syntax-entry ?# "." table) - (modify-syntax-entry ?\" "." table) - (modify-syntax-entry ?\' "." table) - (modify-syntax-entry ?` "." table) - (set-syntax-table table)) - (setq-local comment-start - (or (with-temp-buffer - (call-process "git" nil (current-buffer) nil - "config" "core.commentchar") - (unless (bobp) - (goto-char (point-min)) - (buffer-substring (point) (line-end-position)))) - "#")) - (setq-local comment-start-skip (format "^%s+[\s\t]*" comment-start)) - (setq-local comment-end-skip "\n") - (setq-local comment-use-syntax nil) - (setq-local git-commit--branch-name-regexp - (if (and (featurep 'magit-git) - ;; When using cygwin git, we may end up in a - ;; non-existing directory, which would cause - ;; any git calls to signal an error. - (file-accessible-directory-p default-directory)) - (progn - ;; Make sure the below functions are available. - (require 'magit) - ;; Font-Lock wants every submatch to succeed, so - ;; also match the empty string. Avoid listing - ;; remote branches and using `regexp-quote', - ;; because in repositories have thousands of - ;; branches that would be very slow. See #4353. - (format "\\(\\(?:%s\\)\\|\\)\\([^']+\\)" - (mapconcat #'identity - (magit-list-local-branch-names) - "\\|"))) - "\\([^']*\\)")) - (setq-local font-lock-multiline t) - (add-hook 'font-lock-extend-region-functions - #'git-commit-extend-region-summary-line - t t) - (font-lock-add-keywords nil git-commit-font-lock-keywords)) + (with-demoted-errors "Error running git-commit-setup-font-lock: %S" + (let ((table (make-syntax-table (syntax-table)))) + (when comment-start + (modify-syntax-entry (string-to-char comment-start) "." table)) + (modify-syntax-entry ?# "." table) + (modify-syntax-entry ?\" "." table) + (modify-syntax-entry ?\' "." table) + (modify-syntax-entry ?` "." table) + (set-syntax-table table)) + (setq-local comment-start + (or (with-temp-buffer + (and (zerop + (call-process + (git-commit-executable) nil (list t nil) nil + "config" "core.commentchar")) + (not (bobp)) + (progn + (goto-char (point-min)) + (buffer-substring (point) (line-end-position))))) + "#")) + (setq-local comment-start-skip (format "^%s+[\s\t]*" comment-start)) + (setq-local comment-end-skip "\n") + (setq-local comment-use-syntax nil) + (setq-local git-commit--branch-name-regexp + (if (and (featurep 'magit-git) + ;; When using cygwin git, we may end up in a + ;; non-existing directory, which would cause + ;; any git calls to signal an error. + (file-accessible-directory-p default-directory)) + (progn + ;; Make sure the below functions are available. + (require 'magit) + ;; Font-Lock wants every submatch to succeed, so + ;; also match the empty string. Avoid listing + ;; remote branches and using `regexp-quote', + ;; because in repositories have thousands of + ;; branches that would be very slow. See #4353. + (format "\\(\\(?:%s\\)\\|\\)\\([^']+\\)" + (mapconcat #'identity + (magit-list-local-branch-names) + "\\|"))) + "\\([^']*\\)")) + (setq-local font-lock-multiline t) + (add-hook 'font-lock-extend-region-functions + #'git-commit-extend-region-summary-line + t t) + (font-lock-add-keywords nil git-commit-font-lock-keywords))) (defun git-commit-propertize-diff () (require 'diff-mode) diff --git a/elpa/kubel-20220509.104/kubel-pkg.el b/elpa/kubel-20220509.104/kubel-pkg.el deleted file mode 100644 index 683f598f..00000000 --- a/elpa/kubel-20220509.104/kubel-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; Generated package description from kubel.el -*- no-byte-compile: t -*- -(define-package "kubel" "20220509.104" "Control Kubernetes with limited permissions" '((transient "0.1.0") (emacs "25.3") (dash "2.12.0") (s "1.2.0") (yaml-mode "0.0.14")) :commit "c45e19a215e8e7df80a61c10ca1fa26dcfd1de35" :authors '(("Adrien Brochard")) :maintainer '("Adrien Brochard") :keywords '("kubernetes" "k8s" "tools" "processes") :url "https://github.com/abrochard/kubel") diff --git a/elpa/kubel-20220509.104/kubel-autoloads.el b/elpa/kubel-20220723.1655/kubel-autoloads.el similarity index 100% rename from elpa/kubel-20220509.104/kubel-autoloads.el rename to elpa/kubel-20220723.1655/kubel-autoloads.el diff --git a/elpa/kubel-20220723.1655/kubel-pkg.el b/elpa/kubel-20220723.1655/kubel-pkg.el new file mode 100644 index 00000000..ef8f607f --- /dev/null +++ b/elpa/kubel-20220723.1655/kubel-pkg.el @@ -0,0 +1,2 @@ +;;; Generated package description from kubel.el -*- no-byte-compile: t -*- +(define-package "kubel" "20220723.1655" "Control Kubernetes with limited permissions" '((transient "0.1.0") (emacs "25.3") (dash "2.12.0") (s "1.2.0") (yaml-mode "0.0.14")) :commit "161f8f60cfe7f59cacd38127f7fd21b08c516bc3" :authors '(("Adrien Brochard")) :maintainer '("Adrien Brochard") :keywords '("kubernetes" "k8s" "tools" "processes") :url "https://github.com/abrochard/kubel") diff --git a/elpa/kubel-20220509.104/kubel.el b/elpa/kubel-20220723.1655/kubel.el similarity index 99% rename from elpa/kubel-20220509.104/kubel.el rename to elpa/kubel-20220723.1655/kubel.el index b58d7360..a2b96cea 100644 --- a/elpa/kubel-20220509.104/kubel.el +++ b/elpa/kubel-20220723.1655/kubel.el @@ -22,8 +22,8 @@ ;; USA ;; Version: 1.0 -;; Package-Version: 20220509.104 -;; Package-Commit: c45e19a215e8e7df80a61c10ca1fa26dcfd1de35 +;; Package-Version: 20220723.1655 +;; Package-Commit: 161f8f60cfe7f59cacd38127f7fd21b08c516bc3 ;; Author: Adrien Brochard ;; Keywords: kubernetes k8s tools processes ;; URL: https://github.com/abrochard/kubel @@ -784,11 +784,11 @@ ARGS is the arguments list from transient." (interactive) (let* ((kubel--buffer (get-buffer (kubel--buffer-name))) (last-default-directory (when kubel--buffer (with-current-buffer kubel--buffer default-directory)))) - (when kubel--buffer (kill-buffer kubel--buffer));; kill buffer for previous context if possible (setq kubel-context (completing-read "Select context: " (split-string (kubel--exec-to-string (format "%s config view -o jsonpath='{.contexts[*].name}'" kubel-kubectl)) " "))) + (when kubel--buffer (kill-buffer kubel--buffer));; kill buffer for previous context if possible (kubel--invalidate-context-caches) (setq kubel-namespace "default") (kubel last-default-directory))) diff --git a/elpa/lsp-mode-20220201.852/lsp-actionscript.el b/elpa/lsp-mode-20220201.852/lsp-actionscript.el deleted file mode 100644 index f82e669b..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-actionscript.el +++ /dev/null @@ -1,134 +0,0 @@ -;;; lsp-actionscript.el --- ActionScript Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 Jen-Chieh Shen - -;; Author: Jen-Chieh Shen -;; Keywords: actionscript 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 . - -;;; Commentary: - -;; LSP client for ActionScript - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-actionscript nil - "LSP support for ActionScript." - :group 'lsp-mode - :link '(url-link "https://github.com/BowlerHatLLC/vscode-as3mxml") - :package-version `(lsp-mode . "8.0.0")) - -(defcustom lsp-actionscript-java-path "java" - "Path of the java executable." - :group 'lsp-actionscript - :type 'string) - -(defcustom lsp-actionscript-sdk-path "" - "Path to supported SDK. -See https://github.com/BowlerHatLLC/vscode-as3mxml/wiki/Choose-an-ActionScript-SDK-for-the-current-workspace-in-Visual-Studio-Code." - :type 'string - :group 'lsp-actionscript - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-actionscript-version "1.5.0" - "Version of ActionScript language server." - :type 'string - :group 'lsp-actionscript - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-actionscript-extension-name - (format "vscode-nextgenas-%s.vsix" lsp-actionscript-version) - "File name of the extension file from language server." - :type 'string - :group 'lsp-actionscript - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-actionscript-server-download-url - (format "https://github.com/BowlerHatLLC/vscode-as3mxml/releases/download/v%s/%s" - lsp-actionscript-version lsp-actionscript-extension-name) - "Automatic download url for lsp-actionscript." - :type 'string - :group 'lsp-actionscript - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-actionscript-server-store-path - (f-join lsp-server-install-dir "as3mxml") - "The path to the file in which `lsp-actionscript' will be stored." - :type 'file - :group 'lsp-actionscript - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-actionscript-option-charset "UTF8" - "The charset to use by the ActionScript Language server." - :type 'string - :group 'lsp-actionscript - :package-version '(lsp-mode . "8.0.0")) - -(defun lsp-actionscript--extension-root () - "The path that the downloaded extension will extract to." - (f-join lsp-actionscript-server-store-path - (format "vscode-nextgenas-%s" lsp-actionscript-version))) - -(defun lsp-actionscript--extension-path () - "Return full path of the downloaded extension." - (f-join lsp-actionscript-server-store-path lsp-actionscript-extension-name)) - -(defun lsp-actionscript--extension-dir () - "Return as3mxml extension path." - (f-join (lsp-actionscript--extension-root) "extension")) - -(defun lsp-actionscript--server-command () - "Startup command for ActionScript language server." - (list lsp-actionscript-java-path - (format "-Droyalelib=%s" lsp-actionscript-sdk-path) - (format "-Dfile.encoding=%s" lsp-actionscript-option-charset) - "-cp" - (format "%s/bundled-compiler/*;%s/bin/*" - (lsp-actionscript--extension-dir) (lsp-actionscript--extension-dir)) - "com.as3mxml.vscode.Main")) - -(defun lsp-actionscript--extension-path-zip () - "Change extension path from .vsix to .zip." - (concat (f-no-ext (lsp-actionscript--extension-path)) ".zip")) - -(lsp-dependency - 'as3mxml - '(:system "as3mxml") - `(:download :url lsp-actionscript-server-download-url - :store-path ,(lsp-actionscript--extension-path-zip))) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection - #'lsp-actionscript--server-command - (lambda () (f-exists? (lsp-actionscript--extension-path-zip)))) - :major-modes '(actionscript-mode) - :priority -1 - :server-id 'as3mxml-ls - :download-server-fn (lambda (_client _callback error-callback _update?) - (lsp-package-ensure - 'as3mxml - (lambda () - ;; TODO: Error handling when unzip failed - (lsp-unzip (lsp-actionscript--extension-path-zip) - (lsp-actionscript--extension-root))) - error-callback)))) - -(lsp-consistency-check lsp-actionscript) - -(provide 'lsp-actionscript) -;;; lsp-actionscript.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-ada.el b/elpa/lsp-mode-20220201.852/lsp-ada.el deleted file mode 100644 index 82000417..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-ada.el +++ /dev/null @@ -1,106 +0,0 @@ -;;; lsp-ada.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, ada - -;; 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 . - -;;; Commentary: - -;; LSP Clients for the Ada Programming Language - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-ada nil - "Settings for Ada Language Server." - :group 'tools - :tag "Language Server" - :package-version '(lsp-mode . "6.2")) - -(defcustom-lsp lsp-ada-project-file "default.gpr" - "Set the project file full path to configure the language server with. - The ~ prefix (for the user home directory) is supported. - See https://github.com/AdaCore/ada_language_server for a per-project - configuration example." - :type 'string - :group 'lsp-ada - :package-version '(lsp-mode . "6.2") - :lsp-path "ada.projectFile") - -(defcustom-lsp lsp-ada-option-charset "UTF-8" - "The charset to use by the Ada Language server. Defaults to 'UTF-8'." - :type 'string - :group 'lsp-ada - :package-version '(lsp-mode . "6.2") - :lsp-path "ada.defaultCharset") - -(defcustom-lsp lsp-ada-enable-diagnostics t - "A boolean to disable diagnostics. Defaults to true." - :type 'boolean - :group 'lsp-ada - :package-version '(lsp-mode . "6.2") - :lsp-path "ada.enableDiagnostics") - -(defcustom lsp-ada-als-executable "ada_language_server" - "Command to start the Ada language server." - :group 'lsp-ada - :risky t - :type 'file) - -(defcustom lsp-ada-alira-executable "alr" - "The alire executable to run when a project is detected." - :type 'string - :group 'lsp-ada - :package-version '(lsp-mode "8.0.1")) - -(defun lsp-ada--environment () - "Add environmental variables if needed." - (let ((project-root (lsp-workspace-root))) - ;; When there is an alire project, include its environment - (when (file-exists-p - (concat (file-name-as-directory project-root) - "alire.toml")) - (let ((alr-executable (executable-find lsp-ada-alira-executable))) - (if alr-executable - ;; Transform output variables to environment - (let ((env-output (shell-command-to-string (concat alr-executable " printenv --unix")))) - (let ((var-strings (split-string env-output "\n"))) - (mapcar (lambda (string) - (if (string-match (rx "export" space (group (one-or-more ascii)) "=" "\"" (group (one-or-more ascii)) "\"") string) - (let ((var-name (match-string 1 string)) - (var-value (match-string 2 string))) - (cons var-name var-value)))) - var-strings))) - (lsp--error "Found alire.toml but the executable %s could not be found" alr-executable)))))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection lsp-ada-als-executable) - :major-modes '(ada-mode) - :priority -1 - :initialized-fn (lambda (workspace) - (with-lsp-workspace workspace - (lsp--set-configuration - (lsp-configuration-section "ada")))) - :server-id 'ada-ls - :synchronize-sections '("ada") - :environment-fn 'lsp-ada--environment)) - -(lsp-consistency-check lsp-ada) - -(provide 'lsp-ada) -;;; lsp-ada.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-angular.el b/elpa/lsp-mode-20220201.852/lsp-angular.el deleted file mode 100644 index f09aa870..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-angular.el +++ /dev/null @@ -1,101 +0,0 @@ -;;; lsp-angular.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 . - -;;; Commentary: - -;; LSP Clients for the Angular Web application framework. - -;;; Code: - -(require 'lsp-mode) -(require 'f) - - -;;; Angular -(defgroup lsp-angular nil - "Angular LSP client, provided by the Angular Language Service Server." - :group 'lsp-mode - :version "8.0.0" - :link '(url-link "https://github.com/angular/vscode-ng-language-service")) - -(defcustom lsp-clients-angular-language-server-command - nil - "The command that starts the angular language server." - :group 'lsp-angular - :type '(choice - (string :tag "Single string value") - (repeat :tag "List of string values" - string))) - -(defcustom lsp-clients-angular-node-get-prefix-command - "npm config get --global prefix" - "The shell command that returns the path of NodeJS's prefix. -Has no effects when `lsp-clients-angular-language-server-command' is set." - :group 'lsp-angular - :type 'string) - -(defun lsp-client--angular-start-loading (_workspace params) - (lsp--info "Started loading project %s" params)) - -(defun lsp-client--angular-finished-loading (_workspace params) - (lsp--info "Finished loading project %s" params)) - -(lsp-register-client - (make-lsp-client - :new-connection - (lsp-stdio-connection - (lambda () - (if lsp-clients-angular-language-server-command - lsp-clients-angular-language-server-command - (let ((node-modules-path - (f-join - (string-trim - (shell-command-to-string lsp-clients-angular-node-get-prefix-command)) - "lib/node_modules"))) - ;; The shell command takes a significant time to run, - ;; so we "cache" its results after running once - (setq lsp-clients-angular-language-server-command - (list - "node" - (f-join node-modules-path "@angular/language-server") - "--ngProbeLocations" - node-modules-path - "--tsProbeLocations" - node-modules-path - "--stdio")) - lsp-clients-angular-language-server-command)))) - :activation-fn - (lambda (&rest _args) - (and (string-match-p "\\(\\.html\\|\\.ts\\)\\'" (buffer-file-name)) - (lsp-workspace-root) - (file-exists-p (f-join (lsp-workspace-root) "angular.json")))) - :priority -1 - :notification-handlers - (ht ("angular/projectLoadingStart" #'lsp-client--angular-start-loading) - ("angular/projectLoadingFinish" #'lsp-client--angular-finished-loading) - ("angular/projectLanguageService" #'ignore)) - :add-on? t - :server-id 'angular-ls)) - - -(lsp-consistency-check lsp-angular) - -(provide 'lsp-angular) -;;; lsp-angular.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-bash.el b/elpa/lsp-mode-20220201.852/lsp-bash.el deleted file mode 100644 index ee8a28e9..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-bash.el +++ /dev/null @@ -1,90 +0,0 @@ -;;; lsp-bash.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, bash, shell-script - -;; 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 . - -;;; Commentary: - -;; LSP Clients for the Bash Programming Language - -;;; Code: - -(require 'lsp-mode) - -;;; Bash -(defgroup lsp-bash nil - "Settings for the Bash Language Server." - :group 'lsp-mode - :link '(url-link "https://github.com/bash-lsp/bash-language-server") - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-bash-explainshell-endpoint nil - "The endpoint to use explainshell.com to answer 'onHover' queries. -See instructions at https://marketplace.visualstudio.com/items?itemName=mads-hartmann.bash-ide-vscode" - :type 'string - :risky t - :group 'lsp-bash - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-bash-highlight-parsing-errors nil - "Consider parsing errors in scripts as 'problems'." - :type 'boolean - :group 'lsp-bash - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-bash-glob-pattern nil - "Glob pattern used to find shell script files to parse." - :type 'string - :group 'lsp-bash - :package-version '(lsp-mode . "6.3")) - -(defun lsp-bash--bash-ls-server-command () - "Startup command for Bash language server." - (list (lsp-package-path 'bash-language-server) "start")) - -(lsp-dependency 'bash-language-server - '(:system "bash-language-server") - '(:npm :package "bash-language-server" - :path "bash-language-server")) - -(defvar sh-shell) - -(defun lsp-bash-check-sh-shell (&rest _) - "Check whether `sh-shell' is sh or bash. - -This prevents the Bash server from being turned on in zsh files." - (and (eq major-mode 'sh-mode) - (memq sh-shell '(sh bash)))) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection #'lsp-bash--bash-ls-server-command) - :priority -1 - :activation-fn #'lsp-bash-check-sh-shell - :environment-fn (lambda () - '(("EXPLAINSHELL_ENDPOINT" . lsp-bash-explainshell-endpoint) - ("HIGHLIGHT_PARSING_ERRORS" . lsp-bash-highlight-parsing-errors) - ("GLOB_PATTERN" . lsp-bash-glob-pattern))) - :server-id 'bash-ls - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'bash-language-server callback error-callback)))) - -(lsp-consistency-check lsp-bash) - -(provide 'lsp-bash) -;;; lsp-bash.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-beancount.el b/elpa/lsp-mode-20220201.852/lsp-beancount.el deleted file mode 100644 index d2125e8c..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-beancount.el +++ /dev/null @@ -1,71 +0,0 @@ -;;; lsp-beancount.el --- Beancount Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, beancount - -;; 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 . - -;;; Commentary: - -;; LSP client for Beancount - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-beancount nil - "Settings for the Beancount Language Server." - :group 'lsp-mode - :link '(url-link "https://github.com/polarmutex/beancount-language-server") - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-beancount-langserver-executable "beancount-langserver" - "Command to start Beancount language server." - :type 'string - :group 'lsp-beancount - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-beancount-python-interpreter nil - "Path to Python executable." - :type 'string - :group 'lsp-beancount - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-beancount-journal-file nil - "Pathg to Beancount journal file." - :type 'string - :group 'lsp-beancount - :package-version '(lsp-mode . "8.0.0")) - -(lsp-register-client - (make-lsp-client - :new-connection - (lsp-stdio-connection - (lambda () - (when (null lsp-beancount-python-interpreter) - (setq lsp-beancount-python-interpreter (or (executable-find "python3") - (executable-find "python")))) - `(,lsp-beancount-langserver-executable "--stdio"))) - :major-modes '(beancount-mode) - :initialization-options - `((journalFile . ,lsp-beancount-journal-file) - (pythonPath . ,lsp-beancount-python-interpreter)) - :server-id 'beancount-ls)) - -(lsp-consistency-check lsp-beancount) - -(provide 'lsp-beancount) -;;; lsp-beancount.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-clangd.el b/elpa/lsp-mode-20220201.852/lsp-clangd.el deleted file mode 100644 index 1a888773..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-clangd.el +++ /dev/null @@ -1,315 +0,0 @@ -;;; lsp-clangd.el --- LSP clients for the C Languages Family -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 Daniel Martín & 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 . - -;;; 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 "13.0.0" - "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

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." - (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++), 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 . "8.0.1")) - -(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 14 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") - :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/elpa/lsp-mode-20220201.852/lsp-clojure.el b/elpa/lsp-mode-20220201.852/lsp-clojure.el deleted file mode 100644 index 7f911bbd..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-clojure.el +++ /dev/null @@ -1,418 +0,0 @@ -;;; lsp-clojure.el --- Clojure Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Benedek Fazekas - -;; Author: Benedek Fazekas -;; 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 . - -;;; 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-amd64.zip" - (pcase system-type - ('gnu/linux "linux") - ('darwin "macos") - ('windows-nt "windows"))) - "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-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-test-tree-position-params nil - "The optional test tree position params. -Defaults to side following treemacs default." - :type 'list - :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-server-info () - "Request server info." - (interactive) - (lsp--cur-workspace-check) - (lsp-notify "clojure/serverInfo/log" nil)) - -(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))))))) - t - t)) - -(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)) -(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 - 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"))) - -(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 - (lambda () - (or lsp-clojure-custom-server-command - `(,(lsp-clojure--server-executable-path)))) - (lambda () - (or lsp-clojure-custom-server-command - (lsp-clojure--server-executable-path)))) - :major-modes '(clojure-mode clojurec-mode clojurescript-mode) - :library-folders-fn (lambda (_workspace) (list lsp-clojure-workspace-cache-dir)) - :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) - -;; Cider integration - -(defun lsp-clojure-semantic-tokens-refresh (&rest _) - "Force refresh semantic tokens." - (when (and lsp-semantic-tokens-enable - (lsp-find-workspace 'clojure-lsp (buffer-file-name))) - (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/elpa/lsp-mode-20220201.852/lsp-cmake.el b/elpa/lsp-mode-20220201.852/lsp-cmake.el deleted file mode 100644 index beffa5de..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-cmake.el +++ /dev/null @@ -1,43 +0,0 @@ -;;; lsp-cmake.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, cmake - -;; 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 . - -;;; Commentary: - -;; LSP Clients for the CMake build tool. - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-cmake nil - "LSP support for CMake, using cmake-language-server." - :group 'lsp-mode - :link '(url-link "https://github.com/regen100/cmake-language-server")) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection "cmake-language-server") - :major-modes '(cmake-mode) - :priority -1 - :server-id 'cmakels)) - -(lsp-consistency-check lsp-cmake) - -(provide 'lsp-cmake) -;;; lsp-cmake.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-completion.el b/elpa/lsp-mode-20220201.852/lsp-completion.el deleted file mode 100644 index 2f47dd86..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-completion.el +++ /dev/null @@ -1,809 +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 . -;; -;;; 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-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")) - -(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) - (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--annotate (item) - "Annotate ITEM detail." - (-let (((&CompletionItem :detail? :kind?) (plist-get (text-properties-at 0 item) - 'lsp-completion-item))) - (concat (when (and lsp-completion-show-detail detail?) - (concat " " (s-replace "\r" "" detail?))) - (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 trigger character if text before point match any of the TRIGGER-CHARACTERS." - (unless (= (point) (point-at-bol)) - (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))) - -(defcustom lsp-completion-default-behaviour :replace - "Default behaviour of `InsertReplaceEdit'." - :type '(choice - (const :insert :tag "Default completion inserts") - (const :replace :tag "Default completion replaces")) - :group 'lsp-mode - :package-version '(lsp-mode . "8.0.0")) - -(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." - (let* ((prefix (downcase - (buffer-substring-no-properties - (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." - (unless (get-text-property 0 'lsp-completion-resolved item) - (let ((resolved-item - (-some->> item - (get-text-property 0 'lsp-completion-item) - (lsp-completion--resolve))) - (len (length item))) - (put-text-property 0 len 'lsp-completion-item resolved-item item) - (put-text-property 0 len 'lsp-completion-resolved t item))) - (-some->> item - (get-text-property 0 'lsp-completion-item) - (lsp:completion-item-documentation?) - (lsp--render-element))) - -(defun lsp-completion--get-context (trigger-characters) - "Get completion context with provided TRIGGER-CHARACTERS." - (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) - ((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--server-capabilities) - (lsp:server-capabilities-completion-provider?) - (lsp:completion-options-trigger-characters?))) - (bounds-start (or (-some--> (cl-first (bounds-of-thing-at-point 'symbol)) - (save-excursion - (ignore-errors - (goto-char (+ it 1)) - (while (lsp-completion--looking-back-trigger-characterp - trigger-chars) - (cl-incf it) - (forward-char)) - it))) - (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)))) - (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 - ;; metadata - ((equal action 'metadata) - `(metadata (category . lsp-capf) - (display-sort-function . identity) - (cycle-sort-function . identity))) - ;; boundaries - ((equal (car-safe action) 'boundaries) nil) - ;; try-completion - ((null action) - (when-let ((cands (funcall candidates))) - (if (cl-rest cands) probe (cl-first cands)))) - ;; test-completion: not return exact match so that the selection will - ;; always be shown - ((equal action 'lambda) nil) - ;; retrieve candidates - ((equal action t) - (all-completions probe (funcall candidates) 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 - (goto-char bounds-start) - (and (lsp-completion--looking-back-trigger-characterp trigger-chars) 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--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))) - ((&plist 'lsp-completion-item item - 'lsp-completion-start-point start-point - 'lsp-completion-markers markers - '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? - ((TextEdit) (lsp--apply-text-edit text-edit?)) - ((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 (get-text-property 0 'lsp-completion-resolved candidate) - (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 (get-text-property 0 'lsp-completion-resolved candidate) - 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 mis-match 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)))) - -(defun lsp-completion--fix-resolve-data (item) - ;; patch `CompletionItem' 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." - (cl-assert item nil "Completion item must not be nil") - (lsp-completion--fix-resolve-data item) - (or (ignore-errors - (when (lsp-feature? "completionItem/resolve") - (lsp-request "completionItem/resolve" item))) - 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") - (lsp-completion--fix-resolve-data item) - (ignore-errors - (if (lsp-feature? "completionItem/resolve") - (lsp-request-async "completionItem/resolve" item - (lambda (result) - (funcall callback result) - (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 item) - (when cleanup-fn (funcall cleanup-fn))))) - - -;;;###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-all-completions (_string table pred _point) - "Like `completion-basic-all-completions' but have prefix ignored." - (completion-basic-all-completions "" table pred 0)) - -;;;###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 - (setq-local completion-at-point-functions nil) - (add-hook 'completion-at-point-functions #'lsp-completion-at-point nil t) - (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) - '(completion-basic-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/elpa/lsp-mode-20220201.852/lsp-crystal.el b/elpa/lsp-mode-20220201.852/lsp-crystal.el deleted file mode 100644 index f0aca59c..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-crystal.el +++ /dev/null @@ -1,48 +0,0 @@ -;;; lsp-crystal.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, crystal - -;; 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 . - -;;; Commentary: - -;; LSP Clients for the Crystal Programming Language. - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-scry nil - "LSP support for Crystal via scry." - :group 'lsp-mode - :link '(url-link "https://github.com/crystal-lang-tools/scry")) - -(defcustom lsp-clients-crystal-executable '("scry" "--stdio") - "Command to start the scry language server." - :group 'lsp-scry - :risky t - :type 'file) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection lsp-clients-crystal-executable) - :major-modes '(crystal-mode) - :server-id 'scry)) - -(lsp-consistency-check lsp-crystal) - -(provide 'lsp-crystal) -;;; lsp-crystal.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-csharp.el b/elpa/lsp-mode-20220201.852/lsp-csharp.el deleted file mode 100644 index 4658fd4b..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-csharp.el +++ /dev/null @@ -1,443 +0,0 @@ -;;; lsp-csharp.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Jostein Kjønigsen, Saulius Menkevicius - -;; Author: Saulius Menkevicius -;; 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 . - -;;; 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 . "8.0.1")) - -(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 outputing 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) - "omnisharp-osx.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.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-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) - -(lsp-dependency - 'omnisharp-roslyn - `(:download :url lsp-csharp-omnisharp-roslyn-download-url - :store-path lsp-csharp-omnisharp-roslyn-store-path)) - -(defun lsp-csharp--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 - (lambda () - (lsp-unzip lsp-csharp-omnisharp-roslyn-store-path - lsp-csharp-omnisharp-roslyn-server-dir) - (unless (eq system-type 'windows-nt) - (let ((run-script (f-join lsp-csharp-omnisharp-roslyn-server-dir "run"))) - (when (not (f-exists-p run-script)) - ; create the `run' script when missing (e.g. when server binaries are extracted from omnisharp-mono.zip) - ; NOTE: we do not check for presence or version of mono in the system - (with-temp-file run-script - (insert "#!/bin/bash\n") - (insert "BASEDIR=$(dirname \"$0\")\n") - (insert "exec mono $BASEDIR/OmniSharp.exe $@\n"))) - (set-file-modes run-script #o755))) - (funcall callback)) - error-callback)) - -(defun lsp-csharp--language-server-path () - "Resolve path to use to start the server." - (if lsp-csharp-server-path - lsp-csharp-server-path - (let ((server-dir lsp-csharp-omnisharp-roslyn-server-dir)) - (when (f-exists? server-dir) - (f-join server-dir (cond ((eq system-type 'windows-nt) "OmniSharp.exe") - (t "run"))))))) - -(lsp-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 by displaying a message with lsp-warn." - (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 lsp-csharp -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"))) - -(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)))) - :major-modes '(csharp-mode csharp-tree-sitter-mode) - :server-id 'omnisharp - :priority -1 - :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)) - :download-server-fn #'lsp-csharp--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-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") "-g" "csharp-ls")) - -(lsp-register-client - (make-lsp-client :new-connection - (lsp-stdio-connection - #'(lambda () - (append (list "csharp-ls") - (when lsp-csharp-solution-file - (list "-s" lsp-csharp-solution-file))))) - :priority -2 - :server-id 'csharp-ls - :major-modes '(csharp-mode csharp-tree-sitter-mode) - :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/elpa/lsp-mode-20220201.852/lsp-css.el b/elpa/lsp-mode-20220201.852/lsp-css.el deleted file mode 100644 index ca5d9573..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-css.el +++ /dev/null @@ -1,254 +0,0 @@ -;;; lsp-css.el --- CSS language server configuration -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Ivan Yonchovski - -;; Author: Ivan Yonchovski -;; 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 . - -;;; Commentary: - -;; - -;;; Code: - -(require 'lsp-protocol) -(require 'lsp-mode) - -(defgroup lsp-css nil - "LSP support for CSS." - :group 'lsp-mode - :link '(url-link - "https://github.com/vscode-langservers/vscode-css-languageserver-bin")) - -(defcustom lsp-css-experimental-custom-data nil - "A list of JSON file paths that define custom CSS data that -loads custom properties, at directives, pseudo classes / -elements." - :type '(repeat string)) - -(defcustom lsp-css-completion-trigger-property-value-completion t - "By default, VS Code triggers property value completion after -selecting a CSS property. Use this setting to disable this -behavior." - :type 'boolean) - -(defcustom lsp-css-validate t - "Enables or disables all validations." - :type 'boolean) - -(defcustom lsp-css-lint-compatible-vendor-prefixes "ignore" - "When using a vendor-specific prefix make sure to also include -all other vendor-specific properties." - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-vendor-prefix "warning" - "When using a vendor-specific prefix, also include the standard -property." - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-duplicate-properties "ignore" - "Do not use duplicate style definitions." - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-empty-rules "warning" - "Do not use empty rulesets." - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-import-statement "ignore" - "Import statements do not load in parallel." - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-box-model "ignore" - nil - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-universal-selector "ignore" - nil - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-zero-units "ignore" - "No unit for zero needed." - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-font-face-properties "warning" - nil - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-hex-color-length "error" - "Hex colors must consist of three or six hex numbers." - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-arguments-in-color-function "error" - "Invalid number of parameters." - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-unknown-properties "warning" - "Unknown property." - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-valid-properties nil - "A list of properties that are not validated against the -`unknownProperties` rule." - :type '(repeat string)) - -(defcustom lsp-css-lint-ie-hack "ignore" - "IE hacks are only necessary when supporting IE7 and older." - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-unknown-vendor-specific-properties "ignore" - "Unknown vendor specific property." - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-property-ignored-due-to-display "warning" - nil - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-important "ignore" - nil - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-float "ignore" - nil - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-id-selector "ignore" - "Selectors should not contain IDs because these rules are too -tightly coupled with the HTML." - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-lint-unknown-at-rules "warning" - "Unknown at-rule." - :type '(choice - (const "ignore") - (const "warning") - (const "error"))) - -(defcustom lsp-css-trace-server "off" - "Traces the communication between VS Code and the CSS language -server." - :type '(choice - (const "off") - (const "messages") - (const "verbose"))) - -(lsp-register-custom-settings - '(("css.trace.server" lsp-css-trace-server) - ("css.lint.unknownAtRules" lsp-css-lint-unknown-at-rules) - ("css.lint.idSelector" lsp-css-lint-id-selector) - ("css.lint.float" lsp-css-lint-float) - ("css.lint.important" lsp-css-lint-important) - ("css.lint.propertyIgnoredDueToDisplay" lsp-css-lint-property-ignored-due-to-display) - ("css.lint.unknownVendorSpecificProperties" lsp-css-lint-unknown-vendor-specific-properties) - ("css.lint.ieHack" lsp-css-lint-ie-hack) - ("css.lint.validProperties" lsp-css-lint-valid-properties) - ("css.lint.unknownProperties" lsp-css-lint-unknown-properties) - ("css.lint.argumentsInColorFunction" lsp-css-lint-arguments-in-color-function) - ("css.lint.hexColorLength" lsp-css-lint-hex-color-length) - ("css.lint.fontFaceProperties" lsp-css-lint-font-face-properties) - ("css.lint.zeroUnits" lsp-css-lint-zero-units) - ("css.lint.universalSelector" lsp-css-lint-universal-selector) - ("css.lint.boxModel" lsp-css-lint-box-model) - ("css.lint.importStatement" lsp-css-lint-import-statement) - ("css.lint.emptyRules" lsp-css-lint-empty-rules) - ("css.lint.duplicateProperties" lsp-css-lint-duplicate-properties) - ("css.lint.vendorPrefix" lsp-css-lint-vendor-prefix) - ("css.lint.compatibleVendorPrefixes" lsp-css-lint-compatible-vendor-prefixes) - ("css.validate" lsp-css-validate t) - ("css.completion.triggerPropertyValueCompletion" lsp-css-completion-trigger-property-value-completion t) - ("css.experimental.customData" lsp-css-experimental-custom-data))) - -(defun lsp-css--server-command () - "Generate startup command for CSS language server." - (list (lsp-package-path 'css-languageserver) "--stdio")) - -;;; CSS -(lsp-defun lsp-css--apply-code-action ((&Command :arguments?)) - "Apply ACTION as workspace edit command." - (lsp--apply-text-edits (cl-caddr arguments?) 'code-action)) - -(lsp-dependency 'css-languageserver - '(:system "css-languageserver") - '(:npm :package "vscode-css-languageserver-bin" - :path "css-languageserver")) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection #'lsp-css--server-command) - :activation-fn (lsp-activate-on "css" "scss" "sass" "less") - :priority -1 - :action-handlers (lsp-ht ("_css.applyCodeAction" #'lsp-css--apply-code-action)) - :server-id 'css-ls - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'css-languageserver callback error-callback)))) - -(lsp-consistency-check lsp-css) - -(provide 'lsp-css) -;;; lsp-css.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-d.el b/elpa/lsp-mode-20220201.852/lsp-d.el deleted file mode 100644 index f9c7b137..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-d.el +++ /dev/null @@ -1,37 +0,0 @@ -;;; lsp-d.el --- lsp-mode dlang 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 . - -;;; Commentary: - -;; client for serve-d - -;;; Code: - -(require 'lsp-mode) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection "serve-d") - :major-modes '(d-mode) - :server-id 'serve-d)) - -(lsp-consistency-check lsp-d) - -(provide 'lsp-d) -;;; lsp-d.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-dhall.el b/elpa/lsp-mode-20220201.852/lsp-dhall.el deleted file mode 100644 index 7b105973..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-dhall.el +++ /dev/null @@ -1,43 +0,0 @@ -;;; lsp-dhall.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, dhall - -;; 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 . - -;;; Commentary: - -;; LSP Clients for the Dhall Programming Language. - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-dhall nil - "LSP support for Dhall, using dhall-lsp-server." - :group 'lsp-mode - :link '(url-link "https://github.com/dhall-lang/dhall-haskell")) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection "dhall-lsp-server") - :major-modes '(dhall-mode) - :priority -1 - :server-id 'dhallls)) - -(lsp-consistency-check lsp-dhall) - -(provide 'lsp-dhall) -;;; lsp-dhall.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-diagnostics.el b/elpa/lsp-mode-20220201.852/lsp-diagnostics.el deleted file mode 100644 index f82ef56d..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-diagnostics.el +++ /dev/null @@ -1,370 +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 . -;; -;;; 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) - :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 "lsp-%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 "lsp-%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 (&Position :line start-line - :character start-character) - :end (&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 (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 (point-at-bol (1+ start-line)) - end (point-at-eol (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/elpa/lsp-mode-20220201.852/lsp-dired.el b/elpa/lsp-mode-20220201.852/lsp-dired.el deleted file mode 100644 index 8b84af7d..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-dired.el +++ /dev/null @@ -1,178 +0,0 @@ -;;; lsp-dired.el --- `lsp-mode' diagnostics integrated into `dired' -*- lexical-binding: t -*- - -;; Copyright (C) 2021 - -;; Author: Alexander Miller -;; Author: Ivan Yonchovski - -;; 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 . - -;;; 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 - (point-at-bol) - (search-forward-regexp "^[[:space:]]*" (line-end-position) t) - (point))) - (face (lsp-dired--face-for-path file))) - (when face - (-doto (make-overlay bol (point-at-eol)) - (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/elpa/lsp-mode-20220201.852/lsp-dockerfile.el b/elpa/lsp-mode-20220201.852/lsp-dockerfile.el deleted file mode 100644 index 1d0075df..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-dockerfile.el +++ /dev/null @@ -1,66 +0,0 @@ -;;; lsp-dockerfile.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, dockerfile - -;; 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 . - -;;; Commentary: - -;; LSP Clients for Dockerfile documents. - -;;; Code: - -(require 'lsp-mode) - - -;;; Dockerfile - -(defgroup lsp-dockerfile nil - "Dockerfile LSP client, provided by the Dockerfile Language Server." - :group 'lsp-mode - :version "8.0.0" - :link '(url-link "https://github.com/rcjsuen/dockerfile-language-server-nodejs")) - -(defcustom lsp-dockerfile-language-server-command - '("docker-langserver" "--stdio") - "The command that starts the docker language server." - :group 'lsp-dockerfile - :type '(repeat :tag "List of string values" string)) - -(lsp-dependency 'docker-langserver - '(:system "docker-langserver") - '(:npm :package "dockerfile-language-server-nodejs" - :path "docker-langserver")) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection - (lambda () - `(,(or (executable-find - (cl-first lsp-dockerfile-language-server-command)) - (lsp-package-path 'docker-langserver)) - ,@(cl-rest lsp-dockerfile-language-server-command)))) - :major-modes '(dockerfile-mode) - :priority -1 - :server-id 'dockerfile-ls - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'docker-langserver - callback error-callback)))) - -(lsp-consistency-check lsp-dockerfile) - -(provide 'lsp-dockerfile) -;;; lsp-dockerfile.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-elixir.el b/elpa/lsp-mode-20220201.852/lsp-elixir.el deleted file mode 100644 index 0de89287..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-elixir.el +++ /dev/null @@ -1,190 +0,0 @@ -;;; lsp-elixir.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, elixir - -;; 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 . - -;;; Commentary: - -;; LSP Clients for the Elixir Programming Language. - -;;; Code: - -(require 'lsp-mode) -(require 'ht) - -(defcustom lsp-elixir-dialyzer-enabled t - "Run ElixirLS's rapid Dialyzer when code is saved." - :type 'boolean - :group 'lsp-elixir - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-elixir-dialyzer-warn-opts '() - "Dialyzer options to enable or disable warnings. - -See Dialyzer's documentation for options. Note that the \"race_conditions\" -option is unsupported" - :type '(repeat string) - :group 'lsp-elixir - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-elixir-dialyzer-format "dialyxir_long" - "Formatter to use for Dialyzer warnings." - :type 'string - :group 'lsp-elixir - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-elixir-mix-env "test" - "Mix environment to use for compilation." - :type 'string - :group 'lsp-elixir - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-elixir-mix-target nil - "Mix target to use for compilation (requires Elixir >= 1.8)." - :type 'string - :group 'lsp-elixir - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-elixir-project-dir nil - "Subdirectory containing Mix project if not in the project root. - -If value is `\"\"` then defaults to the workspace rootUri." - :type 'string - :group 'lsp-elixir - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-elixir-fetch-deps t - "Automatically fetch project dependencies when compiling." - :type 'boolean - :group 'lsp-elixir - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-elixir-suggest-specs t - "Suggest @spec annotations inline using Dialyzer's inferred success typings. -This requires Dialyzer." - :type 'boolean - :group 'lsp-elixir - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-elixir-signature-after-complete t - "Show signature help after confirming autocomplete." - :type 'boolean - :group 'lsp-elixir - :package-version '(lsp-mode . "8.0.0")) - -(defgroup lsp-elixir nil - "LSP support for Elixir, using elixir-ls." - :group 'lsp-mode - :link '(url-link "https://github.com/elixir-lsp/elixir-ls")) - -(define-obsolete-variable-alias 'lsp-clients-elixir-server-executable 'lsp-elixir-server-command "2021-04-05") - -(defcustom lsp-elixir-server-command - (if (equal system-type 'windows-nt) - '("language_server.bat") - '("language_server.sh")) - "Command to start elixir-ls. - -Leave as default to let `executable-find' search for it." - :group 'lsp-elixir - :type '(repeat string) - :package-version '(lsp-mode . "8.0.0")) - - -(defconst lsp-elixir-ls-server-dir - (f-join lsp-server-install-dir "elixir-ls") - "Elixir-ls local server Directory.") - -(defcustom lsp-elixir-local-server-command - (f-join lsp-elixir-ls-server-dir - (cl-first lsp-elixir-server-command)) - "Command to start local elixir-ls binary." - :group 'lsp-elixir - :type '(repeat string) - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-elixir-enable-test-lenses t - "Suggest Tests." - :type 'boolean - :group 'lsp-elixir - :package-version '(lsp-mode . "8.0.0")) - -(defun lsp-elixir--build-test-command (argument) - "Builds the test command from the ARGUMENT." - (let ((test-name (lsp-get argument :testName)) - (module (lsp-get argument :module)) - (describe (lsp-get argument :describe))) - (cond (module (concat "\"" "module:" module "\"")) - ((not test-name) (concat "\"" "describe:" describe "\"")) - (describe (concat "\"" "test:test " describe " " test-name "\"" )) - (t (concat "\"" "test:test " test-name "\"" ))))) - -(lsp-defun lsp-elixir--run-test ((&Command :arguments?)) - "Runs tests." - (let* ((argument (lsp-seq-first arguments?)) - (file-path (lsp-get argument :filePath)) - (test-command (lsp-elixir--build-test-command argument))) - (compile - (concat "cd " (lsp-workspace-root file-path) " && " - "mix test --exclude test --include " test-command " " file-path - " --no-color")) - file-path)) - -(lsp-dependency 'elixir-ls - '(:system "elixir-ls")) - -(lsp-register-custom-settings - '(("elixirLS.dialyzerEnabled" lsp-elixir-dialyzer-enabled t) - ("elixirLS.dialyzerWarnOpts" lsp-elixir-dialyzer-warn-opts) - ("elixirLS.dialyzerFormat" lsp-elixir-dialyzer-format) - ("elixirLS.mixEnv" lsp-elixir-mix-env) - ("elixirLS.mixTarget" lsp-elixir-mix-target) - ("elixirLS.projectDir" lsp-elixir-project-dir) - ("elixirLS.fetchDeps" lsp-elixir-fetch-deps t) - ("elixirLS.suggestSpecs" lsp-elixir-suggest-specs t) - ("elixirLS.signatureAfterComplete" lsp-elixir-signature-after-complete t) - ("elixirLS.enableTestLenses" lsp-elixir-enable-test-lenses t))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection - (lambda () - `(,(or (when (f-exists? lsp-elixir-local-server-command) - lsp-elixir-local-server-command) - (or (executable-find - (cl-first lsp-elixir-server-command)) - (lsp-package-path 'elixir-ls)) - "language_server.bat") - ,@(cl-rest lsp-elixir-server-command)))) - :major-modes '(elixir-mode) - :priority -1 - :server-id 'elixir-ls - :action-handlers (ht ("elixir.lens.test.run" 'lsp-elixir--run-test)) - :initialized-fn (lambda (workspace) - (with-lsp-workspace workspace - (lsp--set-configuration - (lsp-configuration-section "elixirLS"))) - (puthash - "textDocumentSync" - (ht ("save" t) - ("change" 2)) - (lsp--workspace-server-capabilities workspace))))) - -(lsp-consistency-check lsp-elixir) - -(provide 'lsp-elixir) -;;; lsp-elixir.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-elm.el b/elpa/lsp-mode-20220201.852/lsp-elm.el deleted file mode 100644 index 55f9f279..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-elm.el +++ /dev/null @@ -1,137 +0,0 @@ -;;; lsp-elm.el --- Elm Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Daniel V - -;; Author: Daniel V -;; Keywords: elm 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 . - -;;; Commentary: - -;; lsp-elm client - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-elm nil - "LSP support for the Elm programming language, using the server from https://github.com/elm-tooling/elm-language-server" - :group 'lsp-mode - :link '(url-link "https://github.com/elm-tooling/elm-language-server")) - -(defcustom lsp-elm-elm-language-server-path nil - "Path for elm-language-server. -Can be installed globally with: npm i -g @elm-tooling/elm-language-server, -or manually by cloning the repo and following the installing instructions." - :group 'lsp-elm - :risky t - :type 'file) - -(defcustom lsp-elm-trace-server - nil - "Enable/disable trace logging of client and server communication." - :type 'boolean - :group 'lsp-elm) - -(defcustom lsp-elm-elm-path - "" - "The path to your elm executable. - -Should be empty by default, in that case it will assume the name and try -to first get it from a local npm installation or a global one. If you -set it manually it will not try to load from the npm folder." - :type 'file - :group 'lsp-elm) - -(defcustom lsp-elm-elm-format-path - "" - "The path to your elm-format executable. - -Should be empty by default, in that case it will assume the name and try -to first get it from a local npm installation or a global one. If you -set it manually it will not try to load from the npm folder." - :type 'file - :group 'lsp-elm) - -(defcustom lsp-elm-elm-test-path - "" - "The path to your elm-test executable. - -Should be empty by default, in that case it will assume the name and try -to first get it from a local npm installation or a global one. If you -set it manually it will not try to load from the npm folder." - :type 'file - :group 'lsp-elm) - -(defcustom lsp-elm-disable-elmls-diagnostics - nil - "Enable/Disable linting diagnostics from the language server." - :type 'boolean - :group 'lsp-elm) - -(defcustom lsp-elm-only-update-diagnostics-on-save - nil - "Only update compiler diagnostics on save, not on document change." - :type 'boolean - :group 'lsp-elm) - -(defcustom lsp-elm-skip-install-package-confirmation - nil - "Skip confirmation for the Install Package code action." - :type 'boolean - :group 'lsp-elm) - -(defcustom lsp-elm-server-args - '("--stdio") - "Arguments to pass to the server." - :type '(repeat string) - :group 'lsp-elm) - -(defun lsp-elm--elm-language-server-command () - "Generate LSP startup command for the Elm Language Server." - (cons - (or lsp-elm-elm-language-server-path - (lsp-package-path 'elm-language-server)) - lsp-elm-server-args)) - -(defun lsp-clients-elm--make-init-options () - "Init options for elm-language-server." - `(:elmPath ,lsp-elm-elm-path - :elmFormatPath ,lsp-elm-elm-format-path - :elmTestPath ,lsp-elm-elm-test-path - :disableElmLSDiagnostics ,(lsp-json-bool lsp-elm-disable-elmls-diagnostics) - :onlyUpdateDiagnosticsOnSave ,(lsp-json-bool lsp-elm-only-update-diagnostics-on-save) - :skipInstallPackageConfirmation ,(lsp-json-bool lsp-elm-skip-install-package-confirmation) - :trace.server ,(lsp-json-bool lsp-elm-trace-server))) - -(lsp-dependency 'elm-language-server - '(:system "elm-language-server") - '(:npm :package "@elm-tooling/elm-language-server" - :path "elm-language-server")) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection #'lsp-elm--elm-language-server-command) - :major-modes '(elm-mode) - :priority -1 - :initialization-options #'lsp-clients-elm--make-init-options - :server-id 'elm-ls - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'elm-language-server callback error-callback)))) - -(lsp-consistency-check lsp-elm) - -(provide 'lsp-elm) -;;; lsp-elm.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-erlang.el b/elpa/lsp-mode-20220201.852/lsp-erlang.el deleted file mode 100644 index 2deae834..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-erlang.el +++ /dev/null @@ -1,67 +0,0 @@ -;;; lsp-erlang.el --- Erlang Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Roberto Aloi - -;; Author: Roberto Aloi -;; Keywords: erlang 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 . - -;;; Commentary: - -;; lsp-erlang client - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-erlang nil - "LSP support for the Erlang programming language, using erlang-ls" - :group 'lsp-mode - :link '(url-link "https://github.com/erlang-ls/erlang_ls")) - -(defcustom lsp-erlang-server-path - "erlang_ls" - "Path to the Erlang Language Server binary." - :group 'lsp-erlang - :risky t - :type 'file) - -(defcustom lsp-erlang-server-connection-type - 'stdio - "Type of connection to use with the Erlang Language Server: tcp or stdio" - :group 'lsp-erlang - :risky t - :type 'symbol) - -(defun lsp-erlang-server-start-fun (port) - `(,lsp-erlang-server-path - "--transport" "tcp" - "--port" ,(number-to-string port))) - -(defun lsp-erlang-server-connection () - (if (eq lsp-erlang-server-connection-type 'tcp) - (lsp-tcp-connection 'lsp-erlang-server-start-fun) - (lsp-stdio-connection `(,lsp-erlang-server-path "--transport" "stdio")))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-erlang-server-connection) - :major-modes '(erlang-mode) - :priority -1 - :server-id 'erlang-ls)) - -(lsp-consistency-check lsp-erlang) - -(provide 'lsp-erlang) -;;; lsp-erlang.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-eslint.el b/elpa/lsp-mode-20220201.852/lsp-eslint.el deleted file mode 100644 index 74df3ddc..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-eslint.el +++ /dev/null @@ -1,408 +0,0 @@ -;;; lsp-eslint.el --- lsp-mode eslint integration -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Ivan Yonchovski - -;; Author: Ivan Yonchovski -;; 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 . - -;;; 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-2.2.2.vsix?raw=true" - "Eslint language server download url." - :type 'string - :group 'lsp-eslint - :package-version '(lsp-mode . "8.0.1")) - -(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 nodejs." - :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 - http://eslint.org/docs/developer-guide/nodejs-api#cliengine)." - :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 [] - "" - :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 - (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)) - :rulesCustomizations lsp-eslint-rules-customizations - :run lsp-eslint-run - :nodePath lsp-eslint-node-path - :workspaceFolder (list :uri (lsp--path-to-uri workspace-folder) - :name (f-filename workspace-folder))))))) - (apply #'vector))) - -(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 '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/elpa/lsp-mode-20220201.852/lsp-fortran.el b/elpa/lsp-mode-20220201.852/lsp-fortran.el deleted file mode 100644 index c9ffb7a5..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-fortran.el +++ /dev/null @@ -1,61 +0,0 @@ -;;; lsp-fortran.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, fortran - -;; 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 . - -;;; Commentary: - -;; LSP Clients for the Fortran Programming Language. - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-fortran nil - "LSP support for Fortran, using the Fortran Language Server." - :group 'lsp-mode - :link '(url-link "https://github.com/hansec/fortran-language-server")) - -(defcustom lsp-clients-fortls-executable "fortls" - "The fortls executable to use. -Leave as just the executable name to use the default behavior of -finding the executable with `exec-path'." - :group 'lsp-fortran - :risky t - :type 'file) - -(defcustom lsp-clients-fortls-args '() - "Extra arguments for the fortls executable" - :group 'lsp-fortran - :risky t - :type '(repeat string)) - -(defun lsp-clients--fortls-command () - "Generate the language server startup command." - `(,lsp-clients-fortls-executable,@lsp-clients-fortls-args)) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection 'lsp-clients--fortls-command) - :major-modes '(f90-mode fortran-mode) - :priority -1 - :server-id 'fortls)) - -(lsp-consistency-check lsp-fortran) - -(provide 'lsp-fortran) -;;; lsp-fortran.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-fsharp.el b/elpa/lsp-mode-20220201.852/lsp-fsharp.el deleted file mode 100644 index 2668b48a..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-fsharp.el +++ /dev/null @@ -1,331 +0,0 @@ -;;; lsp-fsharp.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Reed Mullanix - -;; Author: Reed Mullanix -;; 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 . - -;;; Commentary: - -;; lsp-fsharp client - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-fsharp nil - "LSP support for the F# Programming Language, using the FsharpAutoComplete server." - :link '(url-link "https://github.com/fsharp/FsAutoComplete") - :group 'lsp-mode - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-fsharp-server-runtime 'net-core - "The .NET runtime to use." - :group 'lsp-fsharp - :type '(choice (const :tag "Use .Net Core" net-core) - (const :tag "Use Mono" mono) - (const :tag "Use .Net Framework" net-framework)) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-fsharp-server-install-dir (f-join lsp-server-install-dir "fsautocomplete/") - "Install directory for fsautocomplete server. -The slash is expected at the end." - :group 'lsp-fsharp - :risky t - :type 'directory - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-fsharp-server-args nil - "Extra arguments for the F# language server." - :type '(repeat string) - :group 'lsp-fsharp - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-fsharp-keywords-autocomplete t - "Provides keywords in autocomplete list." - :group 'lsp-fsharp - :type 'bool - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-fsharp-external-autocomplete nil - "Provides autocompletion for symbols from not opened namespaces/modules; -inserts open on accept." - :group 'lsp-fsharp - :type 'bool - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-fsharp-linter t - "Enables FSharpLint integration, provides additional warnings and code -action fixes." - :group 'lsp-fsharp - :type 'bool - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-fsharp-union-case-stub-generation t - "Enables a code action to generate pattern matching cases." - :group 'lsp-fsharp - :type 'bool - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-fsharp-union-case-stub-generation-body "failwith \"Not Implemented\"" - "Defines dummy body used by pattern matching generator." - :group 'lsp-fsharp - :type 'string - :risky t - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-fsharp-record-stub-generation t - "Enables code action to generate record stub." - :group 'lsp-fsharp - :type 'bool - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-fsharp-record-stub-generation-body "failwith \"Not Implemented\"" - "Defines dummy body used by record stub generator." - :group 'lsp-fsharp - :type 'string - :risky t - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-fsharp-interface-stub-generation t - "Enables code action to generate an interface stub." - :group 'lsp-fsharp - :type 'bool - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-fsharp-interface-stub-generation-object-identifier "this" - "Defines object identifier used by interface stub generator, -e.g. `this' or `self'." - :group 'lsp-fsharp - :type 'string - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-fsharp-interface-stub-generation-method-body "failwith \"Not Implemented\"" - "Defines dummy body used by interface stub generator." - :group 'lsp-fsharp - :type 'string - :risky t - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-fsharp-unused-opens-analyzer t - "Enables unused open detection." - :group 'lsp-fsharp - :type 'bool - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-fsharp-unused-declarations-analyzer t - "Enables unused symbol detection." - :group 'lsp-fsharp - :type 'bool - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-fsharp-simplify-name-analyzer nil - "Enables simplify name analyzer and remove redundant qualifier quick fix." - :group 'lsp-fsharp - :type 'bool - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-fsharp-resolve-namespaces t - "Enables resolve namespace quick fix; adds `open' if symbol is from not yet -opened module/namespace." - :group 'lsp-fsharp - :type 'bool - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-fsharp-enable-reference-code-lens t - "Enables reference count code lenses. -It is recommended to disable if `--backgorund-service-enabled' is not used." - :group 'lsp-fsharp - :type 'bool - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-fsharp-auto-workspace-init nil - "Enable automatic workspace initialization. -Do note that this can cause unexpected or challenging behaviors, as solutions -with test projects are not autoloaded by FSharpAutoComplete." - :group 'lsp-fsharp - :type 'bool - :risky t) - -(defun lsp-fsharp--fsac-runtime-cmd () - "Get the command required to run fsautocomplete based off of the -current runtime." - (pcase lsp-fsharp-server-runtime - ('net-core "dotnet") - ('mono "mono") - ('net-framework nil))) - -(defun lsp-fsharp--fsac-cmd () - "The location of fsautocomplete executable." - (let ((file-ext (if (eq lsp-fsharp-server-runtime 'net-core) - ".dll" - ".exe"))) - (expand-file-name (concat "fsautocomplete" file-ext) lsp-fsharp-server-install-dir))) - -(defun lsp-fsharp--version-list-latest (lst) - "Return latest version from LST (if any)." - (->> lst - (-map (lambda (x) (car (s-split " " x)))) - (-filter (lambda (x) (> (length x) 0))) - (-sort (lambda (a b) (not (version<= (substring a 1) - (substring b 1))))) - cl-first)) - -(defun lsp-fsharp--fetch-json (url) - "Retrieve and parse JSON from URL." - (with-temp-buffer - (url-insert-file-contents url) - (let ((json-false :false)) - (json-read)))) - -(defun lsp-fsharp--latest-version-from-github () - "Return latest version of the server available from github." - (lsp-fsharp--version-list-latest - (seq-map (lambda (elt) (s-trim (cdr (assq 'name elt)))) - (lsp-fsharp--fetch-json "https://api.github.com/repos/fsharp/FsAutoComplete/releases")))) - -(defun lsp-fsharp--server-download-url (version) - "Return url for .zip file to download for given VERSION, depending on `lsp-fsharp-server-runtime'." - (concat "https://github.com/fsharp/FsAutoComplete/releases/download" - "/" version - "/" (if (eq lsp-fsharp-server-runtime 'net-core) - "fsautocomplete.netcore.zip" - "fsautocomplete.zip"))) - -(defun lsp-fsharp--change-permissions (install-dir-full) - (unless (eq system-type 'windows-nt) ; Windows does not have chmod - (lsp--info "Altering permissions") - (dolist (file (directory-files-recursively install-dir-full "")) - (if (file-directory-p file) - (chmod file #o755) - (chmod file #o644))) - (lsp--info "Finished altering permissions"))) - -(defun lsp-fsharp--fsac-install (_client callback _error-callback _update?) - "Download the latest version of fsautocomplete and extract it to `lsp-fsharp-server-install-dir'." - (let* ((temp-file (make-temp-file "fsautocomplete" nil ".zip")) - (install-dir-full (expand-file-name lsp-fsharp-server-install-dir)) - (unzip-script (cond ((executable-find "unzip") (format "mkdir -p %s && unzip -qq %s -d %s" install-dir-full temp-file install-dir-full)) - ((executable-find "powershell") (format "powershell -noprofile -noninteractive -nologo -ex bypass Expand-Archive -path '%s' -dest '%s'" temp-file install-dir-full)) - (t (user-error (format "Unable to unzip server - file %s cannot be extracted, please extract it manually" temp-file))))) - (latest-version (lsp-fsharp--latest-version-from-github)) - (server-download-url (lsp-fsharp--server-download-url latest-version))) - (url-copy-file server-download-url temp-file t) - (shell-command unzip-script) - (lsp-fsharp--change-permissions install-dir-full) - (shell-command (format "%s %s --version" (lsp-fsharp--fsac-runtime-cmd) (lsp-fsharp--fsac-cmd))) - (funcall callback))) - -(defun lsp-fsharp-update-fsac () - "Update fsautocomplete to the latest version." - (interactive) - (-let [install-dir (f-expand lsp-fsharp-server-install-dir)] - (f-delete install-dir t) - (lsp-fsharp--fsac-install nil #'ignore #'lsp--error t))) - -(defun lsp-fsharp--make-launch-cmd () - "Build the command required to launch fsautocomplete." - (append (list (lsp-fsharp--fsac-runtime-cmd) (lsp-fsharp--fsac-cmd) "--background-service-enabled") - lsp-fsharp-server-args)) - -(defun lsp-fsharp--project-list () - "Get the list of files we need to send to fsharp/workspaceLoad." - (let* ((response (lsp-request "fsharp/workspacePeek" - `(:directory ,(lsp-workspace-root) - :deep 10 - :excludedDirs ["paket-files" ".git" "packages" "node_modules"]))) - (data (lsp--read-json (lsp-get response :content))) - (found (-> data (lsp-get :Data) (lsp-get :Found))) - (directory (seq-find (lambda (d) (equal "directory" (lsp-get d :Type))) found))) - (-> directory (lsp-get :Data) (lsp-get :Fsprojs)))) - -;;;###autoload -(defun lsp-fsharp--workspace-load (projects) - "Load all of the provided PROJECTS." - (lsp-request-async "fsharp/workspaceLoad" - `(:textDocuments ,(vconcat [] (mapcar (lambda (p) `(:uri ,p)) projects))) - (lambda (_) - (lsp--info "Workspace Loaded!")))) - -(defvar lsp-fsharp--default-init-options (list) - "Default init options to be passed to FSharpAutoComplete, - updated conditionally by `lsp-fsharp--make-init-options'.") - -(defun lsp-fsharp--make-init-options () - "Init options for F#." - (-let [opts lsp-fsharp--default-init-options] - (if lsp-fsharp-auto-workspace-init - (push '(:AutomaticWorkspaceInit . t) opts) - opts))) - -(lsp-register-custom-settings - `(("FSharp.KeywordsAutocomplete" lsp-fsharp-keywords-autocomplete t) - ("FSharp.ExternalAutocomplete" lsp-fsharp-external-autocomplete t) - ("FSharp.Linter" lsp-fsharp-linter t) - ("FSharp.UnionCaseStubGeneration" lsp-fsharp-union-case-stub-generation t) - ("FSharp.UnionCaseStubGenerationBody" lsp-fsharp-union-case-stub-generation-body) - ("FSharp.RecordStubGeneration" lsp-fsharp-record-stub-generation t) - ("FSharp.RecordStubGenerationBody" lsp-fsharp-record-stub-generation-body) - ("FSharp.InterfaceStubGeneration" lsp-fsharp-interface-stub-generation t) - ("FSharp.InterfaceStubGenerationObjectIdentifier" lsp-fsharp-interface-stub-generation-object-identifier) - ("FSharp.InterfaceStubGenerationMethodBody" lsp-fsharp-interface-stub-generation-method-body) - ("FSharp.UnusedOpensAnalyzer" lsp-fsharp-unused-opens-analyzer t) - ("FSharp.UnusedDeclarationsAnalyzer" lsp-fsharp-unused-declarations-analyzer t) - ("FSharp.SimplifyNameAnalyzer" lsp-fsharp-simplify-name-analyzer t) - ("FSharp.ResolveNamespaces" lsp-fsharp-resolve-namespaces t) - ("FSharp.EnableReferenceCodeLens" lsp-fsharp-enable-reference-code-lens t))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection - #'lsp-fsharp--make-launch-cmd - (lambda () (f-exists? (lsp-fsharp--fsac-cmd)))) - :major-modes '(fsharp-mode) - :notification-handlers (ht ("fsharp/notifyCancel" #'ignore) - ("fsharp/notifyWorkspace" #'ignore) - ("fsharp/fileParsed" #'ignore) - ("fsharp/notifyWorkspacePeek" #'ignore)) - :initialization-options 'lsp-fsharp--make-init-options - :initialized-fn (lambda (workspace) - (with-lsp-workspace workspace - ;; Something needs to be calling lsp--set-configuration - (progn - (lsp--set-configuration - (lsp-configuration-section "fsharp")) - (lsp-fsharp--workspace-load - (lsp-fsharp--project-list))))) - :after-open-fn ;; workaround https://github.com/fsharp/FsAutoComplete/issues/833 - (lambda () - (setq-local lsp-default-create-error-handler-fn - (lambda (method) - (lambda (error) - (when - (not - (seq-find (lambda (s) - (string= s (lsp-get error :message))) - '("Index was outside the bounds of the array." - "No symbol information found" - "No ident at this location"))) - (lsp--warn - "%s" - (or (lsp--error-string error) - (format "%s Request has failed" method)))))))) - :server-id 'fsac - :download-server-fn #'lsp-fsharp--fsac-install)) - -(lsp-consistency-check lsp-fsharp) - -(provide 'lsp-fsharp) -;;; lsp-fsharp.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-gdscript.el b/elpa/lsp-mode-20220201.852/lsp-gdscript.el deleted file mode 100644 index 4a52ec8b..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-gdscript.el +++ /dev/null @@ -1,61 +0,0 @@ -;;; lsp-gdscript.el --- LSP mode -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 Oliver Frank - -;; Author: Oliver Frank -;; 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 . - -;;; Commentary: - -;; lsp-gdscript client - -;;; Code: -(require 'lsp-mode) - -(defgroup lsp-gdscript nil - "LSP support for GDScript, using godot's language server." - :group 'lsp-mode - :link '(url-link "https://github.com/godotengine/godot") - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-gdscript-port 6008 - "Port to connect server to" - :type 'integer - :group 'lsp-gdscript) - -(defun lsp-gdscript-tcp-connect-to-port () - (list - :connect (lambda (filter sentinel name _environment-fn) - (let* ((host "localhost") - (port lsp-gdscript-port) - (tcp-proc (lsp--open-network-stream host port (concat name "::tcp")))) - - (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-gdscript-tcp-connect-to-port) - :major-modes '(gdscript-mode) - :server-id 'gdscript)) - - -(lsp-consistency-check lsp-gdscript)(provide 'lsp-gdscript) - - -;;; lsp-gdscript.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-go.el b/elpa/lsp-mode-20220201.852/lsp-go.el deleted file mode 100644 index 874b5764..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-go.el +++ /dev/null @@ -1,337 +0,0 @@ -;;; lsp-go.el --- Go Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Muir Manders - -;; Author: Muir Manders -;; 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 . - -;;; 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 nil - "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-string-vector - :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 (lgeacy)") - (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) - "Returns a list suitable for the `:type' field in a `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 '(repeat 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") - (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 "Fuzzy" - "Sets the algorithm that is used when finding workspace symbols." - :type '(choice (const "Fuzzy") - (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")) - -(lsp-register-custom-settings - '(("gopls.usePlaceholders" lsp-go-use-placeholders t) - ("gopls.hoverKind" lsp-go-hover-kind) - ("gopls.buildFlags" lsp-go-build-flags) - ("gopls.env" lsp-go-env) - ("gopls.linkTarget" lsp-go-link-target) - ("gopls.codelenses" lsp-go-codelenses) - ("gopls.linksInHover" lsp-go-links-in-hover t) - ("gopls.gofumpt" lsp-go-use-gofumpt t) - ("gopls.local" lsp-go-goimports-local) - ("gopls.directoryFilters" lsp-go-directory-filters) - ("gopls.analyses" lsp-go-analyses) - ("gopls.importShortcut" lsp-go-import-shortcut) - ("gopls.symbolMatcher" lsp-go-symbol-matcher) - ("gopls.symbolStyle" lsp-go-symbol-style))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection - (lambda () (cons lsp-go-gopls-server-path lsp-go-gopls-server-args))) - :major-modes '(go-mode go-dot-mod-mode) - :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/elpa/lsp-mode-20220201.852/lsp-graphql.el b/elpa/lsp-mode-20220201.852/lsp-graphql.el deleted file mode 100644 index 3b1bfba7..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-graphql.el +++ /dev/null @@ -1,73 +0,0 @@ -;;; lsp-graphql.el --- lsp client for graphql -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 Binbin Ye - -;; Author: Binbin Ye -;; Keywords: lsp, graphql - -;; 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 . - -;;; Commentary: - -;; Support for running graphql lsp. Support multiple server running at the same time when editing tsx/jsx. - -;;; Code: - -(require 'lsp-mode) - -(lsp-dependency 'graphql-language-service-cli - '(:npm :package "graphql-language-service-cli" - :path "graphql-lsp")) - - -(defgroup lsp-graphql nil - "LSP support for the GraphQL, using the graphql-language-service-cli as language server." - :link '(url-link "https://github.com/graphql/graphiql/tree/main/packages/graphql-language-service-cli#readme") - :group 'lsp-mode) - -(defcustom lsp-clients-graphql-server-args '("server" "--method=stream") - "CLI arguments for graphql language server." - :type '(repeat string) - :risky t - :group 'lsp-graphql) - -(defun lsp-graphql-activate-p (filename &optional _) - "Check if the GraphQL language server should be enabled based on FILENAME." - (or (string-match-p (rx (one-or-more anything) "." - (or "ts" "js" "jsx" "tsx" "vue" "graphql" "gql")eos) - filename) - (and (derived-mode-p 'js-mode 'js2-mode 'typescript-mode) - (not (derived-mode-p 'json-mode))))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection (lambda() - (cons (lsp-package-path 'graphql-language-service-cli) - lsp-clients-graphql-server-args))) - :major-modes '(graphql-mode) - :language-id "graphql" - :server-id 'graphql-lsp - :priority -3 - :add-on? t - :multi-root t - :activation-fn 'lsp-graphql-activate-p - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure - 'graphql-language-service-cli - callback - error-callback)))) - -(lsp-consistency-check lsp-graphql) - -(provide 'lsp-graphql) -;;; lsp-graphql.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-groovy.el b/elpa/lsp-mode-20220201.852/lsp-groovy.el deleted file mode 100644 index c1fcaaf8..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-groovy.el +++ /dev/null @@ -1,66 +0,0 @@ -;;; lsp-groovy.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, groovy - -;; 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 . - -;;; Commentary: - -;; LSP Clients for the Groovy Programming Language. - -;;; Code: - -(require 'lsp-mode) -(require 'f) - -(defgroup lsp-groovy nil - "LSP support for Groovy, using groovy-language-server." - :group 'lsp-mode - :link '(url-link "https://github.com/prominic/groovy-language-server")) - -(defcustom lsp-groovy-server-file (f-join lsp-server-install-dir "groovy-language-server-all.jar") - "JAR file path for groovy-language-server-all.jar." - :group 'lsp-groovy - :risky t - :type 'file) - -(defun lsp-groovy--lsp-command () - "Generate LSP startup command." - `("java" "-jar" ,(expand-file-name lsp-groovy-server-file))) - -(defcustom lsp-groovy-classpath ["/usr/local/opt/groovy/libexec/lib"] - "List of paths to Groovy JARs." - :group 'lsp-groovy - :risky t - :type 'lsp-string-vector) - -(lsp-register-custom-settings - '(("groovy.classpath" lsp-groovy-classpath))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection 'lsp-groovy--lsp-command) - :major-modes '(groovy-mode) - :priority -1 - :server-id 'groovy-ls - :initialized-fn (lambda (workspace) - (with-lsp-workspace workspace - (lsp--set-configuration (lsp-configuration-section "groovy")))))) - -(lsp-consistency-check lsp-groovy) - -(provide 'lsp-groovy) -;;; lsp-groovy.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-hack.el b/elpa/lsp-mode-20220201.852/lsp-hack.el deleted file mode 100644 index 161659a4..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-hack.el +++ /dev/null @@ -1,54 +0,0 @@ -;;; lsp-xxx.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, hack - -;; 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 . - -;;; Commentary: - -;; LSP Clients for the Hack Programming Language. - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-hack nil - "LSP support for Hack, using HHVM." - :group 'lsp-mode - :link '(url-link "https://docs.hhvm.com/hhvm")) - -(defcustom lsp-clients-hack-command '("hh_client" "lsp" "--from" "emacs") - "Command to start hh_client." - :group 'lsp-hack - :risky t - :type '(repeat string)) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection (lambda () lsp-clients-hack-command)) - :major-modes '(hack-mode) - :priority -1 - :server-id 'hack - ;; ignore some unsupported messages from Nuclide - :notification-handlers (lsp-ht ("telemetry/event" 'ignore) - ("$/cancelRequest" 'ignore)) - :request-handlers (lsp-ht ("window/showStatus" 'ignore)))) - - -(lsp-consistency-check lsp-hack) - -(provide 'lsp-hack) -;;; lsp-hack.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-haxe.el b/elpa/lsp-mode-20220201.852/lsp-haxe.el deleted file mode 100644 index 62707bed..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-haxe.el +++ /dev/null @@ -1,226 +0,0 @@ -;;; lsp-haxe.el --- Haxe Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Yannik Böttcher - -;; Author: Yannik Böttcher -;; 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 . - -;;; Commentary: - -;; lsp-haxe client - -;;; Code: - - -;; adapted from lsp-clangd configuration -(require 'lsp-protocol) -(require 'lsp-mode) - -(defgroup lsp-haxe nil - "LSP support for Haxe using the language server provided by vshaxe" - :group 'lsp-mode - :link '(url-link "https://github.com/vshaxe/vshaxe")) - - -;; Haxe ls is executed via node -(defcustom lsp-clients--haxe-executable "node" - "Haxe ls is executed via node." - :group 'lsp-haxe - :risky t - :type 'file) - -;; The server.js is being passed to node as an argument -(defcustom lsp-clients--haxe-server-path (expand-file-name "~/.haxe-language-server/bin/server.js") - "The path to the server.js file." - :group 'lsp-haxe - :risky t - :type 'file) - -;; Build the actual Haxe ls command. -(defun lsp-clients--haxe-command () - "Haxe ls startup command." - `(,lsp-clients--haxe-executable ,lsp-clients--haxe-server-path)) - -;; https://github.com/yyoncho/lsp-mode/commit/72186e1adc089d772c87ed8f287eb3333b66bfa7 -;; This is to force the client to send a didChangeConfiguration Message. Without this, the server won't start, https://github.com/vshaxe/vshaxe/issues/328#issuecomment-471809093 -(defcustom lsp-clients--haxe-settings (list :haxe.executable "haxe") - "Lsp clients configuration settings." - :group 'lsp-haxe - :risky t - :type '(repeat string)) - -;; The build spec for the project. -(defcustom lsp-haxe-hxml "build.hxml" - "The compile file for the haxe project." - :type 'file - :group 'lsp-haxe - :package-version '(lsp-mode . "7.0")) - -;; https://github.com/emacs-lsp/lsp-mode/blob/150a933694349df960dc8fd7a15e04f5727e6433/lsp-rust.el#L251 -(lsp-defun lsp-clients--haxe-processStart (_workspace (&haxe:ProcessStartNotification :title)) - "Handle processStart notification. Just logs PARAMS." - (lsp-log title)) - -(defcustom lsp-haxe-executable "haxe" - nil - :type 'file - :group 'lsp-haxe) - -(defcustom lsp-haxe-configurations nil - nil - :type '(repeat string) - :group 'lsp-haxe) - -(defcustom lsp-haxe-display-configurations nil - nil - :type '(repeat string) - :group 'lsp-haxe) - -(defcustom lsp-haxe-display-server nil - nil - :type 'string - :group 'lsp-haxe) - -(defcustom lsp-haxe-display-port "auto" - nil - :type 'number - :group 'lsp-haxe) - -(defcustom lsp-haxe-enable-compilation-server t - nil - :type 'boolean - :group 'lsp-haxe) - -(defcustom lsp-haxe-task-presentation - '((echo . t) - (reveal . "always") - (focus . :json-false) - (panel . "shared") - (showReuseMessage . t) - (clear . :json-false)) - nil - :type 'plist - :group 'lsp-haxe) - -(defcustom lsp-haxe-enable-code-lens t - nil - :type 'boolean - :group 'lsp-haxe) - -(defcustom lsp-haxe-enable-diagnostics t - nil - :type 'boolean - :group 'lsp-haxe) - -(defcustom lsp-haxe-enable-server-view nil - nil - :type 'boolean - :group 'lsp-haxe) - -(defcustom lsp-haxe-enable-methods-view nil - nil - :type 'boolean - :group 'lsp-haxe) - -(defcustom lsp-haxe-enable-signature-help-documentation t - nil - :type 'boolean - :group 'lsp-haxe) - -(defcustom lsp-haxe-diagnostics-path-filter "${workspaceRoot}" - nil - :type 'string - :group 'lsp-haxe) - -(defcustom lsp-haxe-build-completion-cache t - nil - :type 'boolean - :group 'lsp-haxe) - -(defcustom lsp-haxe-enable-completion-cache-warning t - nil - :type 'boolean - :group 'lsp-haxe) - -(defcustom lsp-haxe-code-generation nil - nil - :type 'string - :group 'lsp-haxe) - -(defcustom lsp-haxe-exclude ["zpp_nape"] - nil - :type '(repeat string) - :group 'lsp-haxe) - -(defcustom lsp-haxe-postfix-completion nil - nil - :type 'string - :group 'lsp-haxe) - -(lsp-register-custom-settings - '(("haxe.hxml" lsp-haxe-hxml) - ("haxe.postfixCompletion" lsp-haxe-postfix-completion) - ("haxe.exclude" lsp-haxe-exclude) - ("haxe.codeGeneration" lsp-haxe-code-generation) - ("haxe.enableCompletionCacheWarning" lsp-haxe-enable-completion-cache-warning t) - ("haxe.buildCompletionCache" lsp-haxe-build-completion-cache t) - ("haxe.diagnosticsPathFilter" lsp-haxe-diagnostics-path-filter) - ("haxe.enableSignatureHelpDocumentation" lsp-haxe-enable-signature-help-documentation t) - ("haxe.enableMethodsView" lsp-haxe-enable-methods-view t) - ("haxe.enableServerView" lsp-haxe-enable-server-view t) - ("haxe.enableDiagnostics" lsp-haxe-enable-diagnostics t) - ("haxe.enableCodeLens" lsp-haxe-enable-code-lens t) - ("haxe.taskPresentation" lsp-haxe-task-presentation) - ("haxe.enableCompilationServer" lsp-haxe-enable-compilation-server t) - ("haxe.displayPort" lsp-haxe-display-port) - ("haxe.displayServer" lsp-haxe-display-server) - ("haxe.displayConfigurations" lsp-haxe-display-configurations) - ("haxe.configurations" lsp-haxe-configurations) - ("haxe.executable" lsp-haxe-executable))) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection #'lsp-clients--haxe-command) - :major-modes '(haxe-mode) ; force didChangeConfiguration message - :initialized-fn - (lambda (workspace) - (with-lsp-workspace workspace - (lsp--set-configuration (lsp-configuration-section "haxe")))) - :priority -1 - :server-id 'haxe - :initialization-options - (lambda () - `(:sendMethodResults t - :haxelibConfig (:executable "haxelib") - :displayServerConfig - ( :print (:reusing :json-false :completion :json-false) - :arguments [] - :env nil - :path "haxe") - :displayArguments [,lsp-haxe-hxml])) - :notification-handlers - (lsp-ht ("haxe/progressStart" 'lsp-clients--haxe-processStart) - ("haxe/progressStop" 'ignore) - ("haxe/didDetectOldPreview" 'ignore) - ("haxe/didChangeDisplayPort" 'ignore) - ("haxe/didRunHaxeMethod" 'ignore) - ("haxe/didChangeRequestQueue" 'ignore) - ("haxe/cacheBuildFailed" 'ignore)))) - -(lsp-consistency-check lsp-haxe) - -(provide 'lsp-haxe) -;;; lsp-haxe.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-headerline.el b/elpa/lsp-mode-20220201.852/lsp-headerline.el deleted file mode 100644 index 50063cfc..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-headerline.el +++ /dev/null @@ -1,473 +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 . -;; -;;; 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-local lsp-headerline--string nil - "Holds the current breadcrumb string on 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.") - -(defun lsp-headerline--arrow-icon () - "Build the arrow icon for headerline breadcrumb." - (or - lsp-headerline-arrow - (setq lsp-headerline-arrow (lsp-icons-all-the-icons-material-icon - "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-workspace-root)) - (propertize (lsp-headerline--directory-with-action - root - (f-filename root)) - 'font-lock-face - 'lsp-headerline-breadcrumb-project-prefix-face) - (propertize "" - '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 severiy 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-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 (eq 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." - (setq 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)) - -;;;###autoload -(define-minor-mode lsp-headerline-breadcrumb-mode - "Toggle breadcrumb on headerline." - :group 'lsp-headerline - :global nil - (cond - (lsp-headerline-breadcrumb-mode - (add-to-list 'header-line-format '(t (:eval 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 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/elpa/lsp-mode-20220201.852/lsp-html.el b/elpa/lsp-mode-20220201.852/lsp-html.el deleted file mode 100644 index 0b44e16d..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-html.el +++ /dev/null @@ -1,198 +0,0 @@ -;;; lsp-html.el --- vscode-html-languageserver configuration -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Vibhav Pant - -;; Author: Vibhav Pant -;; 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 . - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-html nil - "LSP support for HTML, using vscode-html-languageserver." - :group 'lsp-mode - :link '(url-link "https://github.com/vscode-langservers/vscode-html-languageserver") - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-html-experimental-custom-data nil - "A list of JSON file paths that define custom tags, properties and other HTML -syntax constructs. Only workspace folder setting will be read." - :type '(choice (const nil) string) - :group 'lsp-html - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-html-format-enable t - "Enable/disable default HTML formatter." - :type 'boolean - :group 'lsp-html - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-html-format-wrap-line-length 120 - "Maximum amount of characters per line (0 = disable)." - :type 'number - :group 'lsp-html - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-html-format-unformatted "wbr" - nil - :type '(choice (const nil) string) - :group 'lsp-html - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-html-format-content-unformatted "pre,code,textarea" - nil - :group 'lsp-html - :type '(choice (const nil) string) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-html-format-indent-inner-html nil - nil - :type 'boolean - :group 'lsp-html - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-html-format-preserve-new-lines t - "Controls whether existing line breaks before elements should be preserved. -Only works before elements, not inside tags or for text." - :type 'boolean - :group 'lsp-html - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-html-format-max-preserve-new-lines nil - nil - :type '(choice (const nil) integer) - :group 'lsp-html - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-html-format-indent-handlebars nil nil - :type 'boolean - :group 'lsp-html - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-html-format-end-with-newline nil - "End with a newline." - :type 'boolean - :group 'lsp-html - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-html-format-extra-liners "head, body, /html" - nil - :type '(choice (const nil) string) - :group 'lsp-html - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-html-format-wrap-attributes "auto" - "Wrap attributes." - :type '(choice - (const "auto") - (const "force") - (const "force-aligned") - (const "force-expand-multiline") - (const "aligned-multiple") - (const "preserve") - (const "preserve-aligned")) - :group 'lsp-html - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-html-suggest-html5 t - "Controls whether the built-in HTML language support suggests HTML5 tags, -properties and values." - :type 'boolean - :group 'lsp-html - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-html-validate-scripts t - "Controls whether the built-in HTML language support validates embedded -scripts." - :type 'boolean - :group 'lsp-html - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-html-validate-styles t - "Controls whether the built-in HTML language support validates embedded -styles." - :type 'boolean - :group 'lsp-html - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-html-auto-closing-tags t - "Enable/disable autoclosing of HTML tags." - :type 'boolean - :group 'lsp-html - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-html-trace-server "off" - "Traces the communication between VS Code and the HTML language server." - :type '(choice - (const "off") - (const "messages") - (const "verbose")) - :group 'lsp-html - :package-version '(lsp-mode . "6.1")) - -(lsp-register-custom-settings - '(("html.trace.server" lsp-html-trace-server) - ("html.autoClosingTags" lsp-html-auto-closing-tags t) - ("html.validate.styles" lsp-html-validate-styles t) - ("html.validate.scripts" lsp-html-validate-scripts t) - ("html.suggest.html5" lsp-html-suggest-html5 t) - ("html.format.wrapAttributes" lsp-html-format-wrap-attributes) - ("html.format.extraLiners" lsp-html-format-extra-liners) - ("html.format.endWithNewline" lsp-html-format-end-with-newline t) - ("html.format.indentHandlebars" lsp-html-format-indent-handlebars t) - ("html.format.maxPreserveNewLines" lsp-html-format-max-preserve-new-lines) - ("html.format.preserveNewLines" lsp-html-format-preserve-new-lines t) - ("html.format.indentInnerHtml" lsp-html-format-indent-inner-html t) - ("html.format.contentUnformatted" lsp-html-format-content-unformatted) - ("html.format.unformatted" lsp-html-format-unformatted) - ("html.format.wrapLineLength" lsp-html-format-wrap-line-length) - ("html.format.enable" lsp-html-format-enable t) - ("html.experimental.customData" lsp-html-experimental-custom-data))) - -(defcustom lsp-html-server-command-args '("--stdio") - "Command to start html-languageserver." - :type '(repeat string) - :group 'lsp-html - :package-version '(lsp-mode . "6.3")) - -(lsp-dependency 'html-language-server - '(:system "html-languageserver") - '(:npm :package "vscode-html-languageserver-bin" - :path "html-languageserver")) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection - (lambda () - (cons (lsp-package-path 'html-language-server) - lsp-html-server-command-args))) - :activation-fn (lsp-activate-on "html") - :priority -4 - :completion-in-comments? t - :server-id 'html-ls - :initialized-fn (lambda (w) - (with-lsp-workspace w - (lsp--set-configuration - (lsp-configuration-section "html")))) - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure - 'html-language-server callback - error-callback)))) - -(lsp-consistency-check lsp-html) - -(provide 'lsp-html) -;;; lsp-html.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-icons.el b/elpa/lsp-mode-20220201.852/lsp-icons.el deleted file mode 100644 index 7bd8bc6f..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-icons.el +++ /dev/null @@ -1,96 +0,0 @@ -;;; lsp-icons.el --- LSP icons management -*- 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 . -;; -;;; Commentary: -;; -;; LSP icons management -;; -;;; Code: -(require 'lsp-mode) - -(defgroup lsp-icons nil - "LSP icons" - :group 'lsp-mode - :tag "LSP Icons") - -(defcustom lsp-headerline-breadcrumb-icons-enable t - "If non-nil, icons support is enabled for headerline-breadcrumb." - :type 'boolean - :group 'lsp-icons) - -(declare-function all-the-icons-material "ext:all-the-icons" t t) -(declare-function lsp-treemacs-symbol-icon "ext:lsp-treemacs" (kind)) -(declare-function lsp-treemacs-get-icon "ext:lsp-treemacs" (icon-name)) - -(defun lsp-icons--enabled-for-feature (feature) - "Check if icons support is enabled for FEATURE." - (cond - ((eq feature 'headerline-breadcrumb) lsp-headerline-breadcrumb-icons-enable) - (t t))) - -(defun lsp-icons--fix-image-background (image) - "Fix IMAGE background if it is a file otherwise return as an icon." - (if image - (let ((display-image (get-text-property 0 'display image))) - (if (and (listp display-image) - (plist-member (cl-copy-list (cl-rest display-image)) :type)) - (propertize " " 'display - (cl-list* 'image - (plist-put - (cl-copy-list - (cl-rest display-image)) - :background (face-attribute 'header-line :background nil t)))) - (if (stringp display-image) - (replace-regexp-in-string "\s\\|\t" "" display-image) - (replace-regexp-in-string "\s\\|\t" "" image)))) - "")) - -(defun lsp-icons-get-by-file-ext (file-ext &optional feature) - "Get an icon by file FILE-EXT. -FEATURE is the feature that will use the icon which we should check -if its enabled." - (when (and file-ext - (lsp-icons--enabled-for-feature feature) - (functionp 'lsp-treemacs-get-icon)) - (lsp-icons--fix-image-background - (lsp-treemacs-get-icon file-ext)))) - -(defun lsp-icons-get-by-symbol-kind (kind &optional feature) - "Get an icon by symbol KIND. -FEATURE is the feature that will use the icon which we should check -if its enabled." - (when (and kind - (lsp-icons--enabled-for-feature feature) - (functionp 'lsp-treemacs-symbol-icon)) - (lsp-icons--fix-image-background - (lsp-treemacs-symbol-icon kind)))) - -(defun lsp-icons-all-the-icons-material-icon (icon-name face fallback &optional feature) - "Get a material icon from all-the-icons by ICON-NAME using FACE. -Fallback to FALLBACK string if not found or not available. -FEATURE is the feature that will use the icon which we should check -if its enabled." - (if (and (functionp 'all-the-icons-material) - (lsp-icons--enabled-for-feature feature)) - (all-the-icons-material icon-name - :face face) - (propertize fallback 'face face))) - -(lsp-consistency-check lsp-icons) - -(provide 'lsp-icons) -;;; lsp-icons.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-ido.el b/elpa/lsp-mode-20220201.852/lsp-ido.el deleted file mode 100644 index ac34dd75..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-ido.el +++ /dev/null @@ -1,142 +0,0 @@ -;;; lsp-ido.el --- `ido' integration -*- lexical-binding: t -*- -;; -;; Copyright (C) 2021 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 . - -;;; Commentary: - -;; This module provides an interactive ido interface to the workspace symbol -;; functionality offered by lsp-mode. - -;;; Code: - -(require 'ido) -(require 'lsp-protocol) -(require 'lsp-mode) - -(defgroup lsp-ido nil - "LSP support for ido-based symbol completion" - :group 'lsp-mode - :tag "LSP ido") - -(defcustom lsp-ido-symbol-kind-to-string - [" " ; Unknown - 0 - "File" ; File - 1 - "Modu" ; Module - 2 - "Nmsp" ; Namespace - 3 - "Pack" ; Package - 4 - "Clss" ; Class - 5 - "Meth" ; Method - 6 - "Prop" ; Property - 7 - "Fld " ; Field - 8 - "Cons" ; Constructor - 9 - "Enum" ; Enum - 10 - "Intf" ; Interface - 11 - "Func" ; Function - 12 - "Var " ; Variable - 13 - "Cnst" ; Constant - 14 - "Str " ; String - 15 - "Num " ; Number - 16 - "Bool " ; Boolean - 17 - "Arr " ; Array - 18 - "Obj " ; Object - 19 - "Key " ; Key - 20 - "Null" ; Null - 21 - "EmMm" ; EnumMember - 22 - "Srct" ; Struct - 23 - "Evnt" ; Event - 24 - "Op " ; Operator - 25 - "TPar"] ; TypeParameter - 26 - "A vector of 26 itens representing the SymbolKind." - :group 'lsp-ido - :type 'vector) - -(defcustom lsp-ido-show-symbol-filename - t - "Whether to show the project-relative path to a symbol's point of definition." - :group 'lsp-ido - :type 'boolean) - -(defcustom lsp-ido-show-symbol-kind - t - "Whether to show the symbol's kind when showing lsp symbols." - :group 'lsp-ido - :type 'boolean) - -(eval-when-compile - (lsp-interface - (lsp-ido:FormattedSymbolInformation - (:kind :name :location :textualRepresentation) - (:containerName :deprecated)))) - -(lsp-defun lsp-ido--transform-candidate - ((symbol-information &as &SymbolInformation :kind :location (&Location :uri)) - lsp-ido--results project-root) - (let* ((sanitized-kind (if (< kind (length lsp-ido-symbol-kind-to-string)) kind 0)) - (type (elt lsp-ido-symbol-kind-to-string sanitized-kind)) - (typestr (if lsp-ido-show-symbol-kind - (format "[%s] " type) - "")) - (pathstr (if lsp-ido-show-symbol-filename - (propertize (format " . %s" (file-relative-name (lsp--uri-to-path uri) project-root)) - 'face 'font-lock-comment-face) - "")) - (textual-representation - (lsp-render-symbol-information symbol-information ".")) - (entry (concat typestr textual-representation pathstr))) - (puthash entry symbol-information lsp-ido--results))) - -(lsp-defun lsp-ido--jump-selected-candidate - ((&SymbolInformation - :location (&Location :uri :range (&Range :start (&Position :line :character))))) - "Jump to selected candidate." - (find-file (lsp--uri-to-path uri)) - (goto-char (point-min)) - (forward-line line) - (forward-char character)) - -(defun lsp-ido--workspace-symbol (workspaces query) - "Search against WORKSPACES based on QUERY." - (let* ((lsp-ido--results (make-hash-table :test 'equal)) - (workspace-root (lsp-workspace-root)) - (raw-choices - (with-lsp-workspaces workspaces - (lsp-request - "workspace/symbol" - (lsp-make-workspace-symbol-params :query query))))) - (mapc (lambda (it) - (lsp-ido--transform-candidate it lsp-ido--results workspace-root)) - raw-choices) - lsp-ido--results)) - -;;;###autoload -(defun lsp-ido-workspace-symbol (arg) - "`ido' for lsp workspace/symbol. -When called with prefix ARG the default selection will be symbol at point." - (interactive "P") - (let* ((query (if arg "" (read-string "Workspace symbol: "))) - (hash-table-candidates (lsp-ido--workspace-symbol (lsp-workspaces) query)) - (choice (ido-completing-read - "Workspace symbol: " - (hash-table-keys hash-table-candidates) - nil - nil - (when arg (thing-at-point 'symbol))))) - (lsp-ido--jump-selected-candidate (gethash choice hash-table-candidates)))) - -(lsp-consistency-check lsp-ido) - -(provide 'lsp-ido) -;;; lsp-ido.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-iedit.el b/elpa/lsp-mode-20220201.852/lsp-iedit.el deleted file mode 100644 index 55ae0a94..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-iedit.el +++ /dev/null @@ -1,149 +0,0 @@ -;;; lsp-iedit.el --- `iedit' 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 . - -;;; Commentary: - -;; This module provides features that allow starting `iedit' on various -;; different lsp-based, semantic units (like documentHighlights, and -;; linkedEditingRanges in the future). - -;;; Code: - -(require 'lsp-mode) -(require 'dash) - -(declare-function iedit-make-occurrence-overlay "iedit-lib" (begin end)) -(declare-function iedit-start-buffering "iedit-lib" ()) -(declare-function iedit-lib-start "iedit-lib" (mode-exit-func)) -(declare-function iedit-done "iedit" ()) -(declare-function evil-multiedit-mode "evil-multiedit" (mode)) -(declare-function evil-iedit-state "evil-iedit-state" ()) - -(defvar iedit-mode) -(defvar iedit-auto-buffering) -(defvar iedit-occurrences-overlays) -(defvar iedit-occurrence-keymap) -(defvar iedit-mode-occurrence-keymap) -(defvar evil-multiedit--dont-recall) - -(defun lsp-iedit--on-ranges (ranges) - "Start an `iedit' operation using RANGES. -RANGES shall be a list of lsp-`&Range's. They can be acquired -from various lsp protocol requests, e.g. -`textDocument/documentHighlight', ...." - (require 'iedit) - (unless (seq-empty-p ranges) - (mapc (-lambda ((&RangeToPoint :start :end)) - (push (iedit-make-occurrence-overlay start end) - iedit-occurrences-overlays)) - ranges) - ;; See `iedit-start'; TODO: upstream this - (setq iedit-occurrence-keymap iedit-mode-occurrence-keymap) - (setq iedit-mode t) - (when iedit-auto-buffering - (iedit-start-buffering)) - (iedit-lib-start 'iedit-done) - (run-hooks 'iedit-mode-hook) - (add-hook 'before-revert-hook 'iedit-done nil t) - (add-hook 'kbd-macro-termination-hook 'iedit-done nil t) - (add-hook 'change-major-mode-hook 'iedit-done nil t) - (add-hook 'iedit-aborting-hook 'iedit-done nil t) - (message "%d occurrences of \"%s\"" - (seq-length ranges) - (lsp--range-text (lsp-seq-first ranges))))) - -;; iedit - -;;;###autoload -(defun lsp-iedit-highlights () - "Start an `iedit' operation on the documentHighlights at point. -This can be used as a primitive `lsp-rename' replacement if the -language server doesn't support renaming. - -See also `lsp-enable-symbol-highlighting'." - (interactive) - (let ((highlights (lsp-request "textDocument/documentHighlight" - (lsp--text-document-position-params))) - (-compare-fn (-lambda ((&Location :range (&Range :start l-start :end l-end)) - (&Location :range (&Range :start r-start :end r-end))) - (and (lsp--position-equal l-start r-start) - (lsp--position-equal l-end r-end))))) - (lsp-iedit--on-ranges (mapcar #'lsp:document-highlight-range (-distinct highlights))))) - -;;;###autoload -(defun lsp-iedit-linked-ranges () - "Start an `iedit' for `textDocument/linkedEditingRange'" - (interactive) - (unless (lsp-feature? "textDocument/linkedEditingRange") - (user-error "`textDocument/linkedEditingRange' is not supported by current server")) - - (-> (lsp-request "textDocument/linkedEditingRange" (lsp--text-document-position-params)) - (lsp:linked-editing-ranges-ranges) - (or (user-error "No editing ranges found")) - (lsp-iedit--on-ranges))) - - -;; evil-multi-edit - -;;;###autoload -(defun lsp-evil-multiedit-highlights () - "Start an `evil-multiedit' operation on the documentHighlights at point. -This can be used as a primitive `lsp-rename' replacement if the -language server doesn't support renaming. - -See also `lsp-enable-symbol-highlighting'." - (interactive) - (require 'evil-multiedit) - (when (fboundp 'ahs-clear) (ahs-clear)) - (setq evil-multiedit--dont-recall t) - (lsp-iedit-highlights) - (evil-multiedit-mode +1)) - -;;;###autoload -(defun lsp-evil-multiedit-linked-ranges () - "Start an `evil-multiedit' for `textDocument/linkedEditingRange'" - (interactive) - (require 'evil-multiedit) - (when (fboundp 'ahs-clear) (ahs-clear)) - (setq evil-multiedit--dont-recall t) - (lsp-iedit-linked-ranges) - (evil-multiedit-mode +1)) - -;; evil-evil-state - -;;;###autoload -(defun lsp-evil-state-highlights () - "Start `iedit-mode'. for `textDocument/documentHighlight'" - (interactive "P") - (if (fboundp 'ahs-clear) (ahs-clear)) - (lsp-iedit-highlights) - (evil-iedit-state)) - -;;;###autoload -(defun lsp-evil-state-linked-ranges () - "Start `iedit-mode'. for `textDocument/linkedEditingRange'" - (interactive "P") - (if (fboundp 'ahs-clear) (ahs-clear)) - (lsp-iedit-linked-ranges) - (evil-iedit-state)) - - - -(lsp-consistency-check lsp-iedit) - -(provide 'lsp-iedit) -;;; lsp-iedit.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-javascript.el b/elpa/lsp-mode-20220201.852/lsp-javascript.el deleted file mode 100644 index c4f913bc..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-javascript.el +++ /dev/null @@ -1,371 +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 . - -;;; 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")) - -(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 javascript-typescript language server should be enabled based on FILENAME." - (or (string-match-p "\\.mjs\\|\\.[jt]sx?\\'" filename) - (and (derived-mode-p 'js-mode 'typescript-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-log-verbosity "info" - "The server log verbosity." - :group 'lsp-typescript - :type 'string) - -(defcustom lsp-clients-typescript-init-opts nil - "Configuration options provided to tsserver. -See the UserPreferences interface at https://github.com/microsoft/TypeScript/blob/main/lib/protocol.d.ts for the list of options available in the latest version of TypeScript." - :group 'lsp-typescript - :type 'plist) - -(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 \".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))))) - -(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))))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection (lambda () - `(,(lsp-package-path 'typescript-language-server) - "--tsserver-path" - ,(lsp-package-path 'typescript) - ,@lsp-clients-typescript-server-args))) - :activation-fn 'lsp-typescript-javascript-tsx-jsx-activate-p - :priority -2 - :completion-in-comments? t - :initialization-options (lambda () - (list :plugins lsp-clients-typescript-plugins - :logVerbosity lsp-clients-typescript-log-verbosity - :tsServerPath (lsp-package-path 'typescript) - :preferences lsp-clients-typescript-init-opts)) - :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 "//+[ ]*@flow") - (looking-at "/\\**[ ]*@flow") - (looking-at "[ ]*\\*[ ]*@flow")) - (setq found t) (setq stop t)) - ((or (looking-at "//") (looking-at "*")) - (forward-line)) - ((looking-at "/\\*") - (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/elpa/lsp-mode-20220201.852/lsp-json.el b/elpa/lsp-mode-20220201.852/lsp-json.el deleted file mode 100644 index 127d5e4a..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-json.el +++ /dev/null @@ -1,131 +0,0 @@ -;;; lsp-json.el --- vscode-json-languageserver integration -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Kien Nguyen - -;; Author: kien.n.quang at gmail.com -;; 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 . - -;;; Commentary: - -;; - -;;; Code: - -(require 'lsp-mode) -(require 'ht) -(require 'url) -(require 'url-util) - -(defgroup lsp-json nil - "LSP support for JSON, using vscode-json-languageserver." - :group 'lsp-mode - :link '(url-link "https://github.com/vscode-langservers/vscode-json-languageserver") - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-json-schemas nil - "Associate schemas to JSON files in the current project" - :type '(repeat alist) - :group 'lsp-json - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-http-proxy nil - "The URL of the proxy server to use when fetching schema." - :type 'string - :group 'lsp-json - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-http-proxyStrictSSL t - "The URL of the proxy server to use when fetching schema." - :type 'boolean - :group 'lsp-json - :package-version '(lsp-mode . "6.3")) - -(lsp-register-custom-settings - '(("json.schemas" lsp-json-schemas) - ("http.proxy" lsp-http-proxy) - ("http.proxyStrictSSL" lsp-http-proxyStrictSSL))) - -(defvar lsp-json--extra-init-params - `(:provideFormatter t - :handledSchemaProtocols ["file" "http" "https"])) - -(defvar lsp-json--schema-associations - `(:/*.css-data.json ["https://raw.githubusercontent.com/Microsoft/vscode-css-languageservice/master/docs/customData.schema.json"] - :/package.json ["http://json.schemastore.org/package"] - :/*.html-data.json ["https://raw.githubusercontent.com/Microsoft/vscode-html-languageservice/master/docs/customData.schema.json"] - :/*.schema.json ["http://json-schema.org/draft-07/schema#"] - :/bower.json ["http://json.schemastore.org/bower"] - :/composer.json ["http://json.schemastore.org/composer"] - :/tsconfig.json ["http://json.schemastore.org/tsconfig"] - :/tsconfig.*.json ["http://json.schemastore.org/tsconfig"] - :/typings.json ["http://json.schemastore.org/typings"] - :/.bowerrc ["http://json.schemastore.org/bowerrc"] - :/.babelrc ["http://json.schemastore.org/babelrc"] - :/.babelrc.json ["http://json.schemastore.org/babelrc"] - :/babel.config.json ["http://json.schemastore.org/babelrc"] - :/jsconfig.json ["http://json.schemastore.org/jsconfig"] - :/jsconfig.*.json ["http://json.schemastore.org/jsconfig"] - :/project.json ["http://json.schemastore.org/project"] - :/omnisharp.json ["http://json.schemastore.org/omnisharp"] - :/.eslintrc.json ["http://json.schemastore.org/eslintrc"] - :/.eslintrc ["http://json.schemastore.org/eslintrc"]) - "Default json schemas.") - -(defun lsp-json--get-content (_workspace uri callback) - "Get content from URI." - (ignore-errors - (url-retrieve uri - (lambda (_status callback) - (goto-char (point-min)) - (re-search-forward "\n\n" nil 'noerror) - (funcall - callback - (decode-coding-string (buffer-substring (point) (point-max)) - 'utf-8-unix))) - (list callback)))) - -(lsp-dependency 'vscode-json-languageserver - '(:system "vscode-json-languageserver") - '(:npm :package "vscode-json-languageserver" - :path "vscode-json-languageserver")) - -(lsp-register-client - (make-lsp-client - :new-connection - (lsp-stdio-connection - (lambda () (list (lsp-package-path 'vscode-json-languageserver) "--stdio"))) - :activation-fn (lsp-activate-on "json" "jsonc") - :server-id 'json-ls - :priority 0 - :multi-root t - :completion-in-comments? t - :initialization-options lsp-json--extra-init-params - :async-request-handlers (ht ("vscode/content" #'lsp-json--get-content)) - :initialized-fn - (lambda (w) - (with-lsp-workspace w - (lsp--set-configuration - (ht-merge (lsp-configuration-section "json") - (lsp-configuration-section "http"))) - (lsp-notify "json/schemaAssociations" lsp-json--schema-associations))) - :download-server-fn - (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'vscode-json-languageserver callback error-callback)))) - -(lsp-consistency-check lsp-json) - -(provide 'lsp-json) -;;; lsp-json.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-kotlin.el b/elpa/lsp-mode-20220201.852/lsp-kotlin.el deleted file mode 100644 index 2cbb166f..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-kotlin.el +++ /dev/null @@ -1,149 +0,0 @@ -;;; lsp-kotlin.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, kotlin - -;; 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 . - -;;; Commentary: - -;; LSP Clients for the Kotlin Programming Language. - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-kotlin nil - "LSP support for Kotlin, using KotlinLanguageServer." - :group 'lsp-mode - :link '(url-link "https://github.com/fwcd/KotlinLanguageServer")) - -(define-obsolete-variable-alias - 'lsp-kotlin-language-server-path - 'lsp-clients-kotlin-server-executable - "lsp-mode 6.4") - -(defcustom lsp-clients-kotlin-server-executable - (if (eq system-type 'windows-nt) - "kotlin-language-server.bat" - "kotlin-language-server") - "The kotlin-language-server executable to use. -Leave as just the executable name to use the default behavior of finding the -executable with `exec-path'." - :type 'string - :group 'lsp-kotlin) - -(defcustom lsp-kotlin-trace-server "off" - "Traces the communication between VSCode and the Kotlin language server." - :type '(choice (:tag "off" "messages" "verbose")) - :group 'lsp-kotlin - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-kotlin-compiler-jvm-target "1.8" - "Specifies the JVM target, e.g. \"1.6\" or \"1.8\"." - :type 'string - :group 'lsp-kotlin - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-kotlin-linting-debounce-time 250 - "[DEBUG] Specifies the debounce time limit. -Lower to increase responsiveness at the cost of possible stability issues." - :type 'number - :group 'lsp-kotlin - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-kotlin-completion-snippets-enabled t - "Specifies whether code completion should provide snippets (true) or -plain-text items (false)." - :type 'boolean - :group 'lsp-kotlin - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-kotlin-debug-adapter-enabled t - "[Recommended] Specifies whether the debug adapter should be used. -When enabled a debugger for Kotlin will be available." - :type 'boolean) - -(defcustom lsp-kotlin-debug-adapter-path "" - "Optionally a custom path to the debug adapter executable." - :type 'string - :group 'lsp-kotlin - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-kotlin-external-sources-use-kls-scheme t - "[Recommended] Specifies whether URIs inside JARs should be represented -using the 'kls'-scheme." - :type 'boolean - :group 'lsp-kotlin - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-kotlin-external-sources-auto-convert-to-kotlin t - "Specifies whether decompiled/external classes should be auto-converted -to Kotlin." - :type 'boolean - :group 'lsp-kotlin - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-kotlin-server-download-url - "https://github.com/fwcd/kotlin-language-server/releases/latest/download/server.zip" - "The URL for the language server download." - :type 'string - :group 'lsp-kotlin - :package-version '(lsp-mode . "8.0.1")) - -(lsp-register-custom-settings - '(("kotlin.externalSources.autoConvertToKotlin" lsp-kotlin-external-sources-auto-convert-to-kotlin t) - ("kotlin.externalSources.useKlsScheme" lsp-kotlin-external-sources-use-kls-scheme t) - ("kotlin.debugAdapter.path" lsp-kotlin-debug-adapter-path) - ("kotlin.debugAdapter.enabled" lsp-kotlin-debug-adapter-enabled t) - ("kotlin.completion.snippets.enabled" lsp-kotlin-completion-snippets-enabled t) - ("kotlin.linting.debounceTime" lsp-kotlin-linting-debounce-time) - ("kotlin.compiler.jvm.target" lsp-kotlin-compiler-jvm-target) - ("kotlin.trace.server" lsp-kotlin-trace-server) - ("kotlin.languageServer.path" lsp-clients-kotlin-server-executable))) - -(defvar lsp-kotlin--language-server-path - (f-join lsp-server-install-dir - "kotlin" "server" "bin" (if (eq system-type 'windows-nt) - "kotlin-language-server.bat" - "kotlin-language-server")) - "The path to store the language server at if necessary.") - -(lsp-dependency - 'kotlin-language-server - `(:system ,lsp-clients-kotlin-server-executable) - `(:download :url lsp-kotlin-server-download-url - :decompress :zip - :store-path ,(f-join lsp-server-install-dir "kotlin" "kotlin-language-server") - :binary-path lsp-kotlin--language-server-path - :set-executable? t)) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection lsp-clients-kotlin-server-executable) - :major-modes '(kotlin-mode) - :priority -1 - :server-id 'kotlin-ls - :initialized-fn (lambda (workspace) - (with-lsp-workspace workspace - (lsp--set-configuration (lsp-configuration-section "kotlin")))) - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'kotlin-language-server callback error-callback)))) - -(lsp-consistency-check lsp-kotlin) - -(provide 'lsp-kotlin) -;;; lsp-kotlin.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-lens.el b/elpa/lsp-mode-20220201.852/lsp-lens.el deleted file mode 100644 index 5cecff4a..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-lens.el +++ /dev/null @@ -1,448 +0,0 @@ -;;; lsp-lens.el --- LSP lens -*- 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 . -;; -;;; Commentary: -;; -;; LSP lens -;; -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-lens nil - "LSP support for lens" - :prefix "lsp-lens-" - :group 'lsp-mode - :tag "LSP Lens") - -(defcustom lsp-lens-debounce-interval 0.001 - "Debounce interval for loading lenses." - :group 'lsp-lens - :type 'number) - -(defcustom lsp-lens-place-position 'end-of-line - "The position to place lens relative to returned lens position." - :group 'lsp-lens - :type '(choice (const above-line) - (const end-of-line)) - :package-version '(lsp-mode . "8.0.0")) - -(defface lsp-lens-mouse-face - '((t :height 0.8 :inherit link)) - "The face used for code lens overlays." - :group 'lsp-lens) - -(defface lsp-lens-face - '((t :inherit lsp-details-face)) - "The face used for code lens overlays." - :group 'lsp-lens) - -(defvar-local lsp-lens--modified? nil) - -(defvar-local lsp-lens--overlays nil - "Current lenses.") - -(defvar-local lsp-lens--page nil - "Pair of points which holds the last window location the lenses were loaded.") - -(defvar-local lsp-lens--last-count nil - "The number of lenses the last time they were rendered.") - -(defvar lsp-lens-backends '(lsp-lens--backend) - "Backends providing lenses.") - -(defvar-local lsp-lens--refresh-timer nil - "Refresh timer for the lenses.") - -(defvar-local lsp-lens--data nil - "Pair of points which holds the last window location the lenses were loaded.") - -(defvar-local lsp-lens--backend-cache nil) - -(defun lsp-lens--text-width (from to) - "Measure the width of the text between FROM and TO. -Results are meaningful only if FROM and TO are on the same line." - ;; `current-column' takes prettification into account - (- (save-excursion (goto-char to) (current-column)) - (save-excursion (goto-char from) (current-column)))) - -(defun lsp-lens--update (ov) - "Redraw quick-peek overlay OV." - (let* ((offset (lsp-lens--text-width (save-excursion - (beginning-of-visual-line) - (point)) - (save-excursion - (beginning-of-line-text) - (point)))) - (str (if (eq 'end-of-line lsp-lens-place-position) - (overlay-get ov 'lsp--lens-contents) - (concat (make-string offset ?\s) - (overlay-get ov 'lsp--lens-contents))))) - (save-excursion - (goto-char (overlay-start ov)) - (if (eq 'end-of-line lsp-lens-place-position) - (overlay-put ov 'after-string (propertize (concat " " str) 'cursor t)) - (overlay-put ov 'before-string (concat str "\n"))) - (overlay-put ov 'lsp-original str)))) - -(defun lsp-lens--overlay-ensure-at (pos) - "Find or create a lens for the line at POS." - (-doto (save-excursion - (goto-char pos) - (if (eq 'end-of-line lsp-lens-place-position) - (make-overlay (point-at-eol) -1 nil t t) - (make-overlay (point-at-bol) (1+ (point-at-eol)) nil t t))) - (overlay-put 'lsp-lens t) - (overlay-put 'evaporate t) - (overlay-put 'lsp-lens-position pos))) - -(defun lsp-lens--show (str pos metadata) - "Show STR in an inline window at POS including METADATA." - (let ((ov (lsp-lens--overlay-ensure-at pos))) - (save-excursion - (goto-char pos) - (setf (overlay-get ov 'lsp--lens-contents) str) - (setf (overlay-get ov 'lsp--metadata) metadata) - (lsp-lens--update ov) - ov))) - -(defun lsp-lens--idle-function (&optional buffer) - "Create idle function for buffer BUFFER." - (when (and (or (not buffer) (eq (current-buffer) buffer)) - (not (equal (cons (window-start) (window-end)) lsp-lens--page))) - (lsp-lens--schedule-refresh nil))) - -(defun lsp-lens--overlay-matches-pos (ov pos) - "Check if OV is a lens covering POS." - (and (overlay-get ov 'lsp-lens) - (overlay-start ov) - (<= (overlay-start ov) pos) - (< pos (overlay-end ov)))) - -(defun lsp-lens--after-save () - "Handler for `after-save-hook' for lens mode." - (lsp-lens--schedule-refresh t)) - -(defun lsp-lens--schedule-refresh (&optional buffer-modified?) - "Call each of the backend. -BUFFER-MODIFIED? determines whether the buffer was modified or -not." - (-some-> lsp-lens--refresh-timer cancel-timer) - - (setq lsp-lens--page (cons (window-start) (window-end))) - (setq lsp-lens--refresh-timer - (run-with-timer lsp-lens-debounce-interval - nil - #'lsp-lens-refresh - (or lsp-lens--modified? buffer-modified?) - (current-buffer)))) - -(defun lsp-lens--schedule-refresh-modified () - "Schedule a lens refresh due to a buffer-modification. -See `lsp-lens--schedule-refresh' for details." - (lsp-lens--schedule-refresh t)) - -(defun lsp-lens--keymap (command) - "Build the lens keymap for COMMAND." - (-doto (make-sparse-keymap) - (define-key [mouse-1] (lsp-lens--create-interactive-command command)))) - -(defun lsp-lens--create-interactive-command (command?) - "Create an interactive COMMAND? for the lens. -COMMAND? shall be an `&Command' (e.g. `&CodeLens' :command?) and -mustn't be nil." - (if (functionp (lsp:command-command command?)) - (lsp:command-command command?) - (lambda () - (interactive) - (lsp--execute-command command?)))) - -(defun lsp-lens--display (lenses) - "Show LENSES." - ;; rerender only if there are lenses which are not processed or if their count - ;; has changed(e. g. delete lens should trigger redisplay). - (let ((scroll-preserve-screen-position t)) - (setq lsp-lens--modified? nil) - (when (or (-any? (-lambda ((&CodeLens :_processed processed)) - (not processed)) - lenses) - (eq (length lenses) lsp-lens--last-count) - (not lenses)) - (setq lsp-lens--last-count (length lenses)) - (mapc #'delete-overlay lsp-lens--overlays) - (setq lsp-lens--overlays - (->> lenses - (-filter #'lsp:code-lens-command?) - (--map (prog1 it (lsp-put it :_processed t))) - (-group-by (-compose #'lsp:position-line #'lsp:range-start #'lsp:code-lens-range)) - (-map - (-lambda ((_ . lenses)) - (let* ((sorted (-sort (-on #'< (-compose #'lsp:position-character - #'lsp:range-start - #'lsp:code-lens-range)) - lenses)) - (data (-map - (-lambda ((lens &as &CodeLens - :command? (command &as - &Command :title :_face face))) - (propertize - title - 'face (or face 'lsp-lens-face) - 'action (lsp-lens--create-interactive-command command) - 'pointer 'hand - 'mouse-face 'lsp-lens-mouse-face - 'local-map (lsp-lens--keymap command))) - sorted))) - (lsp-lens--show - (s-join (propertize "|" 'face 'lsp-lens-face) data) - (-> sorted cl-first lsp:code-lens-range lsp:range-start lsp--position-to-point) - data))))))))) - -(defun lsp-lens-refresh (buffer-modified? &optional buffer) - "Refresh lenses using lenses backend. -BUFFER-MODIFIED? determines whether the BUFFER is modified or not." - (let ((buffer (or buffer (current-buffer)))) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (dolist (backend lsp-lens-backends) - (funcall backend buffer-modified? - (lambda (lenses version) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (lsp-lens--process backend lenses version)))))))))) - -(defun lsp-lens--process (backend lenses version) - "Process LENSES originated from BACKEND. -VERSION is the version of the file. The lenses has to be -refreshed only when all backends have reported for the same -version." - (setq lsp-lens--data (or lsp-lens--data (make-hash-table))) - (puthash backend (cons version (append lenses nil)) lsp-lens--data) - - (-let [backend-data (->> lsp-lens--data ht-values (-filter #'cl-rest))] - (when (and - (= (length lsp-lens-backends) (ht-size lsp-lens--data)) - (seq-every-p (-lambda ((version)) - (or (not version) (eq version lsp--cur-version))) - backend-data)) - ;; display the data only when the backends have reported data for the - ;; current version of the file - (lsp-lens--display (apply #'append (-map #'cl-rest backend-data))))) - version) - -(lsp-defun lsp--lens-backend-not-loaded? ((&CodeLens :range - (&Range :start) - :command? - :_pending pending)) - "Return t if LENS has to be loaded." - (and (< (window-start) (lsp--position-to-point start) (window-end)) - (not command?) - (not pending))) - -(lsp-defun lsp--lens-backend-present? ((&CodeLens :range (&Range :start) :command?)) - "Return t if LENS has to be loaded." - (or command? - (not (< (window-start) (lsp--position-to-point start) (window-end))))) - -(defun lsp-lens--backend-fetch-missing (lenses callback file-version) - "Fetch LENSES without command in for the current window. - -TICK is the buffer modified tick. If it does not match -`buffer-modified-tick' at the time of receiving the updates the -updates must be discarded.. -CALLBACK - the callback for the lenses. -FILE-VERSION - the version of the file." - (seq-each - (lambda (it) - (with-lsp-workspace (lsp-get it :_workspace) - (lsp-put it :_pending t) - (lsp-put it :_workspace nil) - (lsp-request-async "codeLens/resolve" it - (-lambda ((&CodeLens :command?)) - (lsp-put it :_pending nil) - (lsp-put it :command command?) - (when (seq-every-p #'lsp--lens-backend-present? lenses) - (funcall callback lenses file-version))) - :mode 'tick))) - (seq-filter #'lsp--lens-backend-not-loaded? lenses))) - -(defun lsp-lens--backend (modified? callback) - "Lenses backend using `textDocument/codeLens'. -MODIFIED? - t when buffer is modified since the last invocation. -CALLBACK - callback for the lenses." - (when (lsp--find-workspaces-for "textDocument/codeLens") - (if modified? - (progn - (setq lsp-lens--backend-cache nil) - (lsp-request-async "textDocument/codeLens" - `(:textDocument (:uri ,(lsp--buffer-uri))) - (lambda (lenses) - (setq lsp-lens--backend-cache - (seq-mapcat - (-lambda ((workspace . workspace-lenses)) - ;; preserve the original workspace so we can later use it to resolve the lens - (seq-do (-rpartial #'lsp-put :_workspace workspace) workspace-lenses) - workspace-lenses) - lenses)) - (if (-every? #'lsp:code-lens-command? lsp-lens--backend-cache) - (funcall callback lsp-lens--backend-cache lsp--cur-version) - (lsp-lens--backend-fetch-missing lsp-lens--backend-cache callback lsp--cur-version))) - :error-handler #'ignore - :mode 'tick - :no-merge t - :cancel-token (concat (buffer-name (current-buffer)) "-lenses"))) - (if (-all? #'lsp--lens-backend-present? lsp-lens--backend-cache) - (funcall callback lsp-lens--backend-cache lsp--cur-version) - (lsp-lens--backend-fetch-missing lsp-lens--backend-cache callback lsp--cur-version))))) - -(defun lsp-lens--refresh-buffer () - "Trigger lens refresh on buffer." - (remove-hook 'lsp-on-idle-hook #'lsp-lens--refresh-buffer t) - (when (bound-and-true-p lsp-lens-mode) - (lsp-lens-refresh t))) - -(defun lsp--lens-on-refresh (workspace) - "Clear lens within all buffers of WORKSPACE, refreshing all workspace buffers." - (cl-assert (not (eq nil workspace))) - (->> (lsp--workspace-buffers workspace) - (mapc (lambda (buffer) - (lsp-with-current-buffer buffer - (if (lsp--buffer-visible-p) - (when (bound-and-true-p lsp-lens-mode) - (lsp-lens-refresh t)) - (progn - (add-hook 'lsp-on-idle-hook #'lsp-lens--refresh-buffer nil t) - (lsp--idle-reschedule (current-buffer))))))))) - -;;;###autoload -(defun lsp-lens--enable () - "Enable lens mode." - (when (and lsp-lens-enable - (lsp-feature? "textDocument/codeLens")) - (lsp-lens-mode 1))) - -(defun lsp-lens--disable () - "Disable lens mode." - (lsp-lens-mode -1)) - -;;;###autoload -(defun lsp-lens-show () - "Display lenses in the buffer." - (interactive) - (->> (lsp-request "textDocument/codeLens" - `(:textDocument (:uri - ,(lsp--path-to-uri buffer-file-name)))) - (seq-map (-lambda ((lens &as &CodeAction :command?)) - (if command? - lens - (lsp-request "codeLens/resolve" lens)))) - lsp-lens--display)) - -;;;###autoload -(defun lsp-lens-hide () - "Delete all lenses." - (interactive) - (let ((scroll-preserve-screen-position t)) - (seq-do #'delete-overlay lsp-lens--overlays) - (setq lsp-lens--overlays nil))) - -;;;###autoload -(define-minor-mode lsp-lens-mode - "Toggle code-lens overlays." - :group 'lsp-lens - :global nil - :init-value nil - :lighter " Lens" - (cond - (lsp-lens-mode - (add-hook 'lsp-unconfigure-hook #'lsp-lens--disable nil t) - (add-hook 'lsp-configure-hook #'lsp-lens--enable nil t) - (add-hook 'lsp-on-idle-hook #'lsp-lens--idle-function nil t) - (add-hook 'lsp-on-change-hook #'lsp-lens--schedule-refresh-modified nil t) - (add-hook 'after-save-hook #'lsp-lens--after-save nil t) - (add-hook 'before-revert-hook #'lsp-lens-hide nil t) - (lsp-lens-refresh t)) - (t - (remove-hook 'lsp-on-idle-hook #'lsp-lens--idle-function t) - (remove-hook 'lsp-on-change-hook #'lsp-lens--schedule-refresh-modified t) - (remove-hook 'after-save-hook #'lsp-lens--after-save t) - (remove-hook 'before-revert-hook #'lsp-lens-hide t) - (when lsp-lens--refresh-timer - (cancel-timer lsp-lens--refresh-timer)) - (setq lsp-lens--refresh-timer nil) - (lsp-lens-hide) - (setq lsp-lens--last-count nil) - (setq lsp-lens--backend-cache nil) - (remove-hook 'lsp-configure-hook #'lsp-lens--enable t) - (remove-hook 'lsp-unconfigure-hook #'lsp-lens--disable t)))) - - -;; avy integration - -(declare-function avy-process "ext:avy" (candidates &optional overlay-fn cleanup-fn)) -(declare-function avy--key-to-char "ext:avy" (c)) -(defvar avy-action) - -;;;###autoload -(defun lsp-avy-lens () - "Click lsp lens using `avy' package." - (interactive) - (unless lsp-lens--overlays - (user-error "No lenses in current buffer")) - (let* ((avy-action 'identity) - (position (if (eq lsp-lens-place-position 'end-of-line) - 'after-string - 'before-string)) - (action (cl-third - (avy-process - (-mapcat - (lambda (overlay) - (-map-indexed - (lambda (index lens-token) - (list overlay index - (get-text-property 0 'action lens-token))) - (overlay-get overlay 'lsp--metadata))) - lsp-lens--overlays) - (-lambda (path ((ov index) . _win)) - (let* ((path (mapcar #'avy--key-to-char path)) - (str (propertize (string (car (last path))) - 'face 'avy-lead-face)) - (old-str (overlay-get ov position)) - (old-str-tokens (s-split "|" old-str)) - (old-token (seq-elt old-str-tokens index)) - (tokens `(,@(-take index old-str-tokens) - ,(-if-let ((_ prefix suffix) - (s-match "\\(^[[:space:]]+\\)\\(.*\\)" old-token)) - (concat prefix str suffix) - (concat str old-token)) - ,@(-drop (1+ index) old-str-tokens))) - (new-str (s-join (propertize "|" 'face 'lsp-lens-face) tokens)) - (new-str (if (or (s-ends-with? "\n" new-str) - (eq lsp-lens-place-position 'end-of-line)) - new-str - (concat new-str "\n")))) - (overlay-put ov position new-str))) - (lambda () - (--map (overlay-put it position - (overlay-get it 'lsp-original)) - lsp-lens--overlays)))))) - (when action (funcall-interactively action)))) - -(lsp-consistency-check lsp-lens) - -(provide 'lsp-lens) -;;; lsp-lens.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-lua.el b/elpa/lsp-mode-20220201.852/lsp-lua.el deleted file mode 100644 index 3349a61a..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-lua.el +++ /dev/null @@ -1,678 +0,0 @@ -;;; lsp-lua.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 E. Alexander Barbosa - -;; Author: E. Alexander Barbosa -;; 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 . - -;;; Commentary: - -;; LSP Clients for the Lua Programming Language - -;;; Code: - -(require 'lsp-mode) -(require 'f) -(require 'files) - -(defgroup lsp-emmy-lua nil - "Lua LSP client, provided by the EmmyLua Language Server." - :group 'lsp-mode - :version "8.0.0" - :link '(url-link "https://github.com/EmmyLua/EmmyLua-LanguageServer")) - -(defcustom lsp-clients-emmy-lua-java-path "java" - "Java Runtime binary location." - :group 'lsp-emmy-lua - :version "8.0.0" - :risky t - :type 'file) - -(defcustom lsp-clients-emmy-lua-jar-path (f-join lsp-server-install-dir "EmmyLua-LS-all.jar") - "Emmy Lua language server jar file." - :group 'lsp-emmy-lua - :version "8.0.0" - :risky t - :type 'file) - -(defcustom lsp-clients-emmy-lua-args '("-jar") - "Arguments to the Lua Language server." - :group 'lsp-emmy-lua - :version "8.0.0" - :risky t - :type '(repeat string)) - -(defcustom lsp-clients-emmy-lua-command nil - "Final command to call the Lua Language server." - :group 'lsp-emmy-lua - :version "8.0.0" - :risky t - :type '(repeat string)) - -(defun lsp-clients-emmy-lua-test () - "Test the Emmy Lua binaries and files." - (and (executable-find lsp-clients-emmy-lua-java-path) - (f-exists? lsp-clients-emmy-lua-jar-path))) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection (lambda () (or lsp-clients-emmy-lua-command - `(,lsp-clients-emmy-lua-java-path - ,@lsp-clients-emmy-lua-args - ,lsp-clients-emmy-lua-jar-path))) - #'lsp-clients-emmy-lua-test) - :major-modes '(lua-mode) - :server-id 'emmy-lua - :priority -1 - :notification-handlers (lsp-ht ("emmy/progressReport" #'ignore)))) - - -;;; lua-language-server -(defgroup lsp-lua-language-server nil - "Lua LSP client, provided by the Lua Language Server." - :group 'lsp-mode - :version "8.0.0" - :link '(url-link "https://github.com/sumneko/lua-language-server")) - -(defcustom lsp-clients-lua-language-server-install-dir (f-join lsp-server-install-dir "lua-language-server/") - "Installation directory for Lua Language Server." - :group 'lsp-lua-language-server - :version "8.0.0" - :risky t - :type 'directory) - -(defcustom lsp-clients-lua-language-server-bin - (f-join lsp-clients-lua-language-server-install-dir - "extension/server/bin/" - (pcase system-type - ('gnu/linux "Linux/lua-language-server") - ('darwin "macOS/lua-language-server") - ('windows-nt "Windows/lua-language-server.exe") - (_ "Linux/lua-language-server"))) - "Location of Lua Language Server." - :group 'lsp-lua-language-server - :version "8.0.0" - :risky t - :type 'file) - -(defcustom lsp-clients-lua-language-server-main-location - (f-join lsp-clients-lua-language-server-install-dir - "extension/server/main.lua") - "Location of Lua Language Server main.lua." - :group 'lsp-lua-language-server - :version "8.0.0" - :risky t - :type 'file) - -(defcustom lsp-clients-lua-language-server-args '("-E") - "Arguments to run the Lua Language server." - :group 'lsp-lua-language-server - :version "8.0.0" - :risky t - :type '(repeat string)) - -(defcustom lsp-clients-lua-language-server-command nil - "Command to start Lua Language server." - :group 'lsp-lua-language-server - :type '(repeat string)) - - -(defun lsp-clients-lua-language-server-test () - "Test Lua language server binaries and files." - (and (f-exists? lsp-clients-lua-language-server-main-location) - (f-exists? lsp-clients-lua-language-server-bin))) - -(defcustom lsp-lua-color-mode "Semantic" - "Color mode." - :type '(choice (:tag "Grammar" "Semantic")) - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-completion-call-snippet "Disable" - "Shows function call snippets." - :type '(choice (:tag "Disable" "Both" "Replace")) - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-completion-display-context 6 - "Previewing the relevant code snippet of the suggestion may help you -understand the usage of the suggestion. - -The number set indicates the number of intercepted lines in the code -fragment. If it is set to `0`, this feature can be disabled." - :type 'number - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-completion-enable t - "Enable completion." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-completion-keyword-snippet "Replace" - "Shows keyword syntax snippets." - :type '(choice (:tag "Disable" "Both" "Replace")) - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-completion-workspace-word t - "Show words within the workspace." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-develop-debugger-port 11412 - "Listen port of debugger." - :type 'number - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-develop-debugger-wait nil - "Suspend before debugger connects." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-develop-enable nil - "Developer mode. Do not enable, performance will be affected." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-diagnostics-disable nil - "Disabled diagnostic (Use code in hover brackets). -```json -\"Lua.diagnostics.disable\" : [ -\"unused-local\", -\"lowercase-global\" -] -```" - :type 'lsp-string-vector - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-diagnostics-enable t - "Enable diagnostics." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-diagnostics-globals nil - "Defined global variables. -```json -\"Lua.diagnostics.globals\" : [ -\"GLOBAL1\", -\"GLOBAL2\" -] -```" - :type 'lsp-string-vector - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-diagnostics-needed-file-status nil - "If you want to check only opened files, choice Opened; else choice Any. -```json -\"Lua.diagnostics.neededFileStatus\" : { -\"ambiguity-1\" : \"Any\", -\"circle-doc-class\" : \"Opened\" -} -```" - :type 'alist - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-diagnostics-severity nil - "Modified diagnostic severity. -```json -\"Lua.diagnostics.severity\" : { -\"redefined-local\" : \"Warning\", -\"emmy-lua\" : \"Hint\" -} -```" - :type 'alist - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-diagnostics-workspace-delay 0 - "Latency (milliseconds) for workspace diagnostics. When you start the -workspace, or edit any file, the entire workspace will be re-diagnosed in the -background. Set to negative to disable workspace diagnostics." - :type 'number - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-diagnostics-workspace-rate 100 - "Workspace diagnostics run rate (%). Decreasing this value reduces CPU usage, -but also reduces the speed of workspace diagnostics. The diagnosis of the file -you are currently editing is always done at full speed and is not affected by -this setting." - :type 'number - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-hint-enable nil - "Enable hint." - :type 'boolean - :package-version '(lsp-mmode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-hint-param-name t - "Hint parameter name when the parameter called is literal." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-hint-param-type t - "Show type hints at the parameter of the function." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-hint-set-type nil - "Hint type at assignment operation." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-hover-enable t - "Enable hover." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-hover-field-infer 3000 - "When hovering to view a table, type infer will be performed for each field. -When the accumulated time of type infer reaches the set value (MS), the type -infer of subsequent fields will be skipped." - :type 'number - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-hover-preview-fields 100 - "When hovering to view a table, limits the maximum number of previews for -fields." - :type 'number - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-hover-view-number t - "Hover to view numeric content (only if literal is not decimal)." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-hover-view-string t - "Hover to view the contents of a string (only if the literal contains an -escape character)." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-hover-view-string-max 1000 - "The maximum length of a hover to view the contents of a string." - :type 'number - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-intelli-sense-search-depth 0 - "Set the search depth for IntelliSense. Increasing this value increases -accuracy, but decreases performance. Different workspace have different -tolerance for this setting. Please adjust it to the appropriate value." - :type 'number - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-runtime-file-encoding "utf8" - "File encoding. The 'ansi' option is only available under the 'Windows' -platform." - :type '(choice (:tag "utf8" "ansi")) - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-runtime-nonstandard-symbol nil - "Supports non-standard symbols. Make sure that your runtime environment -supports these symbols." - :type 'lsp-string-vector - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-runtime-path - ["?.lua" "?/init.lua" "?/?.lua"] - "`package.path`." - :type 'lsp-string-vector - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-runtime-plugin nil - "(Proposed) Plugin path. Default is `.vscode/lua/plugin.lua`" - :type 'file - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-runtime-special nil - "The custom global variables are regarded as some special built-in variables, -and the language server will provide special support. -```json -\"Lua.runtime.special\" : { -\"include\" : \"require\" -} -```" - :type 'alist - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-runtime-unicode-name nil - "Allows Unicode characters in name." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-runtime-version "Lua 5.4" - "Lua runtime version." - :type '(choice (:tag "Lua 5.1" "Lua 5.2" "Lua 5.3" "Lua 5.4" "LuaJIT")) - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-signature-help-enable t - "Enable signature help." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-telemetry-enable nil - "Enable telemetry to send your editor information and error logs over the -network." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-window-progress-bar t - "Show progress bar in status bar." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-window-status-bar t - "Show extension status in status bar." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-workspace-ignore-dir - [".vscode"] - "Ignored directories (Use `.gitignore` grammar). -```json -\"Lua.workspace.ignoreDir\" : [ -\"temp/*.*\", -\"!temp/*.lua\" -] -```" - :type 'lsp-string-vector - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-workspace-ignore-submodules t - "Ignore submodules." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-workspace-library nil - "Load external library. - -This feature can load external Lua files, which can be used for definition, -automatic completion and other functions. Note that the language server does -not monitor changes in external files and needs to restart if the external -files are modified. The following example shows loaded files in `C:/lua` -and `../lib` ,exclude `../lib/temp`. - -```json -\"Lua.workspace.library\": { -\"C:/lua\": true, -\"../lib\": [ -\"temp/*\" -] -} -```" - :type 'alist - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-workspace-max-preload 1000 - "Max preloaded files." - :type 'number - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-workspace-preload-file-size 100 - "Skip files larger than this value (KB) when preloading." - :type 'number - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-workspace-use-git-ignore t - "Ignore files list in `.gitignore` ." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-files-associations nil - "Files.associations." - :type 'alist - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(defcustom lsp-lua-files-exclude nil - "Files.exclude." - :type 'alist - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-lua-language-server) - -(lsp-register-custom-settings - '(("files.associations" lsp-lua-files-associations t) - ("files.exclude" lsp-lua-files-exclude t) - ("Lua.workspace.useGitIgnore" lsp-lua-workspace-use-git-ignore t) - ("Lua.workspace.preloadFileSize" lsp-lua-workspace-preload-file-size) - ("Lua.workspace.maxPreload" lsp-lua-workspace-max-preload) - ("Lua.workspace.library" lsp-lua-workspace-library) - ("Lua.workspace.ignoreSubmodules" lsp-lua-workspace-ignore-submodules t) - ("Lua.workspace.ignoreDir" lsp-lua-workspace-ignore-dir) - ("Lua.window.statusBar" lsp-lua-window-status-bar t) - ("Lua.window.progressBar" lsp-lua-window-progress-bar t) - ("Lua.telemetry.enable" lsp-lua-telemetry-enable t) - ("Lua.signatureHelp.enable" lsp-lua-signature-help-enable t) - ("Lua.runtime.version" lsp-lua-runtime-version) - ("Lua.runtime.unicodeName" lsp-lua-runtime-unicode-name nil) - ("Lua.runtime.special" lsp-lua-runtime-special) - ("Lua.runtime.plugin" lsp-lua-runtime-plugin) - ("Lua.runtime.path" lsp-lua-runtime-path) - ("Lua.runtime.nonstandardSymbol" lsp-lua-runtime-nonstandard-symbol) - ("Lua.runtime.fileEncoding" lsp-lua-runtime-file-encoding) - ("Lua.intelliSense.searchDepth" lsp-lua-intelli-sense-search-depth) - ("Lua.hover.viewStringMax" lsp-lua-hover-view-string-max) - ("Lua.hover.viewString" lsp-lua-hover-view-string t) - ("Lua.hover.viewNumber" lsp-lua-hover-view-number t) - ("Lua.hover.previewFields" lsp-lua-hover-preview-fields) - ("Lua.hover.fieldInfer" lsp-lua-hover-field-infer) - ("Lua.hover.enable" lsp-lua-hover-enable t) - ("Lua.hint.setType" lsp-lua-hint-set-type nil) - ("Lua.hint.paramType" lsp-lua-hint-param-type t) - ("Lua.hint.paramName" lsp-lua-hint-param-name t) - ("Lua.hint.enable" lsp-lua-hint-enable t) - ("Lua.diagnostics.workspaceRate" lsp-lua-diagnostics-workspace-rate) - ("Lua.diagnostics.workspaceDelay" lsp-lua-diagnostics-workspace-delay) - ("Lua.diagnostics.severity" lsp-lua-diagnostics-severity) - ("Lua.diagnostics.neededFileStatus" lsp-lua-diagnostics-needed-file-status) - ("Lua.diagnostics.globals" lsp-lua-diagnostics-globals) - ("Lua.diagnostics.enable" lsp-lua-diagnostics-enable t) - ("Lua.diagnostics.disable" lsp-lua-diagnostics-disable) - ("Lua.develop.enable" lsp-lua-develop-enable t) - ("Lua.develop.debuggerWait" lsp-lua-develop-debugger-wait t) - ("Lua.develop.debuggerPort" lsp-lua-develop-debugger-port) - ("Lua.completion.workspaceWord" lsp-lua-completion-workspace-word t) - ("Lua.completion.keywordSnippet" lsp-lua-completion-keyword-snippet) - ("Lua.completion.enable" lsp-lua-completion-enable t) - ("Lua.completion.displayContext" lsp-lua-completion-display-context) - ("Lua.completion.callSnippet" lsp-lua-completion-call-snippet) - ("Lua.color.mode" lsp-lua-color-mode))) - -(defun lsp-lua-language-server-install (client callback error-callback update?) - "Download the latest version of lua-language-server and extract it to -`lsp-lua-language-server-install-dir'." - (ignore client update?) - (let ((store-path (expand-file-name "vs-lua" lsp-clients-lua-language-server-install-dir))) - (lsp-download-install - (lambda (&rest _) - (set-file-modes lsp-clients-lua-language-server-bin #o0700) - (funcall callback)) - error-callback - :url (lsp-vscode-extension-url "sumneko" "lua" "1.17.4") - :store-path store-path - :decompress :zip))) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection (lambda () (or lsp-clients-lua-language-server-command - `(,lsp-clients-lua-language-server-bin - ,@lsp-clients-lua-language-server-args - ,lsp-clients-lua-language-server-main-location))) - #'lsp-clients-lua-language-server-test) - :major-modes '(lua-mode) - :priority -2 - :server-id 'lua-language-server - :download-server-fn #'lsp-lua-language-server-install)) - - -;;; lua-lsp -(defgroup lsp-lua-lsp nil - "Lua LSP client, provided by the Lua-Lsp." - :group 'lsp-mode - :version "8.0.0" - :link '(url-link "https://github.com/Alloyed/lua-lsp")) - -(defcustom lsp-clients-luarocks-bin-dir (f-join (getenv "HOME") ".luarocks/bin/") - "LuaRocks bin directory." - :group 'lsp-lua-lsp - :version "8.0.0" - :risky t - :type 'directory) - -(defcustom lsp-clients-lua-lsp-server-install-dir nil - "Installation directory for Lua-Lsp Language Server." - :group 'lsp-lua-lsp - :version "8.0.0" - :risky t - :type 'file) - -(defun lsp-clients-lua-lsp-test () - "Test Lua-lsp language server files." - (and (f-exists? lsp-clients-lua-lsp-server-install-dir))) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection (lambda () - (or lsp-clients-lua-lsp-server-install-dir - (f-join lsp-clients-luarocks-bin-dir "lua-lsp"))) - #'lsp-clients-lua-lsp-test) - :major-modes '(lua-mode) - :priority -3 - :server-id 'lsp-lua-lsp)) - -;;; lua-roblox-language-server -(defgroup lsp-lua-roblox-language-server nil - "Roblox Lua LSP client, provided by the Roblox Lua Language Server." - :group 'lsp-mode - :version "8.0.0" - :link '(url-link "https://github.com/NightrainsRbx/RobloxLsp")) - -(defcustom lsp-lua-roblox-language-server-install-dir (f-join lsp-server-install-dir "lua-roblox-language-server/") - "Installation directory for Lua Language Server." - :group 'lsp-lua-roblox-language-server - :version "8.0.0" - :risky t - :type 'directory) - -(defcustom lsp-lua-roblox-language-server-bin - (f-join lsp-lua-roblox-language-server-install-dir - "extension/server/bin/" - (pcase system-type - ('gnu/linux "Linux/lua-language-server") - ('darwin "macOS/lua-language-server") - ('windows-nt "Windows/lua-language-server.exe") - (_ "Linux/lua-language-server"))) - "Location of Roblox Lua Language Server." - :group 'lsp-lua-roblox-language-server - :version "8.0.0" - :risky t - :type 'file) - -(defcustom lsp-lua-roblox-language-server-main-location - (f-join lsp-lua-roblox-language-server-install-dir - "extension/server/main.lua") - "Location of Roblox Lua Language Server main.lua." - :group 'lsp-lua-roblox-language-server - :version "8.0.0" - :risky t - :type 'file) - -(defcustom lsp-lua-roblox-server-download-url - (lsp-vscode-extension-url "Nightrains" "robloxlsp" "0.15.8") - "Download url for Roblox Lua vscode extension." - :group 'lsp-lua-roblox-language-server - :version "8.0.0" - :type 'string) - -(defcustom lsp-lua-roblox-server-store-path - (expand-file-name "vs-lua-roblox" lsp-lua-roblox-language-server-install-dir) - "Server file name for the vscode extension." - :group 'lsp-lua-roblox-language-server - :version "8.0.0" - :type 'string) - -(defun lsp-lua-roblox-language-server-test () - "Test Lua language server binaries and files." - (and (f-exists? lsp-lua-roblox-language-server-main-location) - (f-exists? lsp-lua-roblox-language-server-bin))) - -(defun lsp-lua-roblox-language-server-install (_client callback error-callback _update?) - "Download the latest version of lua-language-server and extract it to -`lsp-lua-roblox-language-server-download-url'." - (lsp-download-install - (lambda (&rest _) - (set-file-modes lsp-lua-roblox-language-server-bin #o0700) - (funcall callback)) - error-callback - :url lsp-lua-roblox-server-download-url - :store-path lsp-lua-roblox-server-store-path - :decompress :zip)) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection (lambda () (or lsp-clients-lua-language-server-command - `(,lsp-lua-roblox-language-server-bin - ,@lsp-clients-lua-language-server-args - ,lsp-lua-roblox-language-server-main-location))) - #'lsp-lua-roblox-language-server-test) - :major-modes '(lua-mode) - :priority -4 - :server-id 'lua-roblox-language-server - :download-server-fn #'lsp-lua-roblox-language-server-install)) - -(lsp-consistency-check lsp-lua) - -(provide 'lsp-lua) -;;; lsp-lua.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-markdown.el b/elpa/lsp-mode-20220201.852/lsp-markdown.el deleted file mode 100644 index 08f1b207..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-markdown.el +++ /dev/null @@ -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 . - -;;; 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/elpa/lsp-mode-20220201.852/lsp-mode-autoloads.el b/elpa/lsp-mode-20220201.852/lsp-mode-autoloads.el deleted file mode 100644 index 4f1e1994..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-mode-autoloads.el +++ /dev/null @@ -1,807 +0,0 @@ -;;; lsp-mode-autoloads.el --- automatically extracted autoloads -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "lsp-actionscript" "lsp-actionscript.el" (0 -;;;;;; 0 0 0)) -;;; Generated autoloads from lsp-actionscript.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-actionscript" '("lsp-actionscript-"))) - -;;;*** - -;;;### (autoloads nil "lsp-ada" "lsp-ada.el" (0 0 0 0)) -;;; Generated autoloads from lsp-ada.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-ada" '("lsp-ada-"))) - -;;;*** - -;;;### (autoloads nil "lsp-angular" "lsp-angular.el" (0 0 0 0)) -;;; Generated autoloads from lsp-angular.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-angular" '("lsp-client"))) - -;;;*** - -;;;### (autoloads nil "lsp-bash" "lsp-bash.el" (0 0 0 0)) -;;; Generated autoloads from lsp-bash.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-bash" '("lsp-bash-"))) - -;;;*** - -;;;### (autoloads nil "lsp-beancount" "lsp-beancount.el" (0 0 0 0)) -;;; Generated autoloads from lsp-beancount.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-beancount" '("lsp-beancount-"))) - -;;;*** - -;;;### (autoloads nil "lsp-clangd" "lsp-clangd.el" (0 0 0 0)) -;;; Generated autoloads from lsp-clangd.el - -(autoload 'lsp-cpp-flycheck-clang-tidy-error-explainer "lsp-clangd" "\ -Explain a clang-tidy ERROR by scraping documentation from llvm.org. - -\(fn ERROR)" nil nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-clangd" '("lsp-c"))) - -;;;*** - -;;;### (autoloads nil "lsp-clojure" "lsp-clojure.el" (0 0 0 0)) -;;; Generated autoloads from lsp-clojure.el - -(autoload 'lsp-clojure-show-test-tree "lsp-clojure" "\ -Show a test tree and focus on it if IGNORE-FOCUS? is nil. - -\(fn IGNORE-FOCUS\\=\\?)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-clojure" '("lsp-clojure-"))) - -;;;*** - -;;;### (autoloads nil "lsp-completion" "lsp-completion.el" (0 0 0 -;;;;;; 0)) -;;; Generated autoloads from lsp-completion.el - -(define-obsolete-variable-alias 'lsp-prefer-capf 'lsp-completion-provider "lsp-mode 7.0.1") - -(define-obsolete-variable-alias 'lsp-enable-completion-at-point 'lsp-completion-enable "lsp-mode 7.0.1") - -(autoload 'lsp-completion-at-point "lsp-completion" "\ -Get lsp completions." nil nil) - -(autoload 'lsp-completion--enable "lsp-completion" "\ -Enable LSP completion support." nil nil) - -(autoload 'lsp-completion-mode "lsp-completion" "\ -Toggle LSP completion support. - -If called interactively, enable Lsp-Completion mode if ARG is -positive, and disable it if ARG is zero or negative. If called -from Lisp, also enable the mode if ARG is omitted or nil, and -toggle it if ARG is `toggle'; disable the mode otherwise. - -\(fn &optional ARG)" t nil) - -(add-hook 'lsp-configure-hook (lambda nil (when (and lsp-auto-configure lsp-completion-enable) (lsp-completion--enable)))) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-completion" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-crystal" "lsp-crystal.el" (0 0 0 0)) -;;; Generated autoloads from lsp-crystal.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-crystal" '("lsp-clients-crystal-executable"))) - -;;;*** - -;;;### (autoloads nil "lsp-csharp" "lsp-csharp.el" (0 0 0 0)) -;;; Generated autoloads from lsp-csharp.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-csharp" '("lsp-csharp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-css" "lsp-css.el" (0 0 0 0)) -;;; Generated autoloads from lsp-css.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-css" '("lsp-css-"))) - -;;;*** - -;;;### (autoloads nil "lsp-diagnostics" "lsp-diagnostics.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from lsp-diagnostics.el - -(define-obsolete-variable-alias 'lsp-diagnostic-package 'lsp-diagnostics-provider "lsp-mode 7.0.1") - -(define-obsolete-variable-alias 'lsp-flycheck-default-level 'lsp-diagnostics-flycheck-default-level "lsp-mode 7.0.1") - -(autoload 'lsp-diagnostics-lsp-checker-if-needed "lsp-diagnostics" nil nil nil) - -(autoload 'lsp-diagnostics--enable "lsp-diagnostics" "\ -Enable LSP checker support." nil nil) - -(autoload 'lsp-diagnostics-mode "lsp-diagnostics" "\ -Toggle LSP diagnostics integration. - -If called interactively, enable Lsp-Diagnostics mode if ARG is -positive, and disable it if ARG is zero or negative. If called -from Lisp, also enable the mode if ARG is omitted or nil, and -toggle it if ARG is `toggle'; disable the mode otherwise. - -\(fn &optional ARG)" t nil) - -(add-hook 'lsp-configure-hook (lambda nil (when lsp-auto-configure (lsp-diagnostics--enable)))) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-diagnostics" '("lsp-diagnostics-"))) - -;;;*** - -;;;### (autoloads nil "lsp-dired" "lsp-dired.el" (0 0 0 0)) -;;; Generated autoloads from lsp-dired.el - -(defvar lsp-dired-mode nil "\ -Non-nil if Lsp-Dired mode is enabled. -See the `lsp-dired-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `lsp-dired-mode'.") - -(custom-autoload 'lsp-dired-mode "lsp-dired" nil) - -(autoload 'lsp-dired-mode "lsp-dired" "\ -Display `lsp-mode' icons for each file in a dired buffer. - -If called interactively, enable Lsp-Dired mode if ARG is -positive, and disable it if ARG is zero or negative. If called -from Lisp, also enable the mode if ARG is omitted or nil, and -toggle it if ARG is `toggle'; disable the mode otherwise. - -\(fn &optional ARG)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-dired" '("lsp-dired-"))) - -;;;*** - -;;;### (autoloads nil "lsp-dockerfile" "lsp-dockerfile.el" (0 0 0 -;;;;;; 0)) -;;; Generated autoloads from lsp-dockerfile.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-dockerfile" '("lsp-dockerfile-language-server-command"))) - -;;;*** - -;;;### (autoloads nil "lsp-elixir" "lsp-elixir.el" (0 0 0 0)) -;;; Generated autoloads from lsp-elixir.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-elixir" '("lsp-elixir-"))) - -;;;*** - -;;;### (autoloads nil "lsp-elm" "lsp-elm.el" (0 0 0 0)) -;;; Generated autoloads from lsp-elm.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-elm" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-erlang" "lsp-erlang.el" (0 0 0 0)) -;;; Generated autoloads from lsp-erlang.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-erlang" '("lsp-erlang-server-"))) - -;;;*** - -;;;### (autoloads nil "lsp-eslint" "lsp-eslint.el" (0 0 0 0)) -;;; Generated autoloads from lsp-eslint.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-eslint" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-fortran" "lsp-fortran.el" (0 0 0 0)) -;;; Generated autoloads from lsp-fortran.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-fortran" '("lsp-clients-"))) - -;;;*** - -;;;### (autoloads nil "lsp-fsharp" "lsp-fsharp.el" (0 0 0 0)) -;;; Generated autoloads from lsp-fsharp.el - -(autoload 'lsp-fsharp--workspace-load "lsp-fsharp" "\ -Load all of the provided PROJECTS. - -\(fn PROJECTS)" nil nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-fsharp" '("lsp-fsharp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-gdscript" "lsp-gdscript.el" (0 0 0 0)) -;;; Generated autoloads from lsp-gdscript.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-gdscript" '("lsp-gdscript-"))) - -;;;*** - -;;;### (autoloads nil "lsp-go" "lsp-go.el" (0 0 0 0)) -;;; Generated autoloads from lsp-go.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-go" '("lsp-go-"))) - -;;;*** - -;;;### (autoloads nil "lsp-graphql" "lsp-graphql.el" (0 0 0 0)) -;;; Generated autoloads from lsp-graphql.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-graphql" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-groovy" "lsp-groovy.el" (0 0 0 0)) -;;; Generated autoloads from lsp-groovy.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-groovy" '("lsp-groovy-"))) - -;;;*** - -;;;### (autoloads nil "lsp-hack" "lsp-hack.el" (0 0 0 0)) -;;; Generated autoloads from lsp-hack.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-hack" '("lsp-clients-hack-command"))) - -;;;*** - -;;;### (autoloads nil "lsp-haxe" "lsp-haxe.el" (0 0 0 0)) -;;; Generated autoloads from lsp-haxe.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-haxe" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-headerline" "lsp-headerline.el" (0 0 0 -;;;;;; 0)) -;;; Generated autoloads from lsp-headerline.el - -(autoload 'lsp-headerline-breadcrumb-mode "lsp-headerline" "\ -Toggle breadcrumb on headerline. - -If called interactively, enable Lsp-Headerline-Breadcrumb mode if -ARG is positive, and disable it if ARG is zero or negative. If -called from Lisp, also enable the mode if ARG is omitted or nil, -and toggle it if ARG is `toggle'; disable the mode otherwise. - -\(fn &optional ARG)" t nil) - -(autoload 'lsp-breadcrumb-go-to-symbol "lsp-headerline" "\ -Go to the symbol on breadcrumb at SYMBOL-POSITION. - -\(fn SYMBOL-POSITION)" t nil) - -(autoload 'lsp-breadcrumb-narrow-to-symbol "lsp-headerline" "\ -Narrow to the symbol range on breadcrumb at SYMBOL-POSITION. - -\(fn SYMBOL-POSITION)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-headerline" '("lsp-headerline-"))) - -;;;*** - -;;;### (autoloads nil "lsp-html" "lsp-html.el" (0 0 0 0)) -;;; Generated autoloads from lsp-html.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-html" '("lsp-html-"))) - -;;;*** - -;;;### (autoloads nil "lsp-icons" "lsp-icons.el" (0 0 0 0)) -;;; Generated autoloads from lsp-icons.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-icons" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-ido" "lsp-ido.el" (0 0 0 0)) -;;; Generated autoloads from lsp-ido.el - -(autoload 'lsp-ido-workspace-symbol "lsp-ido" "\ -`ido' for lsp workspace/symbol. -When called with prefix ARG the default selection will be symbol at point. - -\(fn ARG)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-ido" '("lsp-ido-"))) - -;;;*** - -;;;### (autoloads nil "lsp-iedit" "lsp-iedit.el" (0 0 0 0)) -;;; Generated autoloads from lsp-iedit.el - -(autoload 'lsp-iedit-highlights "lsp-iedit" "\ -Start an `iedit' operation on the documentHighlights at point. -This can be used as a primitive `lsp-rename' replacement if the -language server doesn't support renaming. - -See also `lsp-enable-symbol-highlighting'." t nil) - -(autoload 'lsp-iedit-linked-ranges "lsp-iedit" "\ -Start an `iedit' for `textDocument/linkedEditingRange'" t nil) - -(autoload 'lsp-evil-multiedit-highlights "lsp-iedit" "\ -Start an `evil-multiedit' operation on the documentHighlights at point. -This can be used as a primitive `lsp-rename' replacement if the -language server doesn't support renaming. - -See also `lsp-enable-symbol-highlighting'." t nil) - -(autoload 'lsp-evil-multiedit-linked-ranges "lsp-iedit" "\ -Start an `evil-multiedit' for `textDocument/linkedEditingRange'" t nil) - -(autoload 'lsp-evil-state-highlights "lsp-iedit" "\ -Start `iedit-mode'. for `textDocument/documentHighlight'" t nil) - -(autoload 'lsp-evil-state-linked-ranges "lsp-iedit" "\ -Start `iedit-mode'. for `textDocument/linkedEditingRange'" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-iedit" '("lsp-iedit--on-ranges"))) - -;;;*** - -;;;### (autoloads nil "lsp-javascript" "lsp-javascript.el" (0 0 0 -;;;;;; 0)) -;;; Generated autoloads from lsp-javascript.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-javascript" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-json" "lsp-json.el" (0 0 0 0)) -;;; Generated autoloads from lsp-json.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-json" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-kotlin" "lsp-kotlin.el" (0 0 0 0)) -;;; Generated autoloads from lsp-kotlin.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-kotlin" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-lens" "lsp-lens.el" (0 0 0 0)) -;;; Generated autoloads from lsp-lens.el - -(autoload 'lsp-lens--enable "lsp-lens" "\ -Enable lens mode." nil nil) - -(autoload 'lsp-lens-show "lsp-lens" "\ -Display lenses in the buffer." t nil) - -(autoload 'lsp-lens-hide "lsp-lens" "\ -Delete all lenses." t nil) - -(autoload 'lsp-lens-mode "lsp-lens" "\ -Toggle code-lens overlays. - -If called interactively, enable Lsp-Lens mode if ARG is positive, -and disable it if ARG is zero or negative. If called from Lisp, -also enable the mode if ARG is omitted or nil, and toggle it if -ARG is `toggle'; disable the mode otherwise. - -\(fn &optional ARG)" t nil) - -(autoload 'lsp-avy-lens "lsp-lens" "\ -Click lsp lens using `avy' package." t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-lens" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-lua" "lsp-lua.el" (0 0 0 0)) -;;; Generated autoloads from lsp-lua.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-lua" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-markdown" "lsp-markdown.el" (0 0 0 0)) -;;; Generated autoloads from lsp-markdown.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-markdown" '("lsp-markdown-"))) - -;;;*** - -;;;### (autoloads nil "lsp-mode" "lsp-mode.el" (0 0 0 0)) -;;; Generated autoloads from lsp-mode.el -(put 'lsp-enable-file-watchers 'safe-local-variable #'booleanp) -(put 'lsp-file-watch-ignored-directories 'safe-local-variable 'lsp--string-listp) -(put 'lsp-file-watch-ignored-files 'safe-local-variable 'lsp--string-listp) -(put 'lsp-file-watch-threshold 'safe-local-variable (lambda (i) (or (numberp i) (not i)))) - -(autoload 'lsp--string-listp "lsp-mode" "\ -Return t if all elements of SEQUENCE are strings, else nil. - -\(fn SEQUENCE)" nil nil) - -(autoload 'lsp-load-vscode-workspace "lsp-mode" "\ -Load vscode workspace from FILE - -\(fn FILE)" t nil) - -(autoload 'lsp-save-vscode-workspace "lsp-mode" "\ -Save vscode workspace to FILE - -\(fn FILE)" t nil) - -(autoload 'lsp-install-server "lsp-mode" "\ -Interactively install or re-install server. -When prefix UPDATE? is t force installation even if the server is present. - -\(fn UPDATE\\=\\? &optional SERVER-ID)" t nil) - -(autoload 'lsp-update-server "lsp-mode" "\ -Interactively update a server. - -\(fn &optional SERVER-ID)" t nil) - -(autoload 'lsp-ensure-server "lsp-mode" "\ -Ensure server SERVER-ID - -\(fn SERVER-ID)" nil nil) - -(autoload 'lsp "lsp-mode" "\ -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. - -\(fn &optional ARG)" t nil) - -(autoload 'lsp-deferred "lsp-mode" "\ -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." nil nil) - -(autoload 'lsp-start-plain "lsp-mode" "\ -Start `lsp-mode' using mininal configuration using the latest `melpa' version of the packages. - -In case the major-mode that you are using for " t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-mode" '("defcustom-lsp" "lsp-" "make-lsp-client" "when-lsp-workspace" "with-lsp-workspace"))) - -;;;*** - -;;;### (autoloads nil "lsp-modeline" "lsp-modeline.el" (0 0 0 0)) -;;; Generated autoloads from lsp-modeline.el - -(define-obsolete-variable-alias 'lsp-diagnostics-modeline-scope 'lsp-modeline-diagnostics-scope "lsp-mode 7.0.1") - -(autoload 'lsp-modeline-code-actions-mode "lsp-modeline" "\ -Toggle code actions on modeline. - -If called interactively, enable Lsp-Modeline-Code-Actions mode if -ARG is positive, and disable it if ARG is zero or negative. If -called from Lisp, also enable the mode if ARG is omitted or nil, -and toggle it if ARG is `toggle'; disable the mode otherwise. - -\(fn &optional ARG)" t nil) - -(define-obsolete-function-alias 'lsp-diagnostics-modeline-mode 'lsp-modeline-diagnostics-mode "lsp-mode 7.0.1") - -(autoload 'lsp-modeline-diagnostics-mode "lsp-modeline" "\ -Toggle diagnostics modeline. - -If called interactively, enable Lsp-Modeline-Diagnostics mode if -ARG is positive, and disable it if ARG is zero or negative. If -called from Lisp, also enable the mode if ARG is omitted or nil, -and toggle it if ARG is `toggle'; disable the mode otherwise. - -\(fn &optional ARG)" t nil) - -(autoload 'lsp-modeline-workspace-status-mode "lsp-modeline" "\ -Toggle workspace status on modeline. - -If called interactively, enable Lsp-Modeline-Workspace-Status -mode if ARG is positive, and disable it if ARG is zero or -negative. If called from Lisp, also enable the mode if ARG is -omitted or nil, and toggle it if ARG is `toggle'; disable the -mode otherwise. - -\(fn &optional ARG)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-modeline" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-nginx" "lsp-nginx.el" (0 0 0 0)) -;;; Generated autoloads from lsp-nginx.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-nginx" '("lsp-nginx-server-command"))) - -;;;*** - -;;;### (autoloads nil "lsp-nix" "lsp-nix.el" (0 0 0 0)) -;;; Generated autoloads from lsp-nix.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-nix" '("lsp-nix-server-path"))) - -;;;*** - -;;;### (autoloads nil "lsp-ocaml" "lsp-ocaml.el" (0 0 0 0)) -;;; Generated autoloads from lsp-ocaml.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-ocaml" '("lsp-ocaml-l"))) - -;;;*** - -;;;### (autoloads nil "lsp-perl" "lsp-perl.el" (0 0 0 0)) -;;; Generated autoloads from lsp-perl.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-perl" '("lsp-perl-"))) - -;;;*** - -;;;### (autoloads nil "lsp-php" "lsp-php.el" (0 0 0 0)) -;;; Generated autoloads from lsp-php.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-php" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-prolog" "lsp-prolog.el" (0 0 0 0)) -;;; Generated autoloads from lsp-prolog.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-prolog" '("lsp-prolog-server-command"))) - -;;;*** - -;;;### (autoloads nil "lsp-protocol" "lsp-protocol.el" (0 0 0 0)) -;;; Generated autoloads from lsp-protocol.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-protocol" '("dash-expand:&RangeToPoint" "lsp"))) - -;;;*** - -;;;### (autoloads nil "lsp-purescript" "lsp-purescript.el" (0 0 0 -;;;;;; 0)) -;;; Generated autoloads from lsp-purescript.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-purescript" '("lsp-purescript-"))) - -;;;*** - -;;;### (autoloads nil "lsp-pwsh" "lsp-pwsh.el" (0 0 0 0)) -;;; Generated autoloads from lsp-pwsh.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-pwsh" '("lsp-pwsh-"))) - -;;;*** - -;;;### (autoloads nil "lsp-pyls" "lsp-pyls.el" (0 0 0 0)) -;;; Generated autoloads from lsp-pyls.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-pyls" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-pylsp" "lsp-pylsp.el" (0 0 0 0)) -;;; Generated autoloads from lsp-pylsp.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-pylsp" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-r" "lsp-r.el" (0 0 0 0)) -;;; Generated autoloads from lsp-r.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-r" '("lsp-clients-r-server-command"))) - -;;;*** - -;;;### (autoloads nil "lsp-racket" "lsp-racket.el" (0 0 0 0)) -;;; Generated autoloads from lsp-racket.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-racket" '("lsp-racket-lang"))) - -;;;*** - -;;;### (autoloads nil "lsp-remark" "lsp-remark.el" (0 0 0 0)) -;;; Generated autoloads from lsp-remark.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-remark" '("lsp-remark-server-command"))) - -;;;*** - -;;;### (autoloads nil "lsp-rf" "lsp-rf.el" (0 0 0 0)) -;;; Generated autoloads from lsp-rf.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-rf" '("expand-start-command" "lsp-rf-language-server-" "parse-rf-language-server-"))) - -;;;*** - -;;;### (autoloads nil "lsp-rust" "lsp-rust.el" (0 0 0 0)) -;;; Generated autoloads from lsp-rust.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-rust" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-semantic-tokens" "lsp-semantic-tokens.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from lsp-semantic-tokens.el - -(autoload 'lsp--semantic-tokens-initialize-buffer "lsp-semantic-tokens" "\ -Initialize the buffer for semantic tokens. -IS-RANGE-PROVIDER is non-nil when server supports range requests." nil nil) - -(autoload 'lsp--semantic-tokens-initialize-workspace "lsp-semantic-tokens" "\ -Initialize semantic tokens for WORKSPACE. - -\(fn WORKSPACE)" nil nil) - -(autoload 'lsp-semantic-tokens--warn-about-deprecated-setting "lsp-semantic-tokens" "\ -Warn about deprecated semantic highlighting variable." nil nil) - -(autoload 'lsp-semantic-tokens--enable "lsp-semantic-tokens" "\ -Enable semantic tokens mode." nil nil) - -(autoload 'lsp-semantic-tokens-mode "lsp-semantic-tokens" "\ -Toggle semantic-tokens support. - -If called interactively, enable Lsp-Semantic-Tokens mode if ARG -is positive, and disable it if ARG is zero or negative. If -called from Lisp, also enable the mode if ARG is omitted or nil, -and toggle it if ARG is `toggle'; disable the mode otherwise. - -\(fn &optional ARG)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-semantic-tokens" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-solargraph" "lsp-solargraph.el" (0 0 0 -;;;;;; 0)) -;;; Generated autoloads from lsp-solargraph.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-solargraph" '("lsp-solargraph-"))) - -;;;*** - -;;;### (autoloads nil "lsp-sorbet" "lsp-sorbet.el" (0 0 0 0)) -;;; Generated autoloads from lsp-sorbet.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-sorbet" '("lsp-sorbet-"))) - -;;;*** - -;;;### (autoloads nil "lsp-sqls" "lsp-sqls.el" (0 0 0 0)) -;;; Generated autoloads from lsp-sqls.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-sqls" '("lsp-sql"))) - -;;;*** - -;;;### (autoloads nil "lsp-steep" "lsp-steep.el" (0 0 0 0)) -;;; Generated autoloads from lsp-steep.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-steep" '("lsp-steep-"))) - -;;;*** - -;;;### (autoloads nil "lsp-svelte" "lsp-svelte.el" (0 0 0 0)) -;;; Generated autoloads from lsp-svelte.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-svelte" '("lsp-svelte-plugin-"))) - -;;;*** - -;;;### (autoloads nil "lsp-terraform" "lsp-terraform.el" (0 0 0 0)) -;;; Generated autoloads from lsp-terraform.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-terraform" '("lsp-terraform-"))) - -;;;*** - -;;;### (autoloads nil "lsp-tex" "lsp-tex.el" (0 0 0 0)) -;;; Generated autoloads from lsp-tex.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-tex" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-toml" "lsp-toml.el" (0 0 0 0)) -;;; Generated autoloads from lsp-toml.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-toml" '("lsp-toml-"))) - -;;;*** - -;;;### (autoloads nil "lsp-v" "lsp-v.el" (0 0 0 0)) -;;; Generated autoloads from lsp-v.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-v" '("lsp-v-vls-executable"))) - -;;;*** - -;;;### (autoloads nil "lsp-vala" "lsp-vala.el" (0 0 0 0)) -;;; Generated autoloads from lsp-vala.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-vala" '("lsp-clients-vala-ls-executable"))) - -;;;*** - -;;;### (autoloads nil "lsp-verilog" "lsp-verilog.el" (0 0 0 0)) -;;; Generated autoloads from lsp-verilog.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-verilog" '("lsp-clients-"))) - -;;;*** - -;;;### (autoloads nil "lsp-vetur" "lsp-vetur.el" (0 0 0 0)) -;;; Generated autoloads from lsp-vetur.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-vetur" '("lsp-"))) - -;;;*** - -;;;### (autoloads nil "lsp-vhdl" "lsp-vhdl.el" (0 0 0 0)) -;;; Generated autoloads from lsp-vhdl.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-vhdl" '("ghdl-ls-bin-name" "hdl-checker-bin-name" "lsp-vhdl-" "vhdl-"))) - -;;;*** - -;;;### (autoloads nil "lsp-vimscript" "lsp-vimscript.el" (0 0 0 0)) -;;; Generated autoloads from lsp-vimscript.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-vimscript" '("lsp-clients-vim-"))) - -;;;*** - -;;;### (autoloads nil "lsp-xml" "lsp-xml.el" (0 0 0 0)) -;;; Generated autoloads from lsp-xml.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-xml" '("lsp-xml-"))) - -;;;*** - -;;;### (autoloads nil "lsp-yaml" "lsp-yaml.el" (0 0 0 0)) -;;; Generated autoloads from lsp-yaml.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-yaml" '("lsp-yaml-"))) - -;;;*** - -;;;### (autoloads nil "lsp-zig" "lsp-zig.el" (0 0 0 0)) -;;; Generated autoloads from lsp-zig.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lsp-zig" '("lsp-zig-zls-executable"))) - -;;;*** - -;;;### (autoloads nil nil ("lsp-cmake.el" "lsp-d.el" "lsp-dhall.el" -;;;;;; "lsp-mode-pkg.el" "lsp-nim.el" "lsp.el") (0 0 0 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; lsp-mode-autoloads.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-mode-pkg.el b/elpa/lsp-mode-20220201.852/lsp-mode-pkg.el deleted file mode 100644 index 9d984428..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-mode-pkg.el +++ /dev/null @@ -1,18 +0,0 @@ -(define-package "lsp-mode" "20220201.852" "LSP mode" - '((emacs "26.1") - (dash "2.18.0") - (f "0.20.0") - (ht "2.3") - (spinner "1.7.3") - (markdown-mode "2.3") - (lv "0")) - :commit "fbfaa80095a82f7473cb7e45fe73b32ecc1900ae" :authors - '(("Vibhav Pant, Fangrui Song, Ivan Yonchovski")) - :maintainer - '("Vibhav Pant, Fangrui Song, Ivan Yonchovski") - :keywords - '("languages") - :url "https://github.com/emacs-lsp/lsp-mode") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/lsp-mode-20220201.852/lsp-mode.el b/elpa/lsp-mode-20220201.852/lsp-mode.el deleted file mode 100644 index 146e759c..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-mode.el +++ /dev/null @@ -1,8890 +0,0 @@ -;;; lsp-mode.el --- LSP mode -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: Vibhav Pant, Fangrui Song, Ivan Yonchovski -;; Keywords: languages -;; Package-Requires: ((emacs "26.1") (dash "2.18.0") (f "0.20.0") (ht "2.3") (spinner "1.7.3") (markdown-mode "2.3") (lv "0")) -;; Version: 8.0.1 - -;; 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 . - -;;; 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 'yasnippet nil t) -(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 . "8.0.1")) - -(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-bash lsp-beancount lsp-clangd lsp-clojure lsp-cmake - lsp-crystal lsp-csharp lsp-css lsp-d lsp-dart lsp-dhall lsp-docker lsp-dockerfile lsp-elm - lsp-elixir lsp-erlang lsp-eslint lsp-fortran lsp-fsharp lsp-gdscript lsp-go lsp-graphql - lsp-hack lsp-grammarly lsp-groovy lsp-haskell lsp-haxe lsp-java lsp-javascript lsp-json - lsp-kotlin lsp-latex lsp-ltex lsp-lua lsp-markdown lsp-nginx lsp-nim lsp-nix lsp-metals lsp-mssql lsp-ocaml lsp-pascal lsp-perl lsp-php lsp-pwsh - lsp-pyls lsp-pylsp lsp-pyright lsp-python-ms lsp-purescript lsp-r lsp-remark lsp-rf lsp-rust lsp-solargraph lsp-sorbet lsp-sourcekit lsp-sonarlint - lsp-tailwindcss lsp-tex lsp-terraform lsp-toml lsp-v lsp-vala lsp-verilog lsp-vetur lsp-vhdl lsp-vimscript lsp-xml - lsp-yaml lsp-sqls lsp-svelte lsp-steep 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) - -(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-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/blacklisted 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\\'" - "[/\\\\]\\.circleci\\'" - "[/\\\\]\\.hg\\'" - "[/\\\\]\\.bzr\\'" - "[/\\\\]_darcs\\'" - "[/\\\\]\\.svn\\'" - "[/\\\\]_FOSSIL_\\'" - ;; IDE or build tools - "[/\\\\]\\.idea\\'" - "[/\\\\]\\.ensime_cache\\'" - "[/\\\\]\\.eunit\\'" - "[/\\\\]node_modules" - "[/\\\\]\\.yarn\\'" - "[/\\\\]\\.fslckout\\'" - "[/\\\\]\\.tox\\'" - "[/\\\\]dist\\'" - "[/\\\\]dist-newstyle\\'" - "[/\\\\]\\.stack-work\\'" - "[/\\\\]\\.bloop\\'" - "[/\\\\]\\.metals\\'" - "[/\\\\]target\\'" - "[/\\\\]\\.ccls-cache\\'" - "[/\\\\]\\.vscode\\'" - "[/\\\\]\\.venv\\'" - "[/\\\\]\\.mypy_cache\\'" - ;; Autotools output - "[/\\\\]\\.deps\\'" - "[/\\\\]build-aux\\'" - "[/\\\\]autom4te.cache\\'" - "[/\\\\]\\.reference\\'" - ;; Clojure - "[/\\\\]\\.lsp\\'" - "[/\\\\]\\.clj-kondo\\'" - "[/\\\\]\\.shadow-cljs\\'" - "[/\\\\]\\.babel_cache\\'" - "[/\\\\]\\.cpcache\\'" - "[/\\\\]\\checkouts\\'" - ;; Maven - "[/\\\\]\\.m2\\'" - ;; .Net Core build-output - "[/\\\\]bin/Debug\\'" - "[/\\\\]obj\\'" - ;; OCaml and Dune - "[/\\\\]_opam\\'" - "[/\\\\]_build\\'" - ;; Elixir - "[/\\\\]\\.elixir_ls\\'" - ;; nix-direnv - "[/\\\\]\\.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-none 0) -(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 should not be synced at all." nil) - (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-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-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) - -(defcustom lsp-eldoc-hook '(lsp-hover) - "Hooks to run for eldoc." - :type 'hook - :group 'lsp-mode) - -(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" Constuctor) - (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 . "8.0.1")) - -(defvar lsp-language-id-configuration '((".*\\.vue$" . "vue") - (".*\\.tsx$" . "typescriptreact") - (".*\\.ts$" . "typescript") - (".*\\.jsx$" . "javascriptreact") - (".*\\.js$" . "javascript") - (".*\\.xml$" . "xml") - (".*\\.hx$" . "haxe") - (".*\\.lua$" . "lua") - (".*\\.sql$" . "sql") - (".*\\.html$" . "html") - (".*\\.css" . "css") - (".*/settings.json$" . "jsonc") - (".*\\.json$" . "json") - (".*\\.jsonc$" . "jsonc") - (".*\\.php$" . "php") - (".*\\.svelte$" . "svelte") - (".*\\.ebuild$" . "shellscript") - (ada-mode . "ada") - (nxml-mode . "xml") - (sql-mode . "sql") - (vimrc-mode . "vim") - (sh-mode . "shellscript") - (ebuild-mode . "shellscript") - (scala-mode . "scala") - (julia-mode . "julia") - (clojure-mode . "clojure") - (clojurec-mode . "clojure") - (clojurescript-mode . "clojurescript") - (java-mode . "java") - (jdee-mode . "java") - (groovy-mode . "groovy") - (python-mode . "python") - (cython-mode . "python") - (lsp--render-markdown . "markdown") - (rust-mode . "rust") - (rustic-mode . "rust") - (kotlin-mode . "kotlin") - (css-mode . "css") - (less-mode . "less") - (less-css-mode . "less") - (lua-mode . "lua") - (sass-mode . "sass") - (ssass-mode . "sass") - (scss-mode . "scss") - (xml-mode . "xml") - (c-mode . "c") - (c++-mode . "cpp") - (objc-mode . "objective-c") - (html-mode . "html") - (sgml-mode . "html") - (mhtml-mode . "html") - (go-dot-mod-mode . "go.mod") - (go-mode . "go") - (graphql-mode . "graphql") - (haskell-mode . "haskell") - (hack-mode . "hack") - (php-mode . "php") - (powershell-mode . "powershell") - (powershell-mode . "PowerShell") - (json-mode . "json") - (jsonc-mode . "jsonc") - (rjsx-mode . "javascript") - (js2-mode . "javascript") - (js-mode . "javascript") - (typescript-mode . "typescript") - (fsharp-mode . "fsharp") - (reason-mode . "reason") - (caml-mode . "ocaml") - (tuareg-mode . "ocaml") - (swift-mode . "swift") - (elixir-mode . "elixir") - (conf-javaprop-mode . "spring-boot-properties") - (yaml-mode . "spring-boot-properties-yaml") - (ruby-mode . "ruby") - (enh-ruby-mode . "ruby") - (fortran-mode . "fortran") - (f90-mode . "fortran") - (elm-mode . "elm") - (dart-mode . "dart") - (erlang-mode . "erlang") - (dockerfile-mode . "dockerfile") - (csharp-mode . "csharp") - (csharp-tree-sitter-mode . "csharp") - (plain-tex-mode . "plaintex") - (latex-mode . "latex") - (v-mode . "v") - (vhdl-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") - (purescript-mode . "purescript") - (gdscript-mode . "gdscript") - (perl-mode . "perl") - (cperl-mode . "perl") - (robot-mode . "robot") - (racket-mode . "racket") - (nix-mode . "nix") - (prolog-mode . "prolog") - (vala-mode . "vala") - (actionscript-mode . "actionscript") - (d-mode . "d") - (zig-mode . "zig") - (text-mode . "plaintext") - (markdown-mode . "markdown") - (gfm-mode . "markdown") - (beancount-mode . "beancount") - (conf-toml-mode . "toml") - (org-mode . "org") - (nginx-mode . "nginx")) - "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? - (or (lsp--capability :codeActionProvider) - (when-let ((maybe-capability (lsp--registered-capability "textDocument/codeAction")) - (capability-options (lsp--registered-capability-options maybe-capability))) - capability-options)))))) - ("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 :completionProvider))))) - ("textDocument/declaration" :capability :declarationProvider) - ("textDocument/definition" :capability :definitionProvider) - ("textDocument/documentColor" :capability :colorProvider) - ("textDocument/documentLink" :capability :documentLinkProvider) - ("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? - (or (lsp--capability :renameProvider) - (when-let ((maybe-capability (lsp--registered-capability "textDocument/rename"))) - (lsp--registered-capability-options maybe-capability))))))) - ("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) - ("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 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-defgeneric 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 (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--eldoc-message (&optional msg) - "Show MSG in eldoc." - (setq lsp--eldoc-saved-message msg) - (run-with-idle-timer 0 nil (lambda () - ;; XXX: new eldoc in Emacs 28 - ;; recommends running the hook variable - ;; `eldoc-documentation-functions' - ;; instead of using eldoc-message - (with-no-warnings - (eldoc-message msg))))) - -(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 'progress-bar-filled) (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)))) - -(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)) - - ;; 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 - ;; Overrides semantic tokens faces for specific clients - 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--capability :selectionRangeProvider) - (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)) - (file (decode-coding-string (url-filename url) - (or locale-coding-system 'utf-8))) - (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 (f-dir-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) - "Traverse DIR recursively and return a list of paths that should have watchers set on them. -IGNORED-DIRECTORIES will be used for exclusions" - (let* ((dir (if (f-symlink? dir) - (file-truename dir) - dir))) - (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)) - ;; 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 _err - (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)) - - - -(defconst lsp-downstream-deps - '(;; external packages - ccls consult-lsp dap-mode helm-lsp lsp-dart lsp-docker lsp-focus lsp-grammarly - lsp-haskell lsp-ivy lsp-java lsp-javacomp lsp-jedi lsp-julia lsp-latex lsp-ltex - lsp-metals lsp-mssql lsp-origami lsp-p4 lsp-pascal lsp-pyre lsp-pyright - lsp-python-ms lsp-rescript lsp-sonarlint lsp-sourcekit lsp-tailwindcss lsp-treemacs - lsp-ui swift-helpful - ;; clients - lsp-actionscript lsp-ada lsp-angular lsp-bash lsp-beancount lsp-clangd - lsp-clojure lsp-cmake lsp-crystal lsp-csharp lsp-css lsp-d lsp-dhall - lsp-dockerfile lsp-elixir lsp-elm lsp-erlang lsp-eslint lsp-fortran lsp-fsharp lsp-gdscript - lsp-go lsp-graphql lsp-groovy lsp-hack lsp-haxe lsp-html lsp-javascript lsp-json lsp-kotlin lsp-lua - lsp-markdown lsp-nginx lsp-nim lsp-nix lsp-ocaml lsp-perl lsp-php lsp-prolog lsp-purescript lsp-pwsh - lsp-pyls lsp-pylsp lsp-racket lsp-r lsp-rf lsp-rust lsp-solargraph lsp-sorbet lsp-sqls - lsp-steep lsp-svelte lsp-terraform lsp-tex lsp-toml lsp-v lsp-vala lsp-verilog lsp-vetur lsp-vhdl - lsp-vimscript lsp-xml lsp-yaml lsp-zig) - "List of downstream deps.") - -(defmacro lsp-consistency-check (package) - `(defconst ,(intern (concat (symbol-name package) - "-plist-value-when-compiled")) - (eval-when-compile lsp-use-plists))) - -;; (mapc -;; (lambda (package) -;; (with-eval-after-load package -;; (let ((symbol-name (intern -;; (concat (symbol-name package) -;; "-plist-value-when-compiled")))) -;; (cond -;; ((not (boundp symbol-name)) -;; (warn "We have detected that you are using version of %s that is not compatible with current version of lsp-mode.el, please update it." (propertize (symbol-name package) -;; 'face 'bold))) -;; ((not (eq (symbol-value symbol-name) lsp-use-plists)) -;; (warn "Package %s is inconsistent with lsp-mode.el. This is indication of race during installation. In order to solve that please delete all packages related to lsp-mode, restar Emacs and install them again." (propertize (symbol-name package) 'face 'bold))))))) -;; lsp-downstream-deps) - - -;; 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-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 the user and send the user's selection back to the 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 ignore :tag "Ignore") - (function :tag "Other function")) - :package-version '(lsp-mode . "8.0.0")) - -(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 'progress-bar 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--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)))) - -(lsp-defun lsp--on-diagnostics-update-stats (workspace - (&PublishDiagnosticsParams :uri :diagnostics)) - (let ((path (lsp--fix-path-casing (lsp--uri-to-path uri))) - (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)))) - -(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 () - (if (and (or (lsp--capability :foldingRangeProvider) - (lsp--registered-capability "textDocument/foldingRange")) - lsp-enable-folding) - (if-let ((range (lsp--get-current-innermost-folding-range))) - (cons (lsp--folding-range-beg range) - (lsp--folding-range-end range))) - nil)) -(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 (or (lsp--capability :foldingRangeProvider) - (lsp--registered-capability "textDocument/foldingRange")) - lsp-enable-folding - (not (zerop n))) - (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--capability :hoverProvider) - (->> (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-blacklist-remove "un-blacklist 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." - (let* ((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-") #'lsp-find-definition-mouse) - (define-key map (kbd "C-") #'ignore) - (define-key map (kbd "") #'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 "" - :keymap lsp-mode-map - :lighter - (" LSP[" - (lsp--buffer-workspaces - (:eval (mapconcat #'lsp--workspace-print lsp--buffer-workspaces "][")) - (:propertize "Disconnected" face warning)) - "]") - :group 'lsp-mode) - -(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-blacklist - ;; 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-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: ") - (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 (lsp--make-message 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 (time-to-seconds (current-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)) - (catch 'lsp-done - (accept-process-output - nil - (if expected-time (- expected-time send-time) 1))) - (setq send-time (time-to-seconds (current-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 non-essential - (let* ((send-time (time-to-seconds (current-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 (time-to-seconds (current-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 . "8.0.1")) - -(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)) - ;; 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))))) - (buf (current-buffer)) - ;; 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) (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))) - (cancel-callback (when cancel-callback - (pcase mode - ((or 'alive 'tick 'unchanged) - (lambda () - (with-current-buffer buf - (funcall cancel-callback)))) - (_ cancel-callback)))) - (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)) - (let ((message (lsp--make-message body))) - (puthash id - (list callback error-callback method start-time (current-time)) - (-> workspace - (lsp--workspace-client) - (lsp--client-response-handlers))) - (lsp--send-no-wait message (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" lsp--empty-ht) - (error (lsp--error "Timeout while sending shutdown request")))) - (lsp-notify "exit" nil)) - (setf (lsp--workspace-shutdown-action lsp--cur-workspace) (or (and restart 'restart) 'shutdown)) - (lsp--uninitialize-workspace)) - -(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 ((proc (lsp--workspace-cmd-proc lsp--cur-workspace)) - (buffers (lsp--workspace-buffers lsp--cur-workspace))) - (when (process-live-p proc) - (kill-process 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 - `((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))))) - (fileOperations . ((didCreate . :json-false) - (willCreate . :json-false) - (didRename . :json-false) - (willRename . :json-false) - (didDelete . :json-false) - (willDelete . :json-false))))) - (textDocument . ((declaration . ((linkSupport . t))) - (definition . ((linkSupport . t))) - (implementation . ((linkSupport . t))) - (typeDefinition . ((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))) - ,@(when (and lsp-semantic-tokens-enable - (boundp '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 (featurep 'yasnippet)) t) - (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" - "details" - "additionalTextEdits" - "command"]))) - (insertTextModeSupport . ((valueSet . [1 2]))))) - (contextSupport . t))) - (signatureHelp . ((signatureInformation . ((parameterInformation . ((labelOffsetSupport . t))))))) - (documentLink . ((dynamicRegistration . t) - (tooltipSupport . t))) - (hover . ((contentFormat . ["markdown" "plaintext"]))) - (foldingRange . ,(when lsp-enable-folding - `((dynamicRegistration . t) - ,@(when lsp-folding-range-limit - `((rangeLimit . ,lsp-folding-range-limit))) - ,@(when lsp-folding-line-folding-only - `((lineFoldingOnly . t)))))) - (callHierarchy . ((dynamicRegistration . :json-false))) - (publishDiagnostics . ((relatedInformation . t) - (tagSupport . ((valueSet . [1 2]))) - (versionSupport . t))) - (linkedEditingRange . ((dynamicRegistration . t))))) - (window . ((workDoneProgress . t) - (showMessage . nil) - (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?))) - -(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 (featurep 'projectile) (condition-case nil - (projectile-project-root) - (error nil))) - (when (featurep 'project) - (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-blacklist-remove (project-root) - "Remove PROJECT-ROOT from the workspace blacklist." - (interactive (list (completing-read "Select folder to remove:" - (lsp-session-folders-blacklist (lsp-session)) - nil t))) - (setf (lsp-session-folders-blacklist (lsp-session)) - (delete project-root - (lsp-session-folders-blacklist (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 :documentOnTypeFormattingProvider))) - (-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 :signatureHelpProvider)) - (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) - (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)) - -(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-function :before-until (local 'eldoc-documentation-function) #'lsp-eldoc-function) - (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-function (local 'eldoc-documentation-function) #'lsp-eldoc-function) - - (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 - (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")) - (setq-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-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." - (run-hooks 'lsp-unconfigure-hook) - - (lsp--remove-overlays 'lsp-color) - (when (eq indent-region-function #'lsp-format-region) - (setq-local indent-region-function nil)) - (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)) - -(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) - - (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 (point-at-bol) (point-at-eol)))) - -(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"))) - -(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." - ;; 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. - (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." - (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 - (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)) - -(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)))))) - (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-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)) - (setq lsp--signature-last-index nil - lsp--signature-last nil) - ;; cleanup diagnostics - (when lsp-diagnostic-clean-after-change - (lsp-foreach-workspace - (-let [diagnostics (lsp--workspace-diagnostics lsp--cur-workspace)] - (remhash (lsp--fix-path-casing (buffer-file-name)) diagnostics)))))))) - - - -;; 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) - (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)) - - - -(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 (if indent-tabs-mode :json-false t)) - :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" - (find-file (lsp--uri-to-path url)) - (-when-let ((_ line column) (s-match (rx "#" (group (1+ num)) "," (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 :documentLinkProvider)) - (lsp-request-async - "documentLink/resolve" - link - (-lambda ((&DocumentLink :target?)) - (lsp--document-link-handle-target target?))))))) - - - -(defun lsp-buffer-language () - "Get language corresponding current buffer." - (or (->> 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) - (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))) - -(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))) - -(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) - 'highlight t line) - ;; LINE is nil when FILENAME is not being current visited by any buffer. - (xref-make (or line filename) - (xref-make-file-location - filename - (lsp-translate-line (1+ start-line)) - (lsp-translate-column 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 (Location) - (LocationLink))) - (append locations nil)) - ((or (Location) - (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 include-declaration) - "Make a ReferenceParam object. -If TD-POSITION is non-nil, use it as TextDocumentPositionParams object instead. -If INCLUDE-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 ,(or include-declaration json-false))))) - -(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)))) - -(defun lsp-eldoc-function () - "`lsp-mode' eldoc function." - (run-hooks 'lsp-eldoc-hook) - eldoc-last-message) - -(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 "[[: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-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) - (with-help-window lsp-help-buf-name - (insert (string-trim-right (lsp--render-on-hover-content contents t)))))) - (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)) - -(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 . "8.0.1")) - -(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)) - (condition-case nil - (with-temp-buffer - (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)) - (lsp--buffer-string-visible)) - (error str)))) - -(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 ((mode (-some (-lambda ((mode . lang)) - (when (and (equal lang language) (functionp mode)) - mode)) - lsp-language-id-configuration))) - (lsp--fontlock-with-mode str mode) - str)) - -(defun lsp--render-element (content) - "Render CONTENT element." - (let ((inhibit-message t)) - (or - (pcase content - ((MarkedString :value :language) - (lsp--render-string value language)) - ((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-defgeneric 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-filter - (-andfn #'lsp-marked-string? - (-compose #'lsp-get-renderer #'lsp:marked-string-language)) - contents))) - (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-map'.") - -(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 'font-lock-comment-face :foreground 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)) - -(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 'eldoc-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))) - - -;; hover - -(defvar-local lsp--hover-saved-bounds nil) - -(defun lsp-hover () - "Display hover info (based on `textDocument/signatureHelp')." - (if (and lsp--hover-saved-bounds - (lsp--point-in-bounds-p lsp--hover-saved-bounds)) - (lsp--eldoc-message lsp--eldoc-saved-message) - (setq lsp--hover-saved-bounds nil - lsp--eldoc-saved-message nil) - (if (looking-at "[[:space:]\n]") - (lsp--eldoc-message nil) - (when (and lsp-eldoc-enable-hover (lsp--capability :hoverProvider)) - (lsp-request-async - "textDocument/hover" - (lsp--text-document-position-params) - (-lambda ((hover &as &Hover? :range? :contents)) - (when hover - (when range? - (setq lsp--hover-saved-bounds (lsp--range-to-region range?))) - (lsp--eldoc-message (and contents - (lsp--render-on-hover-content - contents - lsp-eldoc-render-all))))) - :error-handler #'ignore - :mode 'tick - :cancel-token :eldoc-hover))))) - - - -(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-line-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. -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?) (lsp--execute-command command?)))) - -(defvar lsp--formatting-indent-alist - ;; Taken from `dtrt-indent-mode' - '((c-mode . c-basic-offset) ; C - (c++-mode . c-basic-offset) ; C++ - (csharp-mode . c-basic-offset) ; C# - (csharp-tree-sitter-mode . csharp-tree-sitter-indent-offset) ; C# - (d-mode . c-basic-offset) ; D - (java-mode . c-basic-offset) ; Java - (jde-mode . c-basic-offset) ; Java (JDE) - (js-mode . js-indent-level) ; JavaScript - (js2-mode . js2-basic-offset) ; JavaScript-IDE - (js3-mode . js3-indent-level) ; JavaScript-IDE - (json-mode . js-indent-level) ; JSON - (lua-mode . lua-indent-level) ; Lua - (objc-mode . c-basic-offset) ; Objective C - (php-mode . c-basic-offset) ; PHP - (perl-mode . perl-indent-level) ; Perl - (cperl-mode . cperl-indent-level) ; Perl - (raku-mode . raku-indent-offset) ; Perl6/Raku - (erlang-mode . erlang-indent-level) ; Erlang - (ada-mode . ada-indent) ; Ada - (sgml-mode . sgml-basic-offset) ; SGML - (nxml-mode . nxml-child-indent) ; XML - (pascal-mode . pascal-indent-level) ; Pascal - (typescript-mode . typescript-indent-level) ; Typescript - (sh-mode . sh-basic-offset) ; Shell Script - (ruby-mode . ruby-indent-level) ; Ruby - (enh-ruby-mode . enh-ruby-indent-level) ; Ruby - (crystal-mode . crystal-indent-level) ; Crystal (Ruby) - (css-mode . css-indent-offset) ; CSS - (rust-mode . rust-indent-offset) ; Rust - (rustic-mode . rustic-indent-offset) ; Rust - (scala-mode . scala-indent:step) ; Scala - (powershell-mode . powershell-indent) ; PowerShell - (ess-mode . ess-indent-offset) ; ESS (R) - (yaml-mode . yaml-indent-offset) ; YAML - (hack-mode . hack-indent-offset) ; Hack - - (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 (if indent-tabs-mode :json-false t)))) - -(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) - (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 - (let ((start-point (lsp--position-to-point start)) - (end-point (lsp--position-to-point end))) - (when (and (> (1+ start-line) start-window) - (< (1+ end-line) end-window) - (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) - 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 - ((DocumentSymbol :name :children? :selection-range (Range :start)) - (cons (cons (concat path name) - (lsp--position-to-point start)) - (lsp--xref-elements-index children? (concat path name " / ")))) - ((SymbolInformation :name :location (Location :range (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))))) - -(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-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 references? xref-show-xrefs-function xref-show-definitions-function) - (-const xrefs) - `((window . ,(selected-window)) - (display-action . ,display-action)))) - (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 include-declaration &key display-action) - "Find references of the symbol under point." - (interactive "P") - (lsp-find-locations "textDocument/references" - (list :context `(:includeDeclaration ,(lsp-json-bool include-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--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 - (with-lsp-workspace it - (or - (when check-command (funcall check-command it)) - (when capability (lsp--capability capability)) - (lsp--registered-capability method) - (and (not capability) (not check-command)))) - (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) - -(defvar lsp--flushing-delayed-changes nil) - -(defun lsp--send-no-wait (message proc) - "Send MESSAGE to PROC without waiting for further output." - - (unless lsp--flushing-delayed-changes - (let ((lsp--flushing-delayed-changes t)) - (lsp--flush-delayed-changes))) - - (condition-case err - (process-send-string proc message) - ('error (lsp--error "Sending to process failed with the following error: %s" - (error-message-string err))))) - -(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) - ("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--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 - (/ (nth 2 (time-since recv-time)) 1000))))) - ;; 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 (lsp--make-message 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) - (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-string)) - `(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 - (/ (nth 2 (time-since before-send)) 1000)) - 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 (/ (nth 2 (time-since before-send)) 1000)) - 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))))))) - -(defvar lsp-parsed-message nil - "This will store the string representation of the json message. - -In some cases like #1807 we lose information during json -deserialization.") - -(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) - input - (concat leftovers input))) - - (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) - -(defface lsp-details-face '((t :height 0.8 :inherit shadow)) - "Used to display additional information troughout `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 lsp-imenu-detailed-outline))) - (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) - (setq-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-function (command) - "Resolve final function COMMAND." - (-let [command (if (functionp command) (funcall command) command)] - (cl-etypecase command - (list - (cl-assert (seq-every-p (apply-partially #'stringp) command) nil - "Invalid command list") - command) - (string (list command))))) - -(defun lsp-server-present? (final-command) - "Check whether FINAL-COMMAND is present." - ;; executable-find only gained support for remote checks after 27 release - (or (and (cond - ((not (file-remote-p default-directory)) - (executable-find (cl-first final-command))) - ((version<= "27.0" emacs-version) - (with-no-warnings (executable-find (cl-first final-command) (file-remote-p default-directory)))) - (t)) - (prog1 t - (lsp-log "Command \"%s\" is present on the path." (s-join " " final-command)))) - (ignore (lsp-log "Command \"%s\" is not present on the path." (s-join " " final-command))))) - -(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-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) - (let ((final-command (lsp-resolve-final-function command)) - (process-name (generate-new-buffer-name name)) - (process-environment - (lsp--compute-process-environment environment-fn))) - (let* ((stderr-buf (format "*%s::stderr*" process-name)) - (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))) - (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 () (-> command lsp-resolve-final-function lsp-server-present?))))) - -(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--find-available-port (host starting-port) - "Find available port on HOST starting from STARTING-PORT." - (let ((success nil) - (port starting-port)) - (while (and (not success)) - (condition-case _err - (progn - (delete-process (open-network-stream "*connection-test*" nil host port :type 'plain)) - (cl-incf port)) - (file-error (setq success t)))) - 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) - (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 (executable-find (cl-first 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 () (executable-find (cl-first (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) - (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 () (executable-find (cl-first (funcall command-fn 0)))))) - -(defun lsp-tramp-connection (local-command &optional generate-error-file-fn) - "Create LSP stdio connection named name. -LOCAL-COMMAND is either list of strings, string or function which -returns the command to execute." - (list :connect (lambda (filter sentinel name environment-fn) - (let* ((final-command (lsp-resolve-final-function local-command)) - ;; wrap with stty to disable converting \r to \n - (process-name (generate-new-buffer-name name)) - (wrapped-command (s-join - " " - (append '("stty" "raw" ";") - final-command - (list - (concat "2>" - (or (when generate-error-file-fn - (funcall generate-error-file-fn name)) - (format "/tmp/%s-%s-stderr" name - (cl-incf lsp--stderr-index)))))))) - (process-environment - (lsp--compute-process-environment environment-fn))) - (let ((proc (start-file-process-shell-command process-name - (format "*%s*" process-name) - wrapped-command))) - (set-process-sentinel proc sentinel) - (set-process-filter proc filter) - (set-process-query-on-exit-flag proc nil) - (set-process-coding-system proc 'binary 'binary) - (cons proc proc)))) - :test? (lambda () (-> local-command lsp-resolve-final-function lsp-server-present?)))) - -(defun lsp--auto-configure () - "Autoconfigure `company', `flycheck', `lsp-ui', etc if they are installed." - (when (functionp 'lsp-ui-mode) - (lsp-ui-mode)) - - (when lsp-headerline-breadcrumb-enable - (add-hook 'lsp-configure-hook 'lsp-headerline-breadcrumb-mode)) - (when lsp-modeline-code-actions-enable - (add-hook 'lsp-configure-hook 'lsp-modeline-code-actions-mode)) - (when lsp-modeline-diagnostics-enable - (add-hook 'lsp-configure-hook 'lsp-modeline-diagnostics-mode)) - (when lsp-modeline-workspace-status-enable - (add-hook 'lsp-configure-hook 'lsp-modeline-workspace-status-mode)) - (when lsp-lens-enable - (add-hook 'lsp-configure-hook 'lsp-lens--enable)) - (when lsp-semantic-tokens-enable - (add-hook 'lsp-configure-hook 'lsp-semantic-tokens--enable)) - - ;; yas-snippet config - (setq-local yas-inhibit-overlay-modification-protection t)) - -(defvar-local lsp--buffer-deferred nil - "Whether buffer was loaded via `lsp-deferred'.") - -(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 with status %s(check corresponding stderr buffer for details). Do you want to restart it?" - (lsp--workspace-print workspace) - (process-status (lsp--workspace-proc 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) - (let* ((status (process-status process)) - (folder->workspaces (lsp-session-folder->servers (lsp-session))) - (stderr (-> workspace lsp--workspace-proc process-name get-buffer))) - - (lsp--warn "%s has exited (%s)" - (process-name (lsp--workspace-proc workspace)) - (string-trim-right 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))) - - ;; Kill standard error buffer only if the process exited normally. - ;; Leave it intact otherwise for debugging purposes. - (when (and (eq status 'exit) (zerop (process-exit-status process)) (buffer-live-p stderr)) - (kill-buffer stderr))) - - (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-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 nil - :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 (response) - (unless response - (lsp--spinner-stop) - (signal 'lsp-empty-response-error (list "initialize"))) - - (let* ((capabilities (lsp:initialize-result-capabilities response)) - (json-object-type 'hash-table) - (text-document-sync (-some-> lsp-parsed-message - (json-read-from-string) - (ht-get "result") - (ht-get "capabilities") - (ht-get "textDocumentSync"))) - (save (when (ht? text-document-sync) - (ht-get text-document-sync "save")))) - ;; see #1807 - (when (and (ht? save) (ht-empty? save)) - (-> capabilities - (lsp:server-capabilities-text-document-sync?) - (lsp:set-text-document-sync-options-save? save))) - - (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've 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-update-server (&optional server-id) - "Interactively update 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-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 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 symbol - return it's value -Otherwise returns value itself." - (cond - ((functionp value) (funcall value)) - ((symbolp value) (symbol-value value)) - (value))) - -(defvar lsp-deps-providers - (list :npm (list :path #'lsp--npm-dependency-path - :install #'lsp--npm-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))) - (if (and (f-absolute? path) - (f-exists? path)) - path - (executable-find 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)))) - (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 callback - 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)) - - -;; 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")) - (`nil store-path) - (_ (error ":decompress must be `:gzip', `:zip' 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)))) - (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 -archieve(e. g. when the archieve 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)))) - -;; unzip - -(defconst lsp-ext-pwsh-script "powershell -noprofile -noninteractive \ --nologo -ex bypass 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 (cond ((executable-find "powershell") lsp-ext-pwsh-script) - ((executable-find "unzip") lsp-ext-unzip-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-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 (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-gunzip-script gz-file))) - -;; VSCode marketplace - -(defcustom lsp-vscode-ext-url - "https://marketplace.visualstudio.com/_apis/public/gallery/publishers/%s/vsextensions/%s/%s/vspackage" - "Vscode extension template url." - :group 'lsp-mode - :type 'string - :package-version '(lsp-mode . "8.0.0")) - -(defun lsp-vscode-extension-url (publisher name &optional version) - "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, defaults to `latest'" - (format lsp-vscode-ext-url publisher name (or version "latest"))) - - - -;; 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 BUFFER-MAJOR-MODE. -SESSION is the currently active session. The function will also -pick only remote enabled clients in case the FILE-NAME is on -remote machine and vice versa." - (-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-register-client (client) - "Registers LSP client CLIENT." - (cl-assert (symbolp (lsp--client-server-id client)) t) - (cl-assert (or - (functionp (lsp--client-activation-fn client)) - (and (listp (lsp--client-major-modes client)) - (seq-every-p (apply-partially #'symbolp) - (lsp--client-major-modes client)))) - nil "Invalid activation-fn and/or major-modes.") - (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)))) - -(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 nil - "For internal use, any external users please use - `lsp-register-custom-settings' function instead") - -(defun lsp--compare-setting-path (a b) - (equal (car a) (car b))) - -(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)" - (let ((-compare-fn #'lsp--compare-setting-path)) - (setq lsp-client-settings (-uniq (append props lsp-client-settings))))) - -(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 - -(defmacro defcustom-lsp (symbol standard doc &rest args) - "Defines `lsp-mode' server property." - (let ((path (plist-get args :lsp-path))) - (cl-remf args :lsp-path) - `(progn - (lsp-register-custom-settings - (quote ((,path ,symbol ,(equal ''boolean (plist-get args :type)))))) - - (defcustom ,symbol ,standard ,doc - :set (lambda (sym val) - (lsp--set-custom-property sym val ,path)) - ,@args)))) - -(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))) - (mapc (-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 (format "%s" (process-id (lsp--workspace-cmd-proc workspace))))) - (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))) - -(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 (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 M." - (when (hash-table-p m) - (let (nodes) - (maphash (lambda (k v) - (push `(tree-widget - :tag ,(if (hash-table-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*"))) - (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))) - -(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--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 (read-key (format - "%s is not part of any project. Select action: - -%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-blacklist. -%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." - (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))))) - (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-blacklist session)) - (lsp--persist-session session) - nil) - (?D (push (read-directory-name "Select folder to blacklist: " - (or project-root-suggestion default-directory) - nil - t) - (lsp-session-folders-blacklist 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-blacklist) - (--first (and (lsp--files-same-host it file-name) - (lsp-f-ancestor-of? it file-name) - (prog1 t - (lsp--info "File %s is in blacklisted directory %s" file-name it)))) - not) - (or - (when lsp-auto-guess-root - (lsp--suggest-project-root)) - (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-blacklist (lsp-session-folders-blacklist 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 blacklisted." (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]" (lsp--workspace-print 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))) - ;; 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')." - 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 (+ (point-at-bol) indentation)) - (point-at-bol) - 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-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) (point-at-eol)) - (point-at-eol) - (+ (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?"))) - - - -;;;###autoload -(defun lsp-start-plain () - "Start `lsp-mode' using mininal 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) - (async-shell-command - (format "%s -q -l %s %s" - (expand-file-name invocation-name invocation-directory) - start-plain - (or (buffer-file-name) "")) - (generate-new-buffer " *lsp-start-plain*")))) - - - -(provide 'lsp-mode) -;;; lsp-mode.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-modeline.el b/elpa/lsp-mode-20220201.852/lsp-modeline.el deleted file mode 100644 index 9449f5c8..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-modeline.el +++ /dev/null @@ -1,354 +0,0 @@ -;;; lsp-modeline.el --- LSP modeline 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 . -;; -;;; Commentary: -;; -;; LSP modeline -;; -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-modeline nil - "LSP support for modeline" - :prefix "lsp-modeline-" - :group 'lsp-mode - :tag "LSP Modeline") - -(defcustom lsp-modeline-code-actions-kind-regex "$\\|quickfix.*\\|refactor.*" - "Regex for the code actions kinds to show in the modeline." - :type 'string - :group 'lsp-modeline) - -(defcustom lsp-modeline-code-actions-segments '(count icon) - "Define what should display on the modeline when code actions are available." - :type '(repeat (choice - (const :tag "Show the lightbulb icon" icon) - (const :tag "Show the name of the preferred code action" name) - (const :tag "Show the count of how many code actions available" count))) - :group 'lsp-modeline - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-modeline-code-action-fallback-icon "💡" - "Define what should display on the modeline when code actions are available." - :type 'string - :group 'lsp-modeline - :package-version '(lsp-mode . "8.0.0")) - -(defface lsp-modeline-code-actions-face - '((t :inherit homoglyph)) - "Face used to code action text on modeline." - :group 'lsp-modeline) - -(defface lsp-modeline-code-actions-preferred-face - '((t :foreground "yellow")) - "Face used to code action text on modeline." - :group 'lsp-modeline) - -;;;###autoload -(define-obsolete-variable-alias 'lsp-diagnostics-modeline-scope - 'lsp-modeline-diagnostics-scope "lsp-mode 7.0.1") - -(defcustom lsp-modeline-diagnostics-scope :workspace - "The modeline diagnostics scope." - :group 'lsp-modeline - :type '(choice (const :tag "File" :file) - (const :tag "Project" :workspace) - (const :tag "All Projects" :global)) - :package-version '(lsp-mode . "6.3")) - -(declare-function all-the-icons-octicon "ext:all-the-icons" t t) -(declare-function lsp-treemacs-errors-list "ext:lsp-treemacs" t) - - -;; code actions - -(defvar-local lsp-modeline--code-actions-string nil - "Holds the current code action string on modeline.") - -(defun lsp-modeline--code-action-face (preferred-code-action) - "Return the face checking if there is any PREFERRED-CODE-ACTION." - (if preferred-code-action - 'lsp-modeline-code-actions-preferred-face - 'lsp-modeline-code-actions-face)) - -(defun lsp-modeline--code-actions-icon (face) - "Build the icon for modeline code actions using FACE." - (if (require 'all-the-icons nil t) - (all-the-icons-octicon "light-bulb" - :face face - :v-adjust -0.0575) - (propertize lsp-modeline-code-action-fallback-icon 'face face))) - -(defun lsp-modeline--code-action-name (actions preferred-code-action-title) - "Return the code action name from ACTIONS and PREFERRED-CODE-ACTION-TITLE." - (or preferred-code-action-title - (->> actions - lsp-seq-first - lsp-modeline--code-action->string))) - -(defun lsp-modeline--code-action->string (action) - "Convert code ACTION to friendly string." - (->> action - lsp:code-action-title - (replace-regexp-in-string "[\n\t ]+" " "))) - -(defun lsp-modeline--build-code-actions-segments (actions) - "Build the code ACTIONS string from the defined segments." - (let* ((preferred-code-action (-some->> actions - (-first #'lsp:code-action-is-preferred?) - lsp-modeline--code-action->string)) - (face (lsp-modeline--code-action-face preferred-code-action))) - (mapconcat - (lambda (segment) - (pcase segment - ('icon (lsp-modeline--code-actions-icon face)) - ('name (propertize (lsp-modeline--code-action-name actions preferred-code-action) - 'face face)) - ('count (propertize (number-to-string (seq-length actions)) - 'face face)))) - lsp-modeline-code-actions-segments " "))) - -(defun lsp-modeline--build-code-actions-string (actions) - "Build the string to be presented on modeline for code ACTIONS." - (-let* ((single-action? (= (length actions) 1)) - (keybinding (concat "(" - (-some->> #'lsp-execute-code-action - where-is-internal - (-find (lambda (o) - (not (member (aref o 0) '(menu-bar normal-state))))) - key-description) - ")")) - (built-string (lsp-modeline--build-code-actions-segments actions)) - (preferred-code-action (-some->> actions - (-first #'lsp:code-action-is-preferred?) - lsp-modeline--code-action->string))) - (add-text-properties 0 (length built-string) - (list 'help-echo - (concat (format "Apply code actions %s\nmouse-1: " keybinding) - (if single-action? - (lsp-modeline--code-action-name actions preferred-code-action) - "select from multiple code actions")) - 'mouse-face 'mode-line-highlight - 'local-map (make-mode-line-mouse-map - 'mouse-1 (lambda () - (interactive) - (if single-action? - (lsp-execute-code-action (lsp-seq-first actions)) - (lsp-execute-code-action (lsp--select-action actions)))))) - built-string) - (unless (string= "" built-string) - (concat built-string " ")))) - -(defun lsp--modeline-update-code-actions (actions) - "Update modeline with new code ACTIONS." - (when lsp-modeline-code-actions-kind-regex - (setq actions (seq-filter (-lambda ((&CodeAction :kind?)) - (or (not kind?) - (s-match lsp-modeline-code-actions-kind-regex kind?))) - actions))) - (setq lsp-modeline--code-actions-string - (if (seq-empty-p actions) "" - (lsp-modeline--build-code-actions-string actions))) - (force-mode-line-update)) - -(defun lsp-modeline--check-code-actions (&rest _) - "Request code actions to update modeline for given BUFFER." - (when (lsp-feature? "textDocument/codeAction") - (lsp-request-async - "textDocument/codeAction" - (lsp--text-document-code-action-params) - #'lsp--modeline-update-code-actions - :mode 'unchanged - :cancel-token :lsp-modeline-code-actions))) - -(defun lsp-modeline--enable-code-actions () - "Enable code actions on modeline mode." - (when (and lsp-modeline-code-actions-enable - (lsp-feature? "textDocument/codeAction")) - (lsp-modeline-code-actions-mode 1))) - -(defun lsp-modeline--disable-code-actions () - "Disable code actions on modeline mode." - (lsp-modeline-code-actions-mode -1)) - -;;;###autoload -(define-minor-mode lsp-modeline-code-actions-mode - "Toggle code actions on modeline." - :group 'lsp-modeline - :global nil - :lighter "" - (cond - (lsp-modeline-code-actions-mode - (add-to-list 'global-mode-string '(t (:eval lsp-modeline--code-actions-string))) - - (add-hook 'lsp-on-idle-hook 'lsp-modeline--check-code-actions nil t) - (add-hook 'lsp-configure-hook #'lsp-modeline--enable-code-actions nil t) - (add-hook 'lsp-unconfigure-hook #'lsp-modeline--disable-code-actions nil t)) - (t - (remove-hook 'lsp-on-idle-hook 'lsp-modeline--check-code-actions t) - (remove-hook 'lsp-configure-hook #'lsp-modeline--enable-code-actions t) - (remove-hook 'lsp-unconfigure-hook #'lsp-modeline--disable-code-actions t) - (setq global-mode-string (remove '(t (:eval lsp-modeline--code-actions-string)) global-mode-string))))) - - -;; diagnostics - -(defvar-local lsp-modeline--diagnostics-string nil - "Value of current buffer diagnostics statistics.") - -(defvar lsp-modeline--diagnostics-wks->strings nil - "Plist of workspaces to their modeline strings. -The `:global' workspace is global one.") - -(defun lsp-modeline-diagnostics-statistics () - "Calculate diagnostics statistics based on `lsp-modeline-diagnostics-scope'." - (let ((diagnostics (cond - ((equal :file lsp-modeline-diagnostics-scope) - (list (lsp--get-buffer-diagnostics))) - (t (->> (eq :workspace lsp-modeline-diagnostics-scope) - (lsp-diagnostics) - (ht-values))))) - (stats (make-vector lsp/diagnostic-severity-max 0)) - strs - (i 0)) - (mapc (lambda (buf-diags) - (mapc (lambda (diag) - (-let [(&Diagnostic? :severity?) diag] - (when severity? - (cl-incf (aref stats severity?))))) - buf-diags)) - diagnostics) - (while (< i lsp/diagnostic-severity-max) - (when (> (aref stats i) 0) - (setq strs - (nconc strs - `(,(propertize - (format "%s" (aref stats i)) - 'face - (cond - ((= i lsp/diagnostic-severity-error) 'error) - ((= i lsp/diagnostic-severity-warning) 'warning) - ((= i lsp/diagnostic-severity-information) 'success) - ((= i lsp/diagnostic-severity-hint) 'success))))))) - (cl-incf i)) - (-> (s-join "/" strs) - (propertize 'mouse-face 'mode-line-highlight - 'help-echo "mouse-1: Show diagnostics" - 'local-map (when (require 'lsp-treemacs nil t) - (make-mode-line-mouse-map - 'mouse-1 #'lsp-treemacs-errors-list)))))) - -(defun lsp-modeline--diagnostics-reset-modeline-cache () - "Reset the modeline diagnostics cache." - (plist-put lsp-modeline--diagnostics-wks->strings (car (lsp-workspaces)) nil) - (plist-put lsp-modeline--diagnostics-wks->strings :global nil) - (setq lsp-modeline--diagnostics-string nil)) - -(defun lsp-modeline--diagnostics-update-modeline () - "Update diagnostics modeline string." - (cl-labels ((calc-modeline () - (let ((str (lsp-modeline-diagnostics-statistics))) - (if (string-empty-p str) "" - (concat str " "))))) - (setq lsp-modeline--diagnostics-string - (cl-case lsp-modeline-diagnostics-scope - (:file (or lsp-modeline--diagnostics-string - (calc-modeline))) - (:workspace - (let ((wk (car (lsp-workspaces)))) - (or (plist-get lsp-modeline--diagnostics-wks->strings wk) - (let ((ml (calc-modeline))) - (setq lsp-modeline--diagnostics-wks->strings - (plist-put lsp-modeline--diagnostics-wks->strings wk ml)) - ml)))) - (:global - (or (plist-get lsp-modeline--diagnostics-wks->strings :global) - (let ((ml (calc-modeline))) - (setq lsp-modeline--diagnostics-wks->strings - (plist-put lsp-modeline--diagnostics-wks->strings :global ml)) - ml))))))) - -(defun lsp-modeline--enable-diagnostics () - "Enable diagnostics on modeline mode." - (when (and lsp-modeline-diagnostics-enable - (lsp-feature? "textDocument/publishDiagnostics")) - (lsp-modeline-diagnostics-mode 1))) - -(defun lsp-modeline--disable-diagnostics () - "Disable diagnostics on modeline mode." - (lsp-modeline-diagnostics-mode -1)) - -;;;###autoload -(define-obsolete-function-alias 'lsp-diagnostics-modeline-mode - 'lsp-modeline-diagnostics-mode "lsp-mode 7.0.1") - -;;;###autoload -(define-minor-mode lsp-modeline-diagnostics-mode - "Toggle diagnostics modeline." - :group 'lsp-modeline - :global nil - :lighter "" - (cond - (lsp-modeline-diagnostics-mode - (add-hook 'lsp-configure-hook #'lsp-modeline--enable-diagnostics nil t) - (add-hook 'lsp-unconfigure-hook #'lsp-modeline--disable-diagnostics nil t) - (add-to-list 'global-mode-string '(t (:eval (lsp-modeline--diagnostics-update-modeline)))) - (add-hook 'lsp-diagnostics-updated-hook 'lsp-modeline--diagnostics-reset-modeline-cache)) - (t - (remove-hook 'lsp-configure-hook #'lsp-modeline--enable-diagnostics t) - (remove-hook 'lsp-unconfigure-hook #'lsp-modeline--disable-diagnostics t) - (remove-hook 'lsp-diagnostics-updated-hook 'lsp-modeline--diagnostics-reset-modeline-cache) - (setq global-mode-string (remove '(t (:eval (lsp-modeline--diagnostics-update-modeline))) global-mode-string))))) - - -;; workspace status - -(defun lsp-modeline--workspace-status-string () - "Build the workspace status string." - '(t (:eval (-keep #'lsp--workspace-status-string (lsp-workspaces))))) - -(defun lsp-modeline--enable-workspace-status () - "Enable workspace status on modeline." - (let ((status (lsp-modeline--workspace-status-string))) - (setq-local global-mode-string (if (-contains? global-mode-string status) - global-mode-string - (cons status global-mode-string))))) - -(defun lsp-modeline--disable-workspace-status () - "Disable workspace status on modeline." - (let ((status (lsp-modeline--workspace-status-string))) - (setq-local global-mode-string (remove status global-mode-string)))) - -;;;###autoload -(define-minor-mode lsp-modeline-workspace-status-mode - "Toggle workspace status on modeline." - :group 'lsp-modeline - :global nil - :lighter "" - (cond - (lsp-modeline-workspace-status-mode - (add-hook 'lsp-configure-hook #'lsp-modeline--enable-workspace-status nil t) - (add-hook 'lsp-unconfigure-hook #'lsp-modeline--disable-workspace-status nil t)) - (t - (remove-hook 'lsp-configure-hook #'lsp-modeline--enable-workspace-status t) - (remove-hook 'lsp-unconfigure-hook #'lsp-modeline--disable-workspace-status t)))) - -(lsp-consistency-check lsp-modeline) - -(provide 'lsp-modeline) -;;; lsp-modeline.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-nginx.el b/elpa/lsp-mode-20220201.852/lsp-nginx.el deleted file mode 100644 index b2e184be..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-nginx.el +++ /dev/null @@ -1,53 +0,0 @@ -;;; lsp-nginx.el --- Nginx Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 Shen, Jen-Chieh - -;; Author: Jen-Chieh Shen -;; Keywords: nginx 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 . - -;;; Commentary: -;; -;; LSP client for Nginx -;; - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-nginx nil - "LSP support for Nginx." - :group 'lsp-mode - :link '(url-link "https://github.com/pappasam/nginx-language-server") - :package-version `(lsp-mode . "8.0.1")) - -(defcustom lsp-nginx-server-command '("nginx-language-server") - "Command to start Nginx Language Server." - :risky t - :group 'lsp-nginx - :type '(repeat string) - :package-version `(lsp-mode . "8.0.1")) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection - (lambda () lsp-nginx-server-command)) - :major-modes '(nginx-mode) - :priority -1 - :server-id 'nginx-ls)) - -(lsp-consistency-check lsp-nginx) - -(provide 'lsp-nginx) -;;; lsp-nginx.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-nim.el b/elpa/lsp-mode-20220201.852/lsp-nim.el deleted file mode 100644 index 5418137f..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-nim.el +++ /dev/null @@ -1,45 +0,0 @@ -;;; lsp-nim.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, nim - -;; 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 . - -;;; Commentary: - -;; LSP Clients for the Nim Programming Language. - -;;; Code: - -(require 'lsp-mode) - -;; Nim -(defgroup lsp-nimlsp nil - "LSP support for Nim, using nimlsp." - :group 'lsp-mode - :link '(url-link "https://github.com/PMunch/nimlsp")) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection "nimlsp") - :major-modes '(nim-mode) - :priority -1 - :server-id 'nimls)) - - -(lsp-consistency-check lsp-nim) - -(provide 'lsp-nim) -;;; lsp-nim.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-nix.el b/elpa/lsp-mode-20220201.852/lsp-nix.el deleted file mode 100644 index d19151c0..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-nix.el +++ /dev/null @@ -1,48 +0,0 @@ -;;; lsp-nix.el --- lsp-mode nix integration -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 lsp-mode maintainers - -;; Author: Seong Yong-ju -;; 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 . - -;;; Commentary: - -;; Client for the rnix language server. - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-nix nil - "LSP support for Nix, using rnix-lsp." - :group 'lsp-mode - :link '(url-link "https://github.com/nix-community/rnix-lsp")) - -(defcustom lsp-nix-server-path "rnix-lsp" - "Executable path for the server." - :group 'lsp-nix - :type 'string - :package-version '(lsp-mode . "8.0.0")) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection (lambda () lsp-nix-server-path)) - :major-modes '(nix-mode) - :server-id 'rnix-lsp)) - -(lsp-consistency-check lsp-nix) - -(provide 'lsp-nix) -;;; lsp-nix.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-ocaml.el b/elpa/lsp-mode-20220201.852/lsp-ocaml.el deleted file mode 100644 index b1e10035..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-ocaml.el +++ /dev/null @@ -1,84 +0,0 @@ -;;; lsp-ocaml.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, ocaml - -;; 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 . - -;;; Commentary: - -;; LSP Clients for the Ocaml Programming Language. - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-ocaml nil - "LSP support for OCaml, using ocaml-language-server." - :group 'lsp-mode - :link '(url-link "https://github.com/freebroccolo/ocaml-language-server")) - -(define-obsolete-variable-alias - 'lsp-ocaml-ocaml-lang-server-command - 'lsp-ocaml-lang-server-command - "lsp-mode 6.1") - -(defcustom lsp-ocaml-lang-server-command - '("ocaml-language-server" "--stdio") - "Command to start ocaml-language-server." - :group 'lsp-ocaml - :type '(choice - (string :tag "Single string value") - (repeat :tag "List of string values" - string))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection - (lambda () lsp-ocaml-lang-server-command)) - :major-modes '(reason-mode caml-mode tuareg-mode) - :priority -1 - :server-id 'ocaml-ls)) - -(defgroup lsp-ocaml-lsp-server nil - "LSP support for OCaml, using ocaml-lsp-server." - :group 'lsp-mode - :link '(url-link "https://github.com/ocaml/ocaml-lsp")) - -(define-obsolete-variable-alias 'lsp-merlin 'lsp-ocaml-lsp-server "lsp-mode 6.1") -(define-obsolete-variable-alias 'lsp-merlin-command 'lsp-ocaml-lsp-server-command "lsp-mode 6.1") - -(defcustom lsp-ocaml-lsp-server-command - '("ocamllsp") - "Command to start ocaml-language-server." - :group 'lsp-ocaml - :type '(choice - (string :tag "Single string value") - (repeat :tag "List of string values" - string))) - -(lsp-register-client - (make-lsp-client - :new-connection - (lsp-stdio-connection (lambda () lsp-ocaml-lsp-server-command)) - :major-modes '(reason-mode caml-mode tuareg-mode) - :priority 0 - :server-id 'ocaml-lsp-server)) - - -(lsp-consistency-check lsp-ocaml) - -(provide 'lsp-ocaml) -;;; lsp-ocaml.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-perl.el b/elpa/lsp-mode-20220201.852/lsp-perl.el deleted file mode 100644 index 4126e0df..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-perl.el +++ /dev/null @@ -1,117 +0,0 @@ -;;; lsp-perl.el --- lsp-perl config -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 lsp-mode developers - -;; Author: Hiroki Noda -;; 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 . - -;;; Commentary: - -;; lsp-perl client - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-perl nil - "LSP support for Perl" - :group 'lsp-mode - :link '(url-link "https://github.com/richterger/Perl-LanguageServer") - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-perl-language-server-path "perl" - "Path to perl interpreter." - :type 'string - :group 'lsp-perl - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-perl-language-server-port 13603 - "Choose listen port." - :type 'integer - :group 'lsp-perl - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-perl-language-server-client-version "2.1.0" - "Choose client version." - :type 'string - :group 'lsp-perl - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-perl-perl-cmd nil - "Path to perl interpreter used in Perl Language Server. -Defaults to `perl' if nil." - :type 'string - :group 'lsp-perl - :package-version '(lsp-mode . "7.0.1")) -(defcustom lsp-perl-perl-inc nil - "A vector of paths to add to perl library path." - :type 'lsp-string-vector - :group 'lsp-perl - :package-version '(lsp-mode . "7.0.1")) -(defcustom lsp-perl-file-filter nil - "A vector of directories filtering perl file. -Defaults to `[\".pm\" \".pl\"]' if nil." - :type 'lsp-string-vector - :group 'lsp-perl - :package-version '(lsp-mode . "7.0.1")) -(defcustom lsp-perl-ignore-dirs nil - "A vector of directories to ignore. -Defaults to `[\".vscode\" \".git\" \".svn\"]' if nil." - :type 'lsp-string-vector - :group 'lsp-perl - :package-version '(lsp-mode . "7.0.1")) - -(defcustom lsp-perl-show-local-vars nil - "If true, show also local variables in symbol view. -Defaults to false if nil" - :type 'boolean - :group 'lsp-perl - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-perl-log-level nil - "Log level 0-2. -Defaults to 0." - :type 'integer - :group 'lsp-perl - :package-version '(lsp-mode . "8.0.0")) - -(lsp-register-custom-settings - '(("perl.perlCmd" lsp-perl-perl-cmd) - ("perl.perlInc" lsp-perl-perl-inc) - ("perl.fileFilter" lsp-perl-file-filter) - ("perl.ignoreDirs" lsp-perl-ignore-dirs) - ("perl.showLocalVars" lsp-perl-show-local-vars t) - ("perl.logLevel" lsp-perl-log-level))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection - (lambda () - (list lsp-perl-language-server-path - "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run" "--" - (format "--port %d --version %s" - lsp-perl-language-server-port lsp-perl-language-server-client-version)))) - :major-modes '(perl-mode cperl-mode) - :initialized-fn (lambda (workspace) - (with-lsp-workspace workspace - (lsp--set-configuration - (lsp-configuration-section "perl")))) - :priority -1 - :server-id 'perl-language-server)) - -(lsp-consistency-check lsp-perl) - -(provide 'lsp-perl) -;;; lsp-perl.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-php.el b/elpa/lsp-mode-20220201.852/lsp-php.el deleted file mode 100644 index fd8bc21f..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-php.el +++ /dev/null @@ -1,450 +0,0 @@ -;;; lsp-php.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, php - -;; 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 . - -;;; Commentary: - -;; LSP Clients for the PHP Programming Language. - -;;; Code: - -(require 'lsp-mode) -(require 'lsp-protocol) - -;; PHP Language Server -(defgroup lsp-php nil - "LSP support for PHP, using php-language-server." - :link '(url-link "https://github.com/felixfbecker/php-language-server") - :group 'lsp-mode) - -(defun lsp-php-get-composer-dir () - "Get composer home directory if possible." - (if (executable-find "composer") - (replace-regexp-in-string "\n$" "" (shell-command-to-string "composer config --global home")) - "~/.composer")) - -(defcustom lsp-php-composer-dir nil - "Home directory of composer." - :group 'lsp-php - :type 'string) - -(defcustom lsp-clients-php-server-command nil - "Install directory for php-language-server." - :group 'lsp-php - :type '(repeat string)) - -(defun lsp-php--create-connection () - "Create lsp connection." - (lsp-stdio-connection - (lambda () - (unless lsp-php-composer-dir - (setq lsp-php-composer-dir (lsp-php-get-composer-dir))) - (unless lsp-clients-php-server-command - (setq lsp-clients-php-server-command - `("php", - (expand-file-name - (f-join lsp-php-composer-dir "vendor/felixfbecker/language-server/bin/php-language-server.php"))))) - lsp-clients-php-server-command) - (lambda () - (if (and (cdr lsp-clients-php-server-command) - (eq (string-match-p "php[0-9.]*\\'" (car lsp-clients-php-server-command)) 0)) - ;; Start with the php command and the list has more elems. Test the existence of the PHP script. - (let ((php-file (nth 1 lsp-clients-php-server-command))) - (or (file-exists-p php-file) - (progn - (lsp-log "%s is not present." php-file) - nil))) - t)))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-php--create-connection) - :activation-fn (lsp-activate-on "php") - :priority -3 - :server-id 'php-ls)) - -;;; Intelephense -(defgroup lsp-intelephense nil - "LSP support for PHP, using Intelephense." - :group 'lsp-mode - :link '(url-link "https://github.com/bmewburn/vscode-intelephense") - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-intelephense-php-version "8.0.1" - "Minimum version of PHP to refer to. Affects code actions, diagnostic & -completions." - :type 'string - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-intelephense-files-max-size 1000000 - "Maximum file size in bytes." - :type 'number - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-intelephense-files-associations - ["*.php" "*.phtml"] - "Configure glob patterns to make files available for language -server features." - :type '(repeat string) - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-intelephense-files-exclude - ["**/.git/**" "**/.svn/**" "**/.hg/**" "**/CVS/**" "**/.DS_Store/**" - "**/node_modules/**" "**/bower_components/**" "**/vendor/**/{Test,test,Tests,tests}/**"] - "Configure glob patterns to exclude certain files and folders -from all language server features." - :type '(repeat string) - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-intelephense-stubs - ["apache" "bcmath" "bz2" "calendar" - "com_dotnet" "Core" "ctype" "curl" "date" "dba" "dom" "enchant" - "exif" "fileinfo" "filter" "fpm" "ftp" "gd" "hash" "iconv" "imap" "interbase" - "intl" "json" "ldap" "libxml" "mbstring" "mcrypt" "meta" "mssql" "mysqli" - "oci8" "odbc" "openssl" "pcntl" "pcre" "PDO" "pdo_ibm" "pdo_mysql" - "pdo_pgsql" "pdo_sqlite" "pgsql" "Phar" "posix" "pspell" "readline" "recode" - "Reflection" "regex" "session" "shmop" "SimpleXML" "snmp" "soap" "sockets" - "sodium" "SPL" "sqlite3" "standard" "superglobals" "sybase" "sysvmsg" - "sysvsem" "sysvshm" "tidy" "tokenizer" "wddx" "xml" "xmlreader" "xmlrpc" - "xmlwriter" "Zend OPcache" "zip" "zlib"] - "Configure stub files for built in symbols and common -extensions. The default setting includes PHP core and all -bundled extensions." - :type '(repeat string) - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-intelephense-completion-insert-use-declaration t - "Use declarations will be automatically inserted for namespaced -classes, traits, interfaces, functions, and constants." - :type 'boolean - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-intelephense-completion-fully-qualify-global-constants-and-functions nil - "Global namespace constants and functions will be fully -qualified (prefixed with a backslash)." - :type 'boolean - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-intelephense-completion-trigger-parameter-hints t - "Method and function completions will include parentheses and -trigger parameter hints." - :type 'boolean - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-intelephense-completion-max-items 100 - "The maximum number of completion items returned per request." - :type 'number - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-intelephense-format-enable t - "Enables formatting." - :type 'boolean - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-intelephense-licence-key nil - "Enter your intelephense licence key here to access premium -features." - :type 'string - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-intelephense-telemetry-enabled nil - "Anonymous usage and crash data will be sent to Azure -Application Insights." - :type 'boolean - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-intelephense-rename-exclude - ["**/vendor/**"] - "Glob patterns to exclude files and folders from having symbols -renamed. Rename operation will fail if references and/or -definitions are found in excluded files/folders." - :type '(repeat string) - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-intelephense-trace-server "off" - "Traces the communication between VSCode and the intelephense -language server." - :type '(choice (:tag "off" "messages" "verbose")) - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-intelephense-storage-path - (expand-file-name (locate-user-emacs-file "lsp-cache")) - "Optional absolute path to storage dir." - :type 'directory - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-intelephense-global-storage-path - (expand-file-name (locate-user-emacs-file "intelephense")) - "Optional absolute path to global storage dir." - :type 'directory - :group 'lsp-intelephense - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-intelephense-clear-cache nil - "Optional flag to clear server state." - :type 'boolean - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-intelephense-multi-root t - "Flag to control if the server supports multi-root projects." - :type 'boolean - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.3")) - -(lsp-register-custom-settings - '(("intelephense.environment.phpVersion" lsp-intelephense-php-version) - ("intelephense.trace.server" lsp-intelephense-trace-server) - ("intelephense.rename.exclude" lsp-intelephense-rename-exclude) - ("intelephense.telemetry.enabled" lsp-intelephense-telemetry-enabled t) - ("intelephense.format.enable" lsp-intelephense-format-enable t) - ("intelephense.completion.maxItems" lsp-intelephense-completion-max-items) - ("intelephense.completion.triggerParameterHints" lsp-intelephense-completion-trigger-parameter-hints t) - ("intelephense.completion.fullyQualifyGlobalConstantsAndFunctions" lsp-intelephense-completion-fully-qualify-global-constants-and-functions t) - ("intelephense.completion.insertUseDeclaration" lsp-intelephense-completion-insert-use-declaration t) - ("intelephense.stubs" lsp-intelephense-stubs) - ("intelephense.files.exclude" lsp-intelephense-files-exclude) - ("intelephense.files.associations" lsp-intelephense-files-associations) - ("intelephense.files.maxSize" lsp-intelephense-files-max-size))) - -(define-obsolete-variable-alias - 'lsp-clients-php-iph-server-command - 'lsp-intelephense-server-command - "lsp-mode 6.1") - -(defcustom lsp-intelephense-server-command - `("intelephense" "--stdio") - "Command to start Intelephense." - :type '(repeat string) - :group 'lsp-intelephense - :package-version '(lsp-mode . "6.1")) - -(lsp-dependency 'intelephense - '(:system "intelephense") - '(:npm :package "intelephense" - :path "intelephense")) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection - (lambda () - `(,(or (executable-find - (cl-first lsp-intelephense-server-command)) - (lsp-package-path 'intelephense)) - ,@(cl-rest lsp-intelephense-server-command)))) - :activation-fn (lsp-activate-on "php") - :priority -1 - :notification-handlers (ht ("indexingStarted" #'ignore) - ("indexingEnded" #'ignore)) - :initialization-options (lambda () - (list :storagePath lsp-intelephense-storage-path - :globalStoragePath lsp-intelephense-global-storage-path - :licenceKey lsp-intelephense-licence-key - :clearCache lsp-intelephense-clear-cache)) - :multi-root lsp-intelephense-multi-root - :completion-in-comments? t - :server-id 'iph - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'intelephense - callback error-callback)))) - - -;;; Serenata -(defgroup lsp-serenata nil - "LSP support for the PHP programming language, using serenata." - :group 'lsp-mode - :link '(url-link "https://gitlab.com/Serenata/Serenata") - :package-version '(lsp-mode . "7.0")) - -(defcustom lsp-serenata-server-path - "serenata.phar" - "Path to the Serenata Language Server phar file. -It can be downloaded from https://gitlab.com/Serenata/Serenata/-/releases." - :group 'lsp-serenata - :type 'file) - -(defcustom lsp-serenata-uris - [] - "A list of folders to index for your project. -This does not have to include the root of the project itself, in -case you have need of an exotic configuration where the root of -the project is at some location but your actual PHP code is -somewhere else. Note that if you are running Serenata in a -container, you will have to ensure that these URI's are mapped -inside it. Avoid using file paths containing spaces. This is -currently broken due to apparent PHP quirks. By default, the -value is taken from the lsp workspace location." - :group 'lsp-serenata - :type 'lsp-string-vector) - -(defcustom lsp-serenata-php-version - 7.3 - "Allows you to specify the PHP version your project is written in. -At the moment this directive is still ignored, but it will -influence functionality such as refactoring in the future, where -older PHP versions may not support scalar type hints, which may -then be omitted from places such as getters and setters." - :group 'lsp-serenata - :type 'number) - -(defcustom lsp-serenata-file-extensions - ["php"] - "List of file extensions (without dot) to process. -Files that do not match this whitelist will be ignored during -indexing. Usually you'll want to set this to at least include -php, as it is the most common PHP extension. phpt is not -included by default as it is often used to contain test code that -is not directly part of the code. Note that for existing -projects, removing extensions will not not automatically prune -files having them from the index if they are already present. -Adding new ones will cause the files having them to be picked up -on the next project initialization." - :group 'lsp-serenata - :type 'lsp-string-vector) - -(defcustom lsp-serenata-index-database-uri (lsp--path-to-uri (f-join user-emacs-directory "index.sqlite")) - "The location to store the index database. -Note that, as the index database uses SQLite and WAL mode, -additional files (usually two) may be generated and used in the -same folder. Note also that Serenata relies on the Doctrine DBAL -library as well as the SQLite backends in PHP, which may not -support non-file URI's, which may prevent you from using these." - :group 'lsp-serenata - :type 'file) - -(defcustom lsp-serenata-exclude-path-expressions ["/.+Test.php$/"] - "One or more expressions of paths to ignore. -This uses Symfony's Finder in the background, so this means you -can configure anything here that can also be passed to the name -function, which includes plain strings, globs, as well as regular -expressions. Note that for existing projects, modifying these -will not not automatically prune them from the index if they are -already present." - :group 'lsp-serenata - :type 'lsp-string-vector) - -(defun lsp-serenata-server-start-fun (port) - "Define serenata start function, it requires a PORT." - `(,lsp-serenata-server-path - "-u" ,(number-to-string port))) - -(defun lsp-serenata-init-options () - "Init options for lsp-serenata." - `( :configuration ( :uris ,lsp-serenata-uris - :indexDatabaseUri ,lsp-serenata-index-database-uri - :phpVersion ,lsp-serenata-php-version - :excludedPathExpressions ,lsp-serenata-exclude-path-expressions - :fileExtensions ,lsp-serenata-file-extensions))) - - -(lsp-interface (serenata:didProgressIndexing (:sequenceOfIndexedItem :totalItemsToIndex :progressPercentage :folderUri :fileUri :info) nil )) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-tcp-connection 'lsp-serenata-server-start-fun) - :activation-fn (lsp-activate-on "php") - :priority -2 - :notification-handlers (ht ("serenata/didProgressIndexing" - (lambda (_server data) - (lsp-log "%s" (lsp:serenata-did-progress-indexing-info data))))) - - :initialization-options #'lsp-serenata-init-options - :initialized-fn (lambda (workspace) - (when (equal (length lsp-serenata-uris) 0) - (let* ((lsp-root (lsp--path-to-uri (lsp-workspace-root)))) - (setq lsp-serenata-uris (vector lsp-root)))) - (with-lsp-workspace workspace - (lsp--set-configuration - (lsp-configuration-section "serenata")))) - :server-id 'serenata)) - -;;; phpactor - -(defgroup lsp-phpactor nil - "LSP support for Phpactor." - :link '(url-link "https://github.com/phpactor/phpactor") - :group 'lsp-mode) - -(defcustom lsp-phpactor-path nil - "Path to the `phpactor' command." - :group 'lsp-phpactor - :type "string") - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection - (lambda () - (unless lsp-php-composer-dir - (setq lsp-php-composer-dir (lsp-php-get-composer-dir))) - (unless lsp-phpactor-path - (setq lsp-phpactor-path (or (executable-find "phpactor") - (f-join lsp-php-composer-dir "vendor/phpactor/phpactor/bin/phpactor")))) - (list lsp-phpactor-path "language-server"))) - :activation-fn (lsp-activate-on "php") - ;; `phpactor' is not really that feature-complete: it doesn't support - ;; `textDocument/showOccurence' and sometimes errors (e.g. find references on - ;; a global free-standing function). - :priority -4 - ;; Even though `phpactor' itself supports no options, this needs to be - ;; serialized as an empty object (otherwise the LS won't even start, due to a - ;; type error). - :initialization-options (ht) - :server-id 'phpactor)) - -(defcustom lsp-phpactor-extension-alist '(("Phpstan" . "phpactor/language-server-phpstan-extension") - ("Behat" . "phpactor/behat-extension") - ("PHPUnit" . "phpactor/phpunit-extension")) - "Alist mapping extension names to `composer' packages. -These extensions can be installed using -`lsp-phpactor-install-extension'." - :type '(alist :key-type "string" :value-type "string") - :group 'lsp-phpactor) - -(defun lsp-phpactor-install-extension (extension) - "Install a `phpactor' EXTENSION. -See `lsp-phpactor-extension-alist' and -https://phpactor.readthedocs.io/en/develop/extensions.html." - (interactive (list (completing-read "Select extension: " - lsp-phpactor-extension-alist))) - (compilation-start - (format "%s extension:install %s" - (shell-quote-argument (expand-file-name lsp-phpactor-path)) - (shell-quote-argument - (cdr (assoc extension lsp-phpactor-extension-alist)))) - nil - (lambda (_mode) - (format "*Phpactor install %s*" extension)))) - -(lsp-consistency-check lsp-php) - -(provide 'lsp-php) -;;; lsp-php.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-prolog.el b/elpa/lsp-mode-20220201.852/lsp-prolog.el deleted file mode 100644 index 084f0ee7..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-prolog.el +++ /dev/null @@ -1,55 +0,0 @@ -;;; lsp-prolog.el --- Prolog Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 James Cash - -;; Author: James Cash -;; 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 . - -;;; 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/elpa/lsp-mode-20220201.852/lsp-protocol.el b/elpa/lsp-mode-20220201.852/lsp-protocol.el deleted file mode 100644 index a3de34c9..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-protocol.el +++ /dev/null @@ -1,766 +0,0 @@ -;;; lsp-protocol.el --- Language Sever Protocol Bindings -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 Ivan Yonchovski - -;; Author: Ivan Yonchovski -;; 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 . - -;;; Commentary: - -;; Autogenerated bindings from lsp4j using -;; https://github.com/victools/jsonschema-generator+scrips to generate -;; scripts/generated.protocol.schema.json and then -;; scripts/lsp-generate-bindings.el - -;;; Code: - -(require 'cl-lib) -(require 'dash) -(require 'ht) -(require 's) - -(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))) - `(pcase-defmacro ,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)))) - -(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)))) - (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))))) - -(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))) - -(lsp-interface (csharp-ls:CSharpMetadata (:textDocument)) - (csharp-ls:CSharpMetadataResponse (:source :projectName :assemblyName :symbolName))) - -(lsp-interface (rls:Cmd (:args :binary :env :cwd) nil)) - -(defconst lsp/rust-analyzer-inlay-hint-kind-type-hint "TypeHint") -(defconst lsp/rust-analyzer-inlay-hint-kind-param-hint "ParameterHint") -(defconst lsp/rust-analyzer-inlay-hint-kind-chaining-hint "ChainingHint") -(lsp-interface (rust-analyzer:AnalyzerStatusParams (:textDocument)) - (rust-analyzer:SyntaxTreeParams (:textDocument) (:range)) - (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)) - (rust-analyzer:RelatedTestsParams (:textDocument :position) nil) - (rust-analyzer:RelatedTests (:runnable) nil) - (rust-analyzer:InlayHint (:range :label :kind) nil) - (rust-analyzer:InlayHintsParams (:textDocument) 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))) - - -;; 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)) - (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)) - (DiagnosticRelatedInformation (:location :message) nil) - (DiagnosticsTagSupport (:valueSet) nil) - (DidChangeConfigurationCapabilities nil (:dynamicRegistration)) - (DidChangeWatchedFilesCapabilities nil (:dynamicRegistration)) - (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)) - (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)) - (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)) - (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) - (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)) - (ReferenceParams (:textDocument :context :position) (:uri)) - (RegistrationParams (:registrations) nil) - (RenameFile (:kind :newUri :oldUri) (:options)) - (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) - (ShowMessageRequestParams (:type :message) (:actions)) - (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)) - - -(provide 'lsp-protocol) - -;;; lsp-protocol.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-purescript.el b/elpa/lsp-mode-20220201.852/lsp-purescript.el deleted file mode 100644 index d6e761ab..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-purescript.el +++ /dev/null @@ -1,72 +0,0 @@ -;;; lsp-purescript.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, purescript - -;; 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 . - -;;; Commentary: - -;; LSP Clients for the PureScript Programming Language. - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-purescript nil - "LSP support for PureScript, using purescript-language-server." - :group 'lsp-mode - :link '(url-link "https://github.com/nwolverson/purescript-language-server")) - -(defcustom lsp-purescript-server-executable nil - "Path to server executable." - :type 'string - :risky t - :group 'lsp-purescript) - -(defcustom lsp-purescript-server-args - '("--stdio") - "Arguments to pass to the server." - :type '(repeat string) - :risky t - :group 'lsp-purescript) - -(defun lsp-purescript--server-command () - "Generate LSP startup command for purescript-language-server." - (cons (or lsp-purescript-server-executable - (lsp-package-path 'purescript-language-server)) - lsp-purescript-server-args)) - -(lsp-dependency 'purescript-language-server - '(:system "purescript-language-server") - '(:npm :package "purescript-language-server" - :path "purescript-language-server")) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection - #'lsp-purescript--server-command) - :major-modes '(purescript-mode) - :priority -1 - :server-id 'pursls - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'purescript-language-server callback error-callback)))) - - -(lsp-consistency-check lsp-purescript) - -(provide 'lsp-purescript) -;;; lsp-purescript.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-pwsh.el b/elpa/lsp-mode-20220201.852/lsp-pwsh.el deleted file mode 100644 index 7b39bba4..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-pwsh.el +++ /dev/null @@ -1,363 +0,0 @@ -;;; lsp-pwsh.el --- client for PowerShellEditorServices -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Kien Nguyen - -;; Author: kien.n.quang at gmail.com -;; 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 . - -;;; Commentary: - -;; - -;;; Code: - -(require 'f) -(require 'dash) -(require 's) -(require 'ht) - -(require 'lsp-protocol) -(require 'lsp-mode) - -(defgroup lsp-pwsh nil - "LSP support for PowerShell, using the PowerShellEditorServices." - :group 'lsp-mode - :package-version '(lsp-mode . "6.2")) - -;; PowerShell vscode flags -(defcustom lsp-pwsh-help-completion "BlockComment" - "Controls the comment-based help completion behavior triggered by typing '##'. -Set the generated help style with 'BlockComment' or 'LineComment'. -Disable the feature with 'Disabled'." - :type - '(choice - (:tag "Disabled" "BlockComment" "LineComment")) - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-script-analysis-enable t - "Enables real-time script analysis from PowerShell Script Analyzer. -Uses the newest installed version of the PSScriptAnalyzer module or the -version bundled with this extension, if it is newer." - :type 'boolean - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-script-analysis-settings-path "" - "Specifies the path to a PowerShell Script Analyzer settings file. -To override the default settings for all projects, enter an absolute path, -or enter a path relative to your workspace." - :type 'string - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-code-folding-enable t - "Enables syntax based code folding. -When disabled, the default indentation based code folding is used." - :type 'boolean - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-code-folding-show-last-line t - "Shows the last line of a folded section. -Similar to the default VSCode folding style. -When disabled, the entire folded region is hidden." - :type 'boolean - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-code-formatting-preset "Custom" - "Sets the codeformatting options to follow the given indent style. -Sets in a way that is compatible with PowerShell syntax. -For more information about the brace styles please refer to https://github.com/PoshCode/PowerShellPracticeAndStyle/issues/81." - :type - '(choice - (:tag "Custom" "Allman" "OTBS" "Stroustrup")) - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-code-formatting-open-brace-on-same-line t - "Places open brace on the same line as its associated statement." - :type 'boolean - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-code-formatting-new-line-after-open-brace t - "Adds a newline (line break) after an open brace." - :type 'boolean - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-code-formatting-new-line-after-close-brace t - "Adds a newline (line break) after a closing brace." - :type 'boolean - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-code-formatting-pipeline-indentation-style "NoIndentation" - "Multi-line pipeline style settings." - :type - '(choice - (:tag "IncreaseIndentationForFirstPipeline" "IncreaseIndentationAfterEveryPipeline" "NoIndentation")) - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-code-formatting-whitespace-before-open-brace t - "Adds a space between a keyword and its associated scriptblock expression." - :type 'boolean - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-code-formatting-whitespace-before-open-paren t - "Adds a space between a keyword (if, elseif, while, switch, etc) and its -associated conditional expression." - :type 'boolean - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-code-formatting-whitespace-around-operator t - "Adds spaces before and after an operator ('=', '+', '-', etc.)." - :type 'boolean - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-code-formatting-whitespace-after-separator t - "Adds a space after a separator (',' and ';')." - :type 'boolean - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-code-formatting-whitespace-inside-brace t - "Adds a space after an opening brace ('{') and before a closing brace ('}')." - :type 'boolean - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-code-formatting-whitespace-around-pipe t - "Adds a space before and after the pipeline operator ('|')." - :type 'boolean - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-code-formatting-ignore-one-line-block t - "Does not reformat one-line code blocks, such as \"if (...) {...} else -{...}\"." - :type 'boolean - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-code-formatting-align-property-value-pairs t - "Align assignment statements in a hashtable or a DSC Configuration." - :type 'boolean - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-code-formatting-use-correct-casing nil - "Use correct casing for cmdlets." - :type 'boolean - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-developer-editor-services-log-level "Normal" - "Sets the log level for the PowerShell Editor Services host executable. -Valid values are 'Diagnostic', 'Verbose', 'Normal', 'Warning', and 'Error'" - :type - '(choice - (:tag "Diagnostic" "Verbose" "Normal" "Warning" "Error")) - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-developer-editor-services-wait-for-debugger nil - "Launches the language service with the /waitForDebugger flag to force it to -wait for a .NET debugger to attach before proceeding." - :type 'boolean - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-developer-feature-flags nil - "An array of strings that enable experimental features in the PowerShell -extension." - :type - '(repeat string) - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(lsp-register-custom-settings - '(("powershell.developer.featureFlags" lsp-pwsh-developer-feature-flags) - ("powershell.developer.editorServicesWaitForDebugger" lsp-pwsh-developer-editor-services-wait-for-debugger t) - ("powershell.codeFormatting.useCorrectCasing" lsp-pwsh-code-formatting-use-correct-casing t) - ("powershell.codeFormatting.alignPropertyValuePairs" lsp-pwsh-code-formatting-align-property-value-pairs t) - ("powershell.codeFormatting.ignoreOneLineBlock" lsp-pwsh-code-formatting-ignore-one-line-block t) - ("powershell.codeFormatting.whitespaceAroundPipe" lsp-pwsh-code-formatting-whitespace-around-pipe t) - ("powershell.codeFormatting.whitespaceInsideBrace" lsp-pwsh-code-formatting-whitespace-inside-brace t) - ("powershell.codeFormatting.whitespaceAfterSeparator" lsp-pwsh-code-formatting-whitespace-after-separator t) - ("powershell.codeFormatting.whitespaceAroundOperator" lsp-pwsh-code-formatting-whitespace-around-operator t) - ("powershell.codeFormatting.whitespaceBeforeOpenParen" lsp-pwsh-code-formatting-whitespace-before-open-paren t) - ("powershell.codeFormatting.whitespaceBeforeOpenBrace" lsp-pwsh-code-formatting-whitespace-before-open-brace t) - ("powershell.codeFormatting.pipelineIndentationStyle" lsp-pwsh-code-formatting-pipeline-indentation-style) - ("powershell.codeFormatting.newLineAfterCloseBrace" lsp-pwsh-code-formatting-new-line-after-close-brace t) - ("powershell.codeFormatting.newLineAfterOpenBrace" lsp-pwsh-code-formatting-new-line-after-open-brace t) - ("powershell.codeFormatting.openBraceOnSameLine" lsp-pwsh-code-formatting-open-brace-on-same-line t) - ("powershell.codeFormatting.preset" lsp-pwsh-code-formatting-preset) - ("powershell.codeFolding.showLastLine" lsp-pwsh-code-folding-show-last-line t) - ("powershell.codeFolding.enable" lsp-pwsh-code-folding-enable t) - ("powershell.scriptAnalysis.settingsPath" lsp-pwsh-script-analysis-settings-path) - ("powershell.scriptAnalysis.enable" lsp-pwsh-script-analysis-enable t) - ("powershell.helpCompletion" lsp-pwsh-help-completion))) - -;; lsp-pwsh custom variables -(defcustom lsp-pwsh-ext-path (expand-file-name "pwsh" lsp-server-install-dir) - "The path to powershell vscode extension." - :type 'string - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-exe (or (executable-find "pwsh") (executable-find "powershell")) - "PowerShell executable." - :type 'string - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pwsh-dir lsp-pwsh-ext-path - "Path to PowerShellEditorServices without last slash." - :type 'string - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defvar lsp-pwsh-pses-script (expand-file-name "PowerShellEditorServices/Start-EditorServices.ps1" - lsp-pwsh-dir) - "Main script to start PSES.") - -(defvar lsp-pwsh-log-path (expand-file-name "logs" lsp-pwsh-ext-path) - "Path to directory where server will write log files. -Must not nil.") - -(defvar lsp-pwsh--sess-id (emacs-pid)) - -(defun lsp-pwsh--command () - "Return the command to start server." - `(,lsp-pwsh-exe "-NoProfile" "-NonInteractive" "-NoLogo" - ,@(if (eq system-type 'windows-nt) '("-ExecutionPolicy" "Bypass")) - "-OutputFormat" "Text" - "-File" - ,lsp-pwsh-pses-script - "-HostName" "\"Emacs Host\"" - "-HostProfileId" "'Emacs.LSP'" - "-HostVersion" "8.0.1" - "-LogPath" ,(expand-file-name "emacs-powershell.log" lsp-pwsh-log-path) - "-LogLevel" ,lsp-pwsh-developer-editor-services-log-level - "-SessionDetailsPath" ,(expand-file-name (format "PSES-VSCode-%d" lsp-pwsh--sess-id) - lsp-pwsh-log-path) - ;; "-AdditionalModules" "@('PowerShellEditorServices.VSCode')" - "-Stdio" - "-BundledModulesPath" ,lsp-pwsh-dir - "-FeatureFlags" "@()")) - -(defun lsp-pwsh--extra-init-params () - "Return form describing parameters for language server.") - -(lsp-defun lsp-pwsh--apply-code-action-edits ((&Command :command :arguments?)) - "Handle ACTION for PowerShell.ApplyCodeActionEdits." - (-if-let* (((&pwsh:ScriptRegion :start-line-number :end-line-number - :start-column-number :end-column-number :text) - (lsp-seq-first arguments?)) - (start-position (lsp-make-position :line (1- start-line-number) - :character (1- start-column-number))) - (end-position (lsp-make-position :line (1- end-line-number) - :character (1- end-column-number))) - (edits `[,(lsp-make-text-edit :range (lsp-make-range :start start-position - :end end-position) - :newText text)])) - (lsp--apply-text-edits edits 'code-action) - (lsp-send-execute-command command arguments?))) - -(lsp-defun lsp-pwsh--show-code-action-document ((&Command :arguments?)) - "Handle ACTION for PowerShell.ShowCodeActionDocumentation." - (-if-let* ((rule-raw (lsp-seq-first arguments?)) - (rule-id (if (s-prefix-p "PS" rule-raw) (substring rule-raw 2) rule-raw))) - (browse-url - (concat "https://github.com/PowerShell/PSScriptAnalyzer/blob/master/RuleDocumentation/" - rule-id - ".md")) - (lsp-warn "Cannot show documentation for code action, no ruleName was supplied"))) - -(defvar lsp-pwsh--major-modes '(powershell-mode)) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection #'lsp-pwsh--command - (lambda () - (f-exists? lsp-pwsh-pses-script))) - :major-modes lsp-pwsh--major-modes - :server-id 'pwsh-ls - :priority -1 - :multi-root t - :initialization-options #'lsp-pwsh--extra-init-params - :notification-handlers (ht ("powerShell/executionStatusChanged" #'ignore) - ("output" #'ignore)) - :action-handlers (ht ("PowerShell.ApplyCodeActionEdits" - #'lsp-pwsh--apply-code-action-edits) - ("PowerShell.ShowCodeActionDocumentation" - #'lsp-pwsh--show-code-action-document)) - :initialized-fn (lambda (w) - (with-lsp-workspace w - (lsp--set-configuration - (lsp-configuration-section "powershell"))) - (let ((caps (lsp--workspace-server-capabilities w))) - (lsp:set-server-capabilities-document-range-formatting-provider? caps t) - (lsp:set-server-capabilities-document-formatting-provider? caps t))) - :download-server-fn #'lsp-pwsh-setup)) - -(defcustom lsp-pwsh-github-asset-url - "https://github.com/%s/%s/releases/latest/download/%s" - "GitHub latest asset template url." - :type 'string - :group 'lsp-pwsh - :package-version '(lsp-mode . "6.2")) - -(defun lsp-pwsh-setup (_client callback error-callback update) - "Downloads PowerShellEditorServices to `lsp-pwsh-dir'. -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." - - (unless (and lsp-pwsh-exe (file-executable-p lsp-pwsh-exe)) - (user-error "Use `lsp-pwsh-exe' with the value of `%s' is not a valid powershell binary" - lsp-pwsh-exe)) - - (let ((url (format lsp-pwsh-github-asset-url "PowerShell" - "PowerShellEditorServices" "PowerShellEditorServices.zip")) - (temp-file (make-temp-file "ext" nil ".zip"))) - (unless (f-exists? lsp-pwsh-log-path) - (mkdir lsp-pwsh-log-path 'create-parent)) - (unless (and (not update) (f-exists? lsp-pwsh-pses-script)) - ;; since we know it's installed, use powershell to download the file - ;; (and avoid url.el bugginess or additional libraries) - (when (f-exists? lsp-pwsh-dir) (delete-directory lsp-pwsh-dir 'recursive)) - (lsp-async-start-process - callback - error-callback - lsp-pwsh-exe "-noprofile" "-noninteractive" "-nologo" - "-ex" "bypass" "-command" - "Invoke-WebRequest" "-UseBasicParsing" "-uri" url "-outfile" temp-file ";" - "Expand-Archive" "-Path" temp-file - "-DestinationPath" lsp-pwsh-dir)))) - -(lsp-consistency-check lsp-pwsh) - -(provide 'lsp-pwsh) -;;; lsp-pwsh.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-pyls.el b/elpa/lsp-mode-20220201.852/lsp-pyls.el deleted file mode 100644 index 72137490..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-pyls.el +++ /dev/null @@ -1,504 +0,0 @@ -;;; lsp-pyls.el --- pyls configuration -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Ivan Yonchovski - -;; Author: Ivan Yonchovski -;; 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 . - -;;; Commentary: - -;; PYLS configuration - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-pyls nil - "LSP support for Python, using Palantir's Python Language Server." - :group 'lsp-mode - :link '(url-link "https://github.com/palantir/python-language-server") - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-clients-python-library-directories '("/usr/") - "List of directories which will be considered to be libraries." - :risky t - :type '(repeat string) - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(define-obsolete-variable-alias - 'lsp-clients-python-command - 'lsp-pyls-server-command - "6.1") - -(defcustom lsp-pyls-disable-warning nil - "Disable Palantir python-language-server deprecation warning" - :group 'lsp-pyls - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-pyls-server-command '("pyls") - "Command to start pyls." - :risky t - :group 'lsp-pyls - :type '(repeat string) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-configuration-sources ["pycodestyle"] - "List of configuration sources to use." - :type '(repeat string) - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-jedi-completion-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-jedi-completion-include-params t - "Auto-completes methods and classes with tabstops for each -parameter." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-jedi-definition-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-jedi-definition-follow-imports t - "The goto call will follow imports." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-jedi-definition-follow-builtin-imports t - "If follow_imports is True will decide if it follow builtin -imports." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-jedi-hover-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-jedi-references-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-jedi-signature-help-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-jedi-symbols-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-jedi-symbols-all-scopes t - "If True lists the names of all scopes instead of only the -module namespace." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-mccabe-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-mccabe-threshold 15 - "The minimum threshold that triggers warnings about cyclomatic -complexity." - :type 'number - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-preload-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-preload-modules nil - "List of modules to import on startup" - :type '(repeat string) - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pylint-enabled nil - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pylint-args [] - "Arguments, passed to pylint" - :risky t - :type 'lsp-string-vector - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pycodestyle-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pycodestyle-exclude nil - "Exclude files or directories which match these patterns." - :type '(repeat string) - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pycodestyle-filename nil - "When parsing directories, only check filenames matching these -patterns." - :type '(repeat string) - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pycodestyle-select nil - "Select errors and warnings" - :type '(repeat string) - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pycodestyle-ignore nil - "Ignore errors and warnings" - :type '(repeat string) - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pycodestyle-hang-closing nil - "Hang closing bracket instead of matching indentation of -opening bracket's line." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pycodestyle-max-line-length nil - "Set maximum allowed line length." - :type 'number - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pydocstyle-enabled nil - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pydocstyle-convention nil - "Choose the basic list of checked errors by specifying an -existing convention." - :type '(choice (:tag "pep257" "numpy")) - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pydocstyle-add-ignore nil - "Ignore errors and warnings in addition to the specified -convention." - :type '(repeat string) - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pydocstyle-add-select nil - "Select errors and warnings in addition to the specified -convention." - :type '(repeat string) - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pydocstyle-ignore nil - "Ignore errors and warnings" - :type '(repeat string) - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pydocstyle-select nil - "Select errors and warnings" - :type '(repeat string) - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pydocstyle-match "(?!test_).*\\.py" - "Check only files that exactly match the given regular -expression; default is to match files that don't start with -'test_' but end with '.py'." - :type 'string - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pydocstyle-match-dir "[^\\.].*" - "Search only dirs that exactly match the given regular -expression; default is to match dirs which do not begin with a -dot." - :type 'string - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-pyflakes-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-rope-completion-enabled nil - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-autopep8-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pyls-plugins-yapf-enabled nil - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-rope-extension-modules nil - "Builtin and c-extension modules that are allowed to be -imported and inspected by rope." - :type 'string - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-rope-rope-folder nil - "The name of the folder in which rope stores project -configurations and data. Pass `nil` for not using such a folder -at all." - :type '(repeat string) - :group 'lsp-pyls - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-pyls-plugins-flake8-enabled nil - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pyls-plugins-flake8-exclude nil - "List of glob patterns to exclude from checks." - :type '(repeat string) - :group 'lsp-pyls - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pyls-plugins-flake8-filename nil - "List of glob patterns to include for checks." - :type '(repeat string) - :group 'lsp-pyls - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pyls-plugins-flake8-hang-closing nil - "Toggle whether pycodestyle should enforce matching the indentation of the -opening bracket’s line. When you specify this, it will prefer that you hang the -closing bracket rather than match the indentation." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pyls-plugins-flake8-ignore nil - "A list of codes to ignore." - :type '(repeat string) - :group 'lsp-pyls - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pyls-plugins-flake8-max-line-length nil - "Set the maximum length that any line (with some exceptions) may be. -Exceptions include lines that are either strings or comments which are -entirely URLs." - :type 'integer - :group 'lsp-pyls - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pyls-plugins-flake8-select nil - "Specify the list of error codes you wish Flake8 to report. Similarly to -`lsp-pyls-plugins-flake8-ignore'. You can specify a portion of an error code to -get all that start with that string. For example, you can use E, E4, E43, and -E431" - :type '(repeat string) - :group 'lsp-pyls - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-pyls-plugins-flake8-config nil - "A path to a config file that will be the only config file read and used. -This will cause Flake8 to ignore all other config files that exist. - -NOTE: other parameters as `lsp-pyls-plugins-flake8-max-line-length' take -precedence over parameters referenced in config." - :type 'string - :group 'lsp-pyls - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-pyls-plugins-jedi-use-pyenv-environment nil - "If enabled, pass the environment got by pyenv to jedi" - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-pyls-plugins-jedi-environment nil - "Specify the environment that jedi runs on where /bin/python -should be the python executable. This option will be prioritized over -`lsp-pyls-plugins-jedi-use-pyenv-environment'." - :type 'string - :group 'lsp-pyls - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-pyls-plugins-jedi-completion-fuzzy nil - "If enabled, uses fuzzy completion in jedi. Requires pyls >= 0.32.0 -Can hit performance, as well as lsp-mode implements its own fuzzy search on -completion items." - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "7.0")) - -(defcustom lsp-pyls-plugins-jedi-completion-include-class-objects t - "If enabled, adds class objects to completion in order to avoid snippet -with init args. - -Has no effect if `lsp-pyls-plugins-jedi-completion-include-params' is disabled. -Requires pyls >= 0.33.0" - :type 'boolean - :group 'lsp-pyls - :package-version '(lsp-mode . "7.0")) - -(defcustom lsp-pyls-rename-backend 'jedi - "Choose renaming backend. - -Jedi is preferred but only works for python >= 3.6 and pyls >= 0.32.0 -Beware that Jedi is lazy and doesn't scan the whole project. -So it will rename only references it can find." - :type '(choice (const :tag "jedi" jedi) - (const :tag "rope" rope)) - :group 'lsp-pyls - :package-version '(lsp-mode . "7.0")) - - -(defun lsp-pyls-get-pyenv-environment () - "Get the pyenv-managed environment for current workspace, where -/bin/python is the corresponding Python executable" - (if lsp-pyls-plugins-jedi-environment - lsp-pyls-plugins-jedi-environment - (when lsp-pyls-plugins-jedi-use-pyenv-environment - (let ((pyenv-version (getenv "PYENV_VERSION")) - (root (lsp-seq-first (lsp-find-roots-for-workspace lsp--cur-workspace (lsp-session))))) - (when root - (setenv "PYENV_VERSION" nil) - (let* ((pyenv-command-path (executable-find "pyenv")) - (python-env (when pyenv-command-path - (f-parent - (f-parent - (shell-command-to-string - (format "PYENV_DIR='%s' %s which python" - root pyenv-command-path))))))) - (if python-env (lsp--info "Configure pyls with environment: %s" python-env) - (lsp--warn "Can't find the python environment for - %s even if - `lsp-pyls-plugins-jedi-use-pyenv-environment` is - enabled") root) - (setenv "PYENV_VERSION" pyenv-version) - python-env)))))) - -(lsp-register-custom-settings - '(("pyls.rope.ropeFolder" lsp-pyls-rope-rope-folder) - ("pyls.rope.extensionModules" lsp-pyls-rope-extension-modules) - ("pyls.plugins.rope_rename.enabled" (lambda () (eq lsp-pyls-rename-backend 'rope)) t) - ("pyls.plugins.autopep8.enabled" lsp-pyls-plugins-autopep8-enabled t) - ("pyls.plugins.yapf.enabled" lsp-pyls-plugins-yapf-enabled t) - ("pyls.plugins.rope_completion.enabled" lsp-pyls-plugins-rope-completion-enabled t) - ("pyls.plugins.pyflakes.enabled" lsp-pyls-plugins-pyflakes-enabled t) - ("pyls.plugins.pydocstyle.matchDir" lsp-pyls-plugins-pydocstyle-match-dir) - ("pyls.plugins.pydocstyle.match" lsp-pyls-plugins-pydocstyle-match) - ("pyls.plugins.pydocstyle.select" lsp-pyls-plugins-pydocstyle-select) - ("pyls.plugins.pydocstyle.ignore" lsp-pyls-plugins-pydocstyle-ignore) - ("pyls.plugins.pydocstyle.addSelect" lsp-pyls-plugins-pydocstyle-add-select) - ("pyls.plugins.pydocstyle.addIgnore" lsp-pyls-plugins-pydocstyle-add-ignore) - ("pyls.plugins.pydocstyle.convention" lsp-pyls-plugins-pydocstyle-convention) - ("pyls.plugins.pydocstyle.enabled" lsp-pyls-plugins-pydocstyle-enabled t) - ("pyls.plugins.pycodestyle.maxLineLength" lsp-pyls-plugins-pycodestyle-max-line-length) - ("pyls.plugins.pycodestyle.hangClosing" lsp-pyls-plugins-pycodestyle-hang-closing t) - ("pyls.plugins.pycodestyle.ignore" lsp-pyls-plugins-pycodestyle-ignore) - ("pyls.plugins.pycodestyle.select" lsp-pyls-plugins-pycodestyle-select) - ("pyls.plugins.pycodestyle.filename" lsp-pyls-plugins-pycodestyle-filename) - ("pyls.plugins.pycodestyle.exclude" lsp-pyls-plugins-pycodestyle-exclude) - ("pyls.plugins.pycodestyle.enabled" lsp-pyls-plugins-pycodestyle-enabled t) - ("pyls.plugins.pylint.enabled" lsp-pyls-plugins-pylint-enabled t) - ("pyls.plugins.pylint.args" lsp-pyls-plugins-pylint-args) - ("pyls.plugins.flake8.enabled" lsp-pyls-plugins-flake8-enabled) - ("pyls.plugins.flake8.exclude" lsp-pyls-plugins-flake8-exclude) - ("pyls.plugins.flake8.filename" lsp-pyls-plugins-flake8-filename) - ("pyls.plugins.flake8.hangClosing" lsp-pyls-plugins-flake8-hang-closing) - ("pyls.plugins.flake8.ignore" lsp-pyls-plugins-flake8-ignore) - ("pyls.plugins.flake8.maxLineLength" lsp-pyls-plugins-flake8-max-line-length) - ("pyls.plugins.flake8.select" lsp-pyls-plugins-flake8-select) - ("pyls.plugins.flake8.config" lsp-pyls-plugins-flake8-config) - ("pyls.plugins.preload.modules" lsp-pyls-plugins-preload-modules) - ("pyls.plugins.preload.enabled" lsp-pyls-plugins-preload-enabled t) - ("pyls.plugins.mccabe.threshold" lsp-pyls-plugins-mccabe-threshold) - ("pyls.plugins.mccabe.enabled" lsp-pyls-plugins-mccabe-enabled t) - ("pyls.plugins.jedi_symbols.all_scopes" lsp-pyls-plugins-jedi-symbols-all-scopes t) - ("pyls.plugins.jedi_symbols.enabled" lsp-pyls-plugins-jedi-symbols-enabled t) - ("pyls.plugins.jedi_signature_help.enabled" lsp-pyls-plugins-jedi-signature-help-enabled t) - ("pyls.plugins.jedi_references.enabled" lsp-pyls-plugins-jedi-references-enabled t) - ("pyls.plugins.jedi_hover.enabled" lsp-pyls-plugins-jedi-hover-enabled t) - ("pyls.plugins.jedi_definition.follow_builtin_imports" lsp-pyls-plugins-jedi-definition-follow-builtin-imports t) - ("pyls.plugins.jedi_definition.follow_imports" lsp-pyls-plugins-jedi-definition-follow-imports t) - ("pyls.plugins.jedi_definition.enabled" lsp-pyls-plugins-jedi-definition-enabled t) - ("pyls.plugins.jedi_completion.include_params" lsp-pyls-plugins-jedi-completion-include-params t) - ("pyls.plugins.jedi_completion.enabled" lsp-pyls-plugins-jedi-completion-enabled t) - ("pyls.plugins.jedi_completion.include_class_objects" lsp-pyls-plugins-jedi-completion-include-class-objects t) - ("pyls.plugins.jedi.environment" lsp-pyls-get-pyenv-environment) - ("pyls.plugins.jedi_completion.fuzzy" lsp-pyls-plugins-jedi-completion-fuzzy t) - ("pyls.plugins.jedi_rename.enabled" (lambda () (eq lsp-pyls-rename-backend 'jedi)) t) - ("pyls.configurationSources" lsp-pyls-configuration-sources))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection - (lambda () lsp-clients-python-command)) - :major-modes '(python-mode cython-mode) - :priority -2 - :server-id 'pyls - :library-folders-fn (lambda (_workspace) lsp-clients-python-library-directories) - :initialized-fn (lambda (workspace) - (unless lsp-pyls-disable-warning - (warn (concat "The palantir python-language-server (pyls) is unmaintained; " - "a maintained fork is the python-lsp-server (pylsp) project; " - "you can install it with pip via: pip install python-lsp-server"))) - (with-lsp-workspace workspace - (lsp--set-configuration (lsp-configuration-section "pyls")))))) - -(lsp-consistency-check lsp-pyls) - -(provide 'lsp-pyls) -;;; lsp-pyls.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-pylsp.el b/elpa/lsp-mode-20220201.852/lsp-pylsp.el deleted file mode 100644 index 511745ff..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-pylsp.el +++ /dev/null @@ -1,434 +0,0 @@ -;;; lsp-pylsp.el --- python-lsp-server support -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 Doug Davis - -;; Author: Doug Davis -;; Keywords: language 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 . - -;;; Commentary: - -;; pylsp configuration - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-pylsp nil - "LSP support for Python, using python-lsp's Python Language Server." - :group 'lsp-mode - :link '(url-link "https://github.com/python-lsp/python-lsp-server")) - -(defcustom lsp-clients-pylsp-library-directories '("/usr/") - "List of directories which will be considered to be libraries." - :risky t - :type '(repeat string) - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-server-command '("pylsp") - "Command to start pylsp." - :risky t - :group 'lsp-pylsp - :type '(repeat string)) - -(defcustom lsp-pylsp-configuration-sources ["flake8"] - "List of configuration sources to use." - :type 'lsp-string-vector - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-jedi-completion-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-jedi-completion-include-params t - "Auto-completes methods and classes with tabstops for each -parameter." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-jedi-definition-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-jedi-definition-follow-imports t - "The goto call will follow imports." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-jedi-definition-follow-builtin-imports t - "If follow_imports is True will decide if it follow builtin -imports." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-jedi-hover-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-jedi-references-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-jedi-signature-help-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-jedi-symbols-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-jedi-symbols-all-scopes t - "If True lists the names of all scopes instead of only the -module namespace." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-mccabe-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-mccabe-threshold 15 - "The minimum threshold that triggers warnings about cyclomatic -complexity." - :type 'number - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-preload-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-preload-modules nil - "List of modules to import on startup" - :type 'lsp-string-vector - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pylint-enabled nil - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pylint-args [] - "Arguments, passed to pylint" - :risky t - :type 'lsp-string-vector - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pycodestyle-enabled nil - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pycodestyle-exclude nil - "Exclude files or directories which match these patterns." - :type 'lsp-string-vector - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pycodestyle-filename nil - "When parsing directories, only check filenames matching these -patterns." - :type 'lsp-string-vector - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pycodestyle-select nil - "Select errors and warnings" - :type 'lsp-string-vector - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pycodestyle-ignore nil - "Ignore errors and warnings" - :type 'lsp-string-vector - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pycodestyle-hang-closing nil - "Hang closing bracket instead of matching indentation of -opening bracket's line." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pycodestyle-max-line-length nil - "Set maximum allowed line length." - :type 'number - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pydocstyle-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pydocstyle-convention nil - "Choose the basic list of checked errors by specifying an -existing convention." - :type '(choice (:tag "pep257" "numpy")) - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pydocstyle-add-ignore nil - "Ignore errors and warnings in addition to the specified -convention." - :type 'lsp-string-vector - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pydocstyle-add-select nil - "Select errors and warnings in addition to the specified -convention." - :type 'lsp-string-vector - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pydocstyle-ignore nil - "Ignore errors and warnings" - :type 'lsp-string-vector - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pydocstyle-select nil - "Select errors and warnings" - :type 'lsp-string-vector - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pydocstyle-match "(?!test_).*\\.py" - "Check only files that exactly match the given regular -expression; default is to match files that don't start with -'test_' but end with '.py'." - :type 'string - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pydocstyle-match-dir "[^\\.].*" - "Search only dirs that exactly match the given regular -expression; default is to match dirs which do not begin with a -dot." - :type 'string - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-pyflakes-enabled nil - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-rope-completion-enabled nil - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-autopep8-enabled nil - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-yapf-enabled nil - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-rope-extension-modules nil - "Builtin and c-extension modules that are allowed to be -imported and inspected by rope." - :type 'string - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-rope-rope-folder nil - "The name of the folder in which rope stores project -configurations and data. Pass `nil` for not using such a folder -at all." - :type 'lsp-string-vector - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-flake8-enabled t - "Enable or disable the plugin." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-flake8-exclude nil - "List of glob patterns to exclude from checks." - :type 'lsp-string-vector - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-flake8-filename nil - "List of glob patterns to include for checks." - :type 'lsp-string-vector - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-flake8-hang-closing nil - "Toggle whether pycodestyle should enforce matching the indentation of the -opening bracket’s line. When you specify this, it will prefer that you hang the -closing bracket rather than match the indentation." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-flake8-ignore nil - "A list of codes to ignore." - :type 'lsp-string-vector - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-flake8-max-line-length nil - "Set the maximum length that any line (with some exceptions) may be. -Exceptions include lines that are either strings or comments which are -entirely URLs." - :type 'integer - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-flake8-select nil - "Specify the list of error codes you wish Flake8 to report. Similarly to -`lsp-pylsp-plugins-flake8-ignore'. You can specify a portion of an error code to -get all that start with that string. For example, you can use E, E4, E43, and -E431" - :type 'lsp-string-vector - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-flake8-config nil - "A path to a config file that will be the only config file read and used. -This will cause Flake8 to ignore all other config files that exist. - -NOTE: other parameters as `lsp-pylsp-plugins-flake8-max-line-length' take -precedence over parameters referenced in config." - :type 'string - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-jedi-use-pyenv-environment nil - "If enabled, pass the environment got by pyenv to jedi" - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-jedi-environment nil - "Specify the environment that jedi runs on where /bin/python -should be the python executable. This option will be prioritized over -`lsp-pylsp-plugins-jedi-use-pyenv-environment'." - :type 'string - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-jedi-completion-fuzzy nil - "If enabled, uses fuzzy completion in jedi. Requires pylsp >= 0.32.0 -Can hit performance, as well as lsp-mode implements its own fuzzy search on -completion items." - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-plugins-jedi-completion-include-class-objects t - "If enabled, adds class objects to completion in order to avoid snippet -with init args. - -Has no effect if `lsp-pylsp-plugins-jedi-completion-include-params' is disabled. -Requires pylsp >= 0.33.0" - :type 'boolean - :group 'lsp-pylsp) - -(defcustom lsp-pylsp-rename-backend 'jedi - "Choose renaming backend. - -Jedi is preferred but only works for python >= 3.6 and pylsp >= 0.32.0 -Beware that Jedi is lazy and doesn't scan the whole project. -So it will rename only references it can find." - :type '(choice (const :tag "jedi" jedi) - (const :tag "rope" rope)) - :group 'lsp-pylsp) - -(defun lsp-pylsp-get-pyenv-environment () - "Get the pyenv-managed environment for current workspace, where -/bin/python is the corresponding Python executable" - (if lsp-pylsp-plugins-jedi-environment - lsp-pylsp-plugins-jedi-environment - (when lsp-pylsp-plugins-jedi-use-pyenv-environment - (let ((pyenv-version (getenv "PYENV_VERSION")) - (root (lsp-seq-first (lsp-find-roots-for-workspace lsp--cur-workspace (lsp-session))))) - (when root - (setenv "PYENV_VERSION" nil) - (let* ((pyenv-command-path (executable-find "pyenv")) - (python-env (when pyenv-command-path - (f-parent - (f-parent - (shell-command-to-string - (format "PYENV_DIR='%s' %s which python" - root pyenv-command-path))))))) - (if python-env (lsp--info "Configure pylsp with environment: %s" python-env) - (lsp--warn "Can't find the python environment for - %s even if - `lsp-pylsp-plugins-jedi-use-pyenv-environment` is - enabled") root) - (setenv "PYENV_VERSION" pyenv-version) - python-env)))))) - -(lsp-register-custom-settings - '(("pylsp.rope.ropeFolder" lsp-pylsp-rope-rope-folder) - ("pylsp.rope.extensionModules" lsp-pylsp-rope-extension-modules) - ("pylsp.plugins.rope_rename.enabled" (lambda () (eq lsp-pylsp-rename-backend 'rope)) t) - ("pylsp.plugins.autopep8.enabled" lsp-pylsp-plugins-autopep8-enabled t) - ("pylsp.plugins.yapf.enabled" lsp-pylsp-plugins-yapf-enabled t) - ("pylsp.plugins.rope_completion.enabled" lsp-pylsp-plugins-rope-completion-enabled t) - ("pylsp.plugins.pyflakes.enabled" lsp-pylsp-plugins-pyflakes-enabled t) - ("pylsp.plugins.pydocstyle.matchDir" lsp-pylsp-plugins-pydocstyle-match-dir) - ("pylsp.plugins.pydocstyle.match" lsp-pylsp-plugins-pydocstyle-match) - ("pylsp.plugins.pydocstyle.select" lsp-pylsp-plugins-pydocstyle-select) - ("pylsp.plugins.pydocstyle.ignore" lsp-pylsp-plugins-pydocstyle-ignore) - ("pylsp.plugins.pydocstyle.addSelect" lsp-pylsp-plugins-pydocstyle-add-select) - ("pylsp.plugins.pydocstyle.addIgnore" lsp-pylsp-plugins-pydocstyle-add-ignore) - ("pylsp.plugins.pydocstyle.convention" lsp-pylsp-plugins-pydocstyle-convention) - ("pylsp.plugins.pydocstyle.enabled" lsp-pylsp-plugins-pydocstyle-enabled t) - ("pylsp.plugins.pycodestyle.maxLineLength" lsp-pylsp-plugins-pycodestyle-max-line-length) - ("pylsp.plugins.pycodestyle.hangClosing" lsp-pylsp-plugins-pycodestyle-hang-closing t) - ("pylsp.plugins.pycodestyle.ignore" lsp-pylsp-plugins-pycodestyle-ignore) - ("pylsp.plugins.pycodestyle.select" lsp-pylsp-plugins-pycodestyle-select) - ("pylsp.plugins.pycodestyle.filename" lsp-pylsp-plugins-pycodestyle-filename) - ("pylsp.plugins.pycodestyle.exclude" lsp-pylsp-plugins-pycodestyle-exclude) - ("pylsp.plugins.pycodestyle.enabled" lsp-pylsp-plugins-pycodestyle-enabled t) - ("pylsp.plugins.pylint.enabled" lsp-pylsp-plugins-pylint-enabled t) - ("pylsp.plugins.pylint.args" lsp-pylsp-plugins-pylint-args) - ("pylsp.plugins.flake8.enabled" lsp-pylsp-plugins-flake8-enabled) - ("pylsp.plugins.flake8.exclude" lsp-pylsp-plugins-flake8-exclude) - ("pylsp.plugins.flake8.filename" lsp-pylsp-plugins-flake8-filename) - ("pylsp.plugins.flake8.hangClosing" lsp-pylsp-plugins-flake8-hang-closing) - ("pylsp.plugins.flake8.ignore" lsp-pylsp-plugins-flake8-ignore) - ("pylsp.plugins.flake8.maxLineLength" lsp-pylsp-plugins-flake8-max-line-length) - ("pylsp.plugins.flake8.select" lsp-pylsp-plugins-flake8-select) - ("pylsp.plugins.flake8.config" lsp-pylsp-plugins-flake8-config) - ("pylsp.plugins.preload.modules" lsp-pylsp-plugins-preload-modules) - ("pylsp.plugins.preload.enabled" lsp-pylsp-plugins-preload-enabled t) - ("pylsp.plugins.mccabe.threshold" lsp-pylsp-plugins-mccabe-threshold) - ("pylsp.plugins.mccabe.enabled" lsp-pylsp-plugins-mccabe-enabled t) - ("pylsp.plugins.jedi_symbols.all_scopes" lsp-pylsp-plugins-jedi-symbols-all-scopes t) - ("pylsp.plugins.jedi_symbols.enabled" lsp-pylsp-plugins-jedi-symbols-enabled t) - ("pylsp.plugins.jedi_signature_help.enabled" lsp-pylsp-plugins-jedi-signature-help-enabled t) - ("pylsp.plugins.jedi_references.enabled" lsp-pylsp-plugins-jedi-references-enabled t) - ("pylsp.plugins.jedi_hover.enabled" lsp-pylsp-plugins-jedi-hover-enabled t) - ("pylsp.plugins.jedi_definition.follow_builtin_imports" lsp-pylsp-plugins-jedi-definition-follow-builtin-imports t) - ("pylsp.plugins.jedi_definition.follow_imports" lsp-pylsp-plugins-jedi-definition-follow-imports t) - ("pylsp.plugins.jedi_definition.enabled" lsp-pylsp-plugins-jedi-definition-enabled t) - ("pylsp.plugins.jedi_completion.include_params" lsp-pylsp-plugins-jedi-completion-include-params t) - ("pylsp.plugins.jedi_completion.enabled" lsp-pylsp-plugins-jedi-completion-enabled t) - ("pylsp.plugins.jedi_completion.include_class_objects" lsp-pylsp-plugins-jedi-completion-include-class-objects t) - ("pylsp.plugins.jedi.environment" lsp-pylsp-get-pyenv-environment) - ("pylsp.plugins.jedi_completion.fuzzy" lsp-pylsp-plugins-jedi-completion-fuzzy t) - ("pylsp.plugins.jedi_rename.enabled" (lambda () (eq lsp-pylsp-rename-backend 'jedi)) t) - ("pylsp.configurationSources" lsp-pylsp-configuration-sources))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection - (lambda () lsp-pylsp-server-command)) - :major-modes '(python-mode cython-mode) - :priority -1 - :server-id 'pylsp - :library-folders-fn (lambda (_workspace) lsp-clients-pylsp-library-directories) - :initialized-fn (lambda (workspace) - (with-lsp-workspace workspace - (lsp--set-configuration (lsp-configuration-section "pylsp")))))) - -(lsp-consistency-check lsp-pylsp) - -(provide 'lsp-pylsp) -;;; lsp-pylsp.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-r.el b/elpa/lsp-mode-20220201.852/lsp-r.el deleted file mode 100644 index da54bc37..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-r.el +++ /dev/null @@ -1,49 +0,0 @@ -;;; lsp-r.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, r - -;; 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 . - -;;; Commentary: - -;; LSP Clients for the R Programming Language. - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-r nil - "LSP support for R." - :group 'lsp-mode - :link '(url-link "https://github.com/REditorSupport/languageserver")) - -(defcustom lsp-clients-r-server-command '("R" "--slave" "-e" "languageserver::run()") - "Command to start the R language server." - :group 'lsp-r - :risky t - :type '(repeat string)) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection lsp-clients-r-server-command) - :major-modes '(ess-r-mode) - :server-id 'lsp-r)) - - -(lsp-consistency-check lsp-r) - -(provide 'lsp-r) -;;; lsp-r.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-racket.el b/elpa/lsp-mode-20220201.852/lsp-racket.el deleted file mode 100644 index be00ba97..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-racket.el +++ /dev/null @@ -1,77 +0,0 @@ -;;; lsp-racket.el --- lsp-mode racket integration -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 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 . - -;;; Commentary: - -;; Client for the Racket language server. - -;;; Code: - -(require 'ht) -(require 'lsp-mode) - - -;; racket-langserver - -(defgroup lsp-racket-langserver nil - "LSP support for Racket, using racket-langserver" - :group 'lsp-mode - :link '(url-link "https://github.com/jeapostrophe/racket-langserver")) - -(defcustom lsp-racket-langserver-command '("racket" "--lib" "racket-langserver") - "Command to start the server." - :type 'string - :package-version '(lsp-mode . "8.0.0")) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection (lambda () lsp-racket-langserver-command)) - :major-modes '(racket-mode) - :priority 1 - :server-id 'racket-langserver)) - - -;; Theia - -(defgroup lsp-racket-language-server nil - "LSP support for Racket, using racket-language-server." - :group 'lsp-mode - :link '(url-link "https://github.com/theia-ide/racket-language-server")) - -(defcustom lsp-racket-language-server-path "racket-language-server" - "Executable path for the server." - :type 'string - :package-version '(lsp-mode . "8.0.0")) - -(defun lsp-racket-language-server-colorize-handler (&rest _args) - "Handler for the colorize notification." - ;; TODO: - nil) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection (lambda () lsp-racket-language-server-path)) - :major-modes '(racket-mode) - :priority -1 - :notification-handlers (ht ("racket/colorize" #'lsp-racket-language-server-colorize-handler)) - :server-id 'racket-language-server)) - -(lsp-consistency-check lsp-racket) - -(provide 'lsp-racket) -;;; lsp-racket.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-remark.el b/elpa/lsp-mode-20220201.852/lsp-remark.el deleted file mode 100644 index 19cdaa7f..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-remark.el +++ /dev/null @@ -1,69 +0,0 @@ -;;; lsp-remark.el --- lsp-mode remark 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 . - -;;; Commentary: - -;; LSP client for remark-language-server - -;;; Code: - -(require 'lsp-mode) - -;;; Markdown -(defgroup lsp-remark nil - "Settings for the markdown language server client." - :group 'lsp-mode - :link '(url-link "https://github.com/remarkjs/remark-language-server") - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-remark-server-command "remark-language-server" - "The binary (or full path to binary) which executes the server." - :type 'string - :group 'lsp-remark - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-remark-server-command-args '("--stdio") - "Command-line arguments for the markdown lsp server." - :type '(repeat 'string) - :group 'lsp-remark - :package-version '(lsp-mode . "8.0.1")) - -(lsp-dependency 'remark-language-server - '(:system "remark-language-server") - '(:npm :package "remark-language-server" - :path "remark-language-server")) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection - (lambda () - (cons (or (executable-find lsp-remark-server-command) - (lsp-package-path 'remark-language-server)) - lsp-remark-server-command-args))) - :activation-fn (lsp-activate-on "markdown") - :initialized-fn (lambda (workspace) - (with-lsp-workspace workspace - (lsp--set-configuration (lsp-configuration-section "remark-language-server")))) - :priority 0 - :server-id 'remark)) - -(lsp-consistency-check lsp-remark) - -(provide 'lsp-remark) -;;; lsp-remark.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-rf.el b/elpa/lsp-mode-20220201.852/lsp-rf.el deleted file mode 100644 index eee0a16b..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-rf.el +++ /dev/null @@ -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 . - -;;; 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/elpa/lsp-mode-20220201.852/lsp-rust.el b/elpa/lsp-mode-20220201.852/lsp-rust.el deleted file mode 100644 index 8ff49561..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-rust.el +++ /dev/null @@ -1,1173 +0,0 @@ -;;; lsp-rust.el --- Rust Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Ivan Yonchovski - -;; Author: Ivan Yonchovski -;; 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 . - -;;; Commentary: - -;; lsp-rust client - -;;; Code: - -(require 'lsp-mode) -(require 'ht) -(require 'dash) - -(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-analyzer/rust-analyzer") - :package-version '(lsp-mode . "8.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 ' -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-blacklist [ - "cocoa" - "gleam" - "glium" - "idna" - "libc" - "openssl" - "rustc_serialize" - "serde" - "serde_json" - "typenum" - "unicode_normalization" - "unicode_segmentation" - "winapi" - ] - "A list of Cargo crates to blacklist." - :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 Cargo features to enable." - :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-analyzer-cargo-target nil - "Compilation target (target triple)." - :type 'string - :group 'lsp-rust-rls - :package-version '(lsp-mode . "8.0.0")) - -(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_blacklist" lsp-rust-crate-blacklist) - ("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)) - :major-modes '(rust-mode rustic-mode) - :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-server-display-inlay-hints nil - "Show inlay hints." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.2")) - -(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-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-chaining-hints nil - "Whether to show inlay type hints for method chains." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.2.2")) - -(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-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 [] - "Cargo watch args." - :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-cargo-all-targets t - "Cargo watch all targets or not." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "6.2.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 . "8.0.1")) - -(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 t - "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-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 nil - "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-merge-behaviour "full" - "The strategy to use when inserting new imports or merging imports. -Valid values are: - - \"none\": No merging - - \"full\": Merge all layers of the import trees - - \"last\": Only merge the last layer of the import trees" - :type '(choice - (const "none") - (const "full") - (const "last")) - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(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-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 'string - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-experimental-proc-attr-macros nil - "Whether to enable experimental support for expanding proc macro attributes." - :type 'boolean - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(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) - :assist (:importMergeBehaviour ,lsp-rust-analyzer-import-merge-behaviour - :importPrefix ,lsp-rust-analyzer-import-prefix - :importGranularity ,lsp-rust-analyzer-import-granularity - :importEnforceGranularity ,(lsp-json-bool lsp-rust-analyzer-import-enforce-granularity) - :importGroup ,(lsp-json-bool lsp-rust-analyzer-import-group)) - :lruCapacity ,lsp-rust-analyzer-lru-capacity - :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-cargo-all-targets) - :overrideCommand ,lsp-rust-analyzer-cargo-override-command) - :files (:exclude ,lsp-rust-analyzer-exclude-globs - :watcher ,(lsp-json-bool (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 - :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) - :inlayHints (:typeHints ,(lsp-json-bool lsp-rust-analyzer-server-display-inlay-hints) - :chainingHints ,(lsp-json-bool lsp-rust-analyzer-display-chaining-hints) - :parameterHints ,(lsp-json-bool lsp-rust-analyzer-display-parameter-hints) - :maxLength ,lsp-rust-analyzer-max-inlay-hint-length) - :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 - :highlighting (:strings ,(lsp-json-bool lsp-rust-analyzer-highlighting-strings)) - :experimental (:procAttrMacros ,(lsp-json-bool lsp-rust-analyzer-experimental-proc-attr-macros)))) - -(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-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 - (format "https://github.com/rust-analyzer/rust-analyzer/releases/latest/download/%s" - (pcase system-type - ('gnu/linux "rust-analyzer-x86_64-unknown-linux-gnu.gz") - ('darwin "rust-analyzer-x86_64-apple-darwin.gz") - ('windows-nt "rust-analyzer-x86_64-pc-windows-msvc.gz"))) - "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" - (if (eq 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 :gzip - :store-path lsp-rust-analyzer-store-path - :set-executable? t) - '(:system "rust-analyzer")) - -(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)) - -(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)))) - :major-modes '(rust-mode rustic-mode) - :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)) - :library-folders-fn (lambda (_workspace) lsp-rust-library-directories) - :after-open-fn (lambda () - (when lsp-rust-analyzer-server-display-inlay-hints - (lsp-rust-analyzer-inlay-hints-mode))) - :ignore-messages nil - :server-id 'rust-analyzer - :custom-capabilities `((experimental . ((snippetTextEdit . ,(and lsp-enable-snippet (featurep 'yasnippet)))))) - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'rust-analyzer callback error-callback)))) - -(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 - -(defvar-local lsp-rust-analyzer-inlay-hints-timer nil) - -(defface lsp-rust-analyzer-inlay-face - '((t :inherit font-lock-comment-face)) - "The face to use for the Rust Analyzer inlays." - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "7.0")) - -(defface lsp-rust-analyzer-inlay-type-face - '((t :inherit lsp-rust-analyzer-inlay-face)) - "Face for inlay type hints (e.g. inferred variable types)." - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-inlay-type-space-format "%s" - "Format string for spacing around variable inlays -\(not part of the inlay face)." - :type '(string :tag "String") - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-inlay-type-format ": %s" - "Format string for variable inlays (part of the inlay face)." - :type '(string :tag "String") - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defface lsp-rust-analyzer-inlay-param-face - '((t :inherit lsp-rust-analyzer-inlay-face)) - "Face for inlay parameter hints (e.g. function parameter names at call-site)." - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-inlay-param-space-format "%s " - "Format string for spacing around parameter inlays -\(not part of the inlay face)." - :type '(string :tag "String") - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-inlay-param-format "%s:" - "Format string for parameter inlays (part of the inlay face)." - :type '(string :tag "String") - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defface lsp-rust-analyzer-inlay-chain-face - '((t :inherit lsp-rust-analyzer-inlay-face)) - "Face for inlay chaining hints (e.g. inferred chain intermediate types)." - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-inlay-chain-space-format "%s" - "Format string for spacing around chain inlays (not part of the inlay face)." - :type '(string :tag "String") - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-rust-analyzer-inlay-chain-format ": %s" - "Format string for chain inlays (part of the inlay face)." - :type '(string :tag "String") - :group 'lsp-rust-analyzer - :package-version '(lsp-mode . "8.0.0")) - -(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")) - -(defun lsp-rust-analyzer-update-inlay-hints (buffer) - (if (and (lsp-rust-analyzer-initialized?) - (eq buffer (current-buffer))) - (lsp-request-async - "rust-analyzer/inlayHints" - (lsp-make-rust-analyzer-inlay-hints-params - :text-document (lsp--text-document-identifier)) - (lambda (res) - (remove-overlays (point-min) (point-max) 'lsp-rust-analyzer-inlay-hint t) - (dolist (hint res) - (-let* (((&rust-analyzer:InlayHint :range :label :kind) hint) - ((&RangeToPoint :start :end) range) - (overlay (make-overlay start end nil 'front-advance 'end-advance))) - (overlay-put overlay 'lsp-rust-analyzer-inlay-hint t) - (overlay-put overlay 'evaporate t) - (cond - ((equal kind lsp/rust-analyzer-inlay-hint-kind-type-hint) - (overlay-put overlay 'after-string - (format lsp-rust-analyzer-inlay-type-space-format - (propertize (format lsp-rust-analyzer-inlay-type-format label) - 'font-lock-face 'lsp-rust-analyzer-inlay-type-face)))) - - ((equal kind lsp/rust-analyzer-inlay-hint-kind-param-hint) - (overlay-put overlay 'before-string - (format lsp-rust-analyzer-inlay-param-space-format - (propertize (format lsp-rust-analyzer-inlay-param-format label) - 'font-lock-face 'lsp-rust-analyzer-inlay-param-face)))) - - ((equal kind lsp/rust-analyzer-inlay-hint-kind-chaining-hint) - (overlay-put overlay 'after-string - (format lsp-rust-analyzer-inlay-chain-space-format - (propertize (format lsp-rust-analyzer-inlay-chain-format label) - 'font-lock-face 'lsp-rust-analyzer-inlay-chain-face)))))))) - :mode 'tick)) - nil) - -(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-inlay-hints-change-handler (&rest _rest) - (when lsp-rust-analyzer-inlay-hints-timer - (cancel-timer lsp-rust-analyzer-inlay-hints-timer)) - (setq lsp-rust-analyzer-inlay-hints-timer - (run-with-idle-timer 0.1 nil #'lsp-rust-analyzer-update-inlay-hints (current-buffer)))) - -(define-minor-mode lsp-rust-analyzer-inlay-hints-mode - "Mode for displaying inlay hints." - :lighter nil - (cond - (lsp-rust-analyzer-inlay-hints-mode - (lsp-rust-analyzer-update-inlay-hints (current-buffer)) - (add-hook 'lsp-on-change-hook #'lsp-rust-analyzer-inlay-hints-change-handler nil t)) - (t - (remove-overlays (point-min) (point-max) 'lsp-rust-analyzer-inlay-hint t) - (remove-hook 'lsp-on-change-hook #'lsp-rust-analyzer-inlay-hints-change-handler t)))) - -(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) - -(defun lsp-rust-analyzer--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 () - (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?) 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 (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 (featurep 'dap-cpptools) - (user-error "You must require `dap-cpptools'")) - (-let (((&rust-analyzer:Runnable - :args (&rust-analyzer:RunnableArgs :cargo-args :workspace-root? :executable-args) - :label) runnable)) - (cl-case (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 "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-analyzer/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)) - (-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-analyzer/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-analyzer/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")) - -(lsp-consistency-check lsp-rust) - -(provide 'lsp-rust) -;;; lsp-rust.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-semantic-tokens.el b/elpa/lsp-mode-20220201.852/lsp-semantic-tokens.el deleted file mode 100644 index 59ba076a..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-semantic-tokens.el +++ /dev/null @@ -1,870 +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 . -;; -;;; 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) - -(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-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 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 lsp-semantic-token-modifier-faces - '(("declaration" . lsp-face-semhl-interface) - ("definition" . lsp-face-semhl-definition) - ("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.") - -(defvar 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-token-modifier-faces)) - [])) - (tokenTypes . ,(apply 'vector (mapcar #'car lsp-semantic-token-faces))) - (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))))) - - -(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 (+ text-property-beg (aref data (+ i 2)))) - (when face - (put-text-property text-property-beg text-property-end 'face face)) - (cl-loop for j from 0 to (1- (length modifier-faces)) do - (when (and (aref modifier-faces j) - (> (logand (aref data (+ i 4)) (lsh 1 j)) 0)) - (add-face-text-property text-property-beg text-property-end - (aref modifier-faces j)))) - 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 - (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--replace-alist-values (a b) - "Replace alist A values with B ones where available." - (-map - (-lambda ((ak . av)) - (cons ak (alist-get ak b av nil #'string=))) - a)) - -(defun lsp-semantic-tokens--type-faces-for (client) - "Return the semantic token type faces for CLIENT." - (lsp-semantic-tokens--replace-alist-values lsp-semantic-token-faces - (plist-get (lsp--client-semantic-tokens-faces-overrides client) :types))) - -(defun lsp-semantic-tokens--modifier-faces-for (client) - "Return the semantic token type faces for CLIENT." - (lsp-semantic-tokens--replace-alist-values lsp-semantic-token-modifier-faces - (plist-get (lsp--client-semantic-tokens-faces-overrides client) :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/semanticTokens")) - (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 - (lsp-semantic-tokens-mode - (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/semanticTokens")) - (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 '()) - (defadvice lsp-semantic-tokens--fontify (around advice-tokens-fontify activate) - (lsp-semantic-tokens--log-buffer-contents 'before) - (let ((result ad-do-it)) - (lsp-semantic-tokens--log-buffer-contents 'after) - result)) - (defadvice lsp--semantic-tokens-ingest-full/delta-response - (before log-delta-response (response) activate) - (setq lsp-semantic-tokens--prev-response `(:request-type "delta" - :response ,response - :version ,lsp--cur-version))) - (defadvice lsp--semantic-tokens-ingest-full-response - (before log-full-response (response) activate) - (setq lsp-semantic-tokens--prev-response `(:request-type "full" - :response ,response - :version ,lsp--cur-version))) - (defadvice lsp--semantic-tokens-ingest-range-response - (before log-range-response (response) activate) - (setq lsp-semantic-tokens--prev-response `(:request-type "range" - :response ,response - :version ,lsp--cur-version)))) - -(defun lsp-semantic-tokens-disable-log () - "Disable logging of intermediate fontification states." - (ad-unadvise 'lsp-semantic-tokens--fontify) - (ad-unadvise 'lsp--semantic-tokens-ingest-full/delta-response) - (ad-unadvise 'lsp--semantic-tokens-ingest-full-response) - (ad-unadvise 'lsp--semantic-tokens-ingest-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/elpa/lsp-mode-20220201.852/lsp-solargraph.el b/elpa/lsp-mode-20220201.852/lsp-solargraph.el deleted file mode 100644 index 968b32ad..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-solargraph.el +++ /dev/null @@ -1,166 +0,0 @@ -;;; lsp-solargraph.el --- Solargraph server configuration -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Ivan Yonchovski - -;; Author: Ivan Yonchovski -;; 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 . - -;;; Commentary: - -;; - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-solargraph nil - "LSP support for Ruby, using the Solargraph language server." - :group 'lsp-mode - :link '(url-link "https://github.com/castwide/solargraph") - :package-version '(lsp-mode . "6.1")) - -;; (defcustom lsp-solargraph-check-gem-version t -;; "Automatically check if a new version of the Solargraph gem is available." -;; :type 'boolean) - -(defcustom lsp-solargraph-completion t - "Enable completion" - :type 'boolean - :group 'lsp-solargraph - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-solargraph-hover t - "Enable hover" - :type 'boolean - :group 'lsp-solargraph - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-solargraph-diagnostics t - "Enable diagnostics" - :type 'boolean - :group 'lsp-solargraph - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-solargraph-autoformat nil - "Enable automatic formatting while typing (WARNING: experimental)" - :type 'boolean - :group 'lsp-solargraph - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-solargraph-formatting t - "Enable document formatting" - :type 'boolean - :group 'lsp-solargraph - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-solargraph-symbols t - "Enable symbols" - :type 'boolean - :group 'lsp-solargraph - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-solargraph-definitions t - "Enable definitions (go to, etc.)" - :type 'boolean - :group 'lsp-solargraph - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-solargraph-rename t - "Enable symbol renaming" - :type 'boolean - :group 'lsp-solargraph - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-solargraph-references t - "Enable finding references" - :type 'boolean - :group 'lsp-solargraph - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-solargraph-folding t - "Enable folding ranges" - :type 'boolean - :group 'lsp-solargraph - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-solargraph-log-level "warn" - "Level of debug info to log. `warn` is least and `debug` is most." - :type '(choice (const :tag "warn" "info" "debug")) - :group 'lsp-solargraph - :package-version '(lsp-mode . "6.1")) - -;; https://github.com/castwide/solargraph#solargraph-and-bundler -(defcustom lsp-solargraph-use-bundler nil - "Run solargraph under bundler" - :type 'boolean - :safe #'booleanp - :group 'lsp-solargraph - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-solargraph-multi-root t - "If non nil, `solargraph' will be started in multi-root mode." - :type 'boolean - :safe #'booleanp - :group 'lsp-solargraph - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-solargraph-library-directories - '("~/.rbenv/" "/usr/lib/ruby/" "~/.rvm/" "~/.gem/") - "List of directories which will be considered to be libraries." - :type '(repeat string) - :group 'lsp-solargraph - :package-version '(lsp-mode . "7.0.1")) - -(defun lsp-solargraph--build-command () - "Build solargraph command" - (let ((lsp-command '("solargraph" "stdio"))) - (if lsp-solargraph-use-bundler - (append '("bundle" "exec") lsp-command) - lsp-command))) - -(lsp-register-custom-settings - '(("solargraph.logLevel" lsp-solargraph-log-level) - ("solargraph.folding" lsp-solargraph-folding t) - ("solargraph.references" lsp-solargraph-references t) - ("solargraph.rename" lsp-solargraph-rename t) - ("solargraph.definitions" lsp-solargraph-definitions t) - ("solargraph.symbols" lsp-solargraph-symbols t) - ("solargraph.formatting" lsp-solargraph-formatting t) - ("solargraph.autoformat" lsp-solargraph-autoformat t) - ("solargraph.diagnostics" lsp-solargraph-diagnostics t) - ("solargraph.hover" lsp-solargraph-hover t) - ("solargraph.completion" lsp-solargraph-completion t) - ("solargraph.useBundler" lsp-solargraph-use-bundler t))) - -;; Ruby -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection - #'lsp-solargraph--build-command) - :major-modes '(ruby-mode enh-ruby-mode) - :priority -1 - :multi-root lsp-solargraph-multi-root - :library-folders-fn (lambda (_workspace) lsp-solargraph-library-directories) - :server-id 'ruby-ls - :initialized-fn (lambda (workspace) - (with-lsp-workspace workspace - (lsp--set-configuration - (lsp-configuration-section "solargraph")))))) - -(lsp-consistency-check lsp-solargraph) - -(provide 'lsp-solargraph) -;;; lsp-solargraph.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-sorbet.el b/elpa/lsp-mode-20220201.852/lsp-sorbet.el deleted file mode 100644 index 58040a76..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-sorbet.el +++ /dev/null @@ -1,59 +0,0 @@ -;;; lsp-sorbet.el --- Sorbet server configuration -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 - -;; Author: Christopher Wilson -;; 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 . - -;;; Commentary: - -;; lsp-sorbet client - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-sorbet nil - "LSP support for Ruby, using the Sorbet language server." - :group 'lsp-mode - :link '(url-link "https://github.com/sorbet/sorbet") - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-sorbet-use-bundler nil - "Run sorbet under bundler" - :type 'boolean - :group 'lsp-sorbet - :package-version '(lsp-mode . "8.0.0")) - -(defun lsp-sorbet--build-command () - "Build sorbet command" - (let ((lsp-command '("srb" "typecheck" "--lsp" "--disable-watchman"))) - (if lsp-sorbet-use-bundler - (append '("bundle" "exec") lsp-command) - lsp-command))) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection - #'lsp-sorbet--build-command) - :priority -2 - :major-modes '(ruby-mode enh-ruby-mode) - :server-id 'sorbet-ls)) - -(lsp-consistency-check lsp-sorbet) - -(provide 'lsp-sorbet) -;;; lsp-sorbet.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-sqls.el b/elpa/lsp-mode-20220201.852/lsp-sqls.el deleted file mode 100644 index bd693722..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-sqls.el +++ /dev/null @@ -1,190 +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 . - -;;; 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/lighttiger2505/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-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 -1 - :action-handlers (ht ("executeQuery" #'lsp-sql-execute-query) - ("showDatabases" #'lsp-sql-show-databases) - ("showSchemas" #'lsp-sql-show-schemas) - ("showConnections" #'lsp-sql-show-connections) - ("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/elpa/lsp-mode-20220201.852/lsp-steep.el b/elpa/lsp-mode-20220201.852/lsp-steep.el deleted file mode 100644 index 54d50ef2..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-steep.el +++ /dev/null @@ -1,73 +0,0 @@ -;;; lsp-steep.el --- lsp-mode for Steep -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 Masafumi Koba - -;; Author: Masafumi Koba -;; 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 . - -;;; Commentary: - -;; LSP client for Steep which is a Ruby type checker. - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-steep nil - "LSP support for Steep, using the Steep language server." - :group 'lsp-mode - :link '(url-link "https://github.com/soutaro/steep")) - -(defcustom lsp-steep-log-level "warn" - "Log level of Steep." - :type '(choice - (const "fatal") - (const "error") - (const "warn") - (const "info") - (const "debug")) - :group 'lsp-steep) - -(defcustom lsp-steep-use-bundler t - "Run Steep using Bunder." - :type 'boolean - :safe #'booleanp - :group 'lsp-steep) - -(defcustom lsp-steep-server-path nil - "Path of the Steep language server executable. -If specified, `lsp-steep-use-bundler' is ignored." - :type 'file - :group 'lsp-steep - :package-version '(lsp-mode . "8.0.0")) - -(defun lsp-steep--build-command () - "Build a command to start the Steep language server." - (append - (if (and lsp-steep-use-bundler (not lsp-steep-server-path)) '("bundle" "exec")) - (list (or lsp-steep-server-path "steep") "langserver" "--log-level" lsp-steep-log-level))) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection #'lsp-steep--build-command) - :major-modes '(ruby-mode enh-ruby-mode) - :priority -3 - :server-id 'steep-ls)) - -(lsp-consistency-check lsp-steep) - -(provide 'lsp-steep) -;;; lsp-steep.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-svelte.el b/elpa/lsp-mode-20220201.852/lsp-svelte.el deleted file mode 100644 index 723b8fc0..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-svelte.el +++ /dev/null @@ -1,307 +0,0 @@ -;;; lsp-svelte.el --- LSP Svelte integration -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 Stepan Lusnikov - -;; Author: Stepan Lusnikov -;; Keywords: lsp svelte - -;; 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 . - -;;; Commentary: - -;; LSP client for Svelte - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-svelte nil - "LSP support for Svelte." - :group 'lsp-mode - :link '(url-link - "https://github.com/sveltejs/language-tools")) - -(lsp-dependency 'svelte-language-server - '(:system "svelteserver") - '(:npm :package "svelte-language-server" - :path "svelteserver")) - -(defcustom lsp-svelte-plugin-typescript-enable t - "Enable the TypeScript plugin" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-typescript-diagnostics-enable t - "Enable diagnostic messages for TypeScript" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-typescript-hover-enable t - "Enable hover info for TypeScript" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-typescript-document-symbols-enable t - "Enable document symbols for TypeScript" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-typescript-completions-enable t - "Enable completions for TypeScript" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-typescript-find-references-enable t - "Enable find-references for TypeScript" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-typescript-definitions-enable t - "Enable go to definition for TypeScript" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-typescript-code-actions-enable t - "Enable code actions for TypeScript" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-typescript-selection-range-enable t - "Enable selection range for TypeScript" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-typescript-signature-help-enable t - "Enable signature help (parameter hints) for TypeScript" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-typescript-rename-enable t - "Enable rename functionality for JS/TS variables inside Svelte files" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-css-enable t - "Enable the CSS plugin" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-css-globals "" - "Which css files should be checked for global variables -(`--global-var: value;`). - -These variables are added to the css completions. String of comma-separated -file paths or globs relative to workspace root." - :type 'string - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-css-diagnostics-enable t - "Enable diagnostic messages for CSS" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-css-hover-enable t - "Enable hover info for CSS" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-css-completions-enable t - "Enable auto completions for CSS" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-css-completions-emmet t - "Enable emmet auto completions for CSS" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-css-document-colors-enable t - "Enable document colors for CSS" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-css-color-presentations-enable t - "Enable color picker for CSS" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-css-document-symbols-enable t - "Enable document symbols for CSS" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-css-selection-range-enable t - "Enable selection range for CSS" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-html-enable t - "Enable the HTML plugin" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-html-hover-enable t - "Enable hover info for HTML" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-html-completions-enable t - "Enable auto completions for HTML" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-html-completions-emmet t - "Enable emmet auto completions for HTML" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-html-tag-complete-enable t - "Enable HTML tag auto closing" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-html-document-symbols-enable t - "Enable document symbols for HTML" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-svelte-enable t - "Enable the Svelte plugin" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-svelte-diagnostics-enable t - "Enable diagnostic messages for Svelte" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-svelte-compiler-warnings nil - "Svelte compiler warning codes to ignore or to treat as errors. -Example: '((css-unused-selector . ignore) (unused-export-let . error))" - :type '(alist :key-type (symbol :tag "Warning code") - :value-type (choice - (const :tag "Ignore" ignore) - (const :tag "Treat as error" error))) - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-svelte-format-enable t - "Enable formatting for Svelte (includes css & js)" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-svelte-completions-enable t - "Enable auto completions for Svelte" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-svelte-hover-enable t - "Enable hover information for Svelte" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-svelte-code-actions-enable t - "Enable Code Actions for Svelte" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-svelte-selection-range-enable t - "Enable selection range for Svelte" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-svelte-plugin-svelte-rename-enable t - "Enable rename/move Svelte files functionality" - :type 'boolean - :package-version '(lsp-mode . "8.0.0")) - -(lsp-register-custom-settings - '(("svelte.plugin.svelte.rename.enable" lsp-svelte-plugin-svelte-rename-enable t) - ("svelte.plugin.svelte.selectionRange.enable" lsp-svelte-plugin-svelte-selection-range-enable t) - ("svelte.plugin.svelte.codeActions.enable" lsp-svelte-plugin-svelte-code-actions-enable t) - ("svelte.plugin.svelte.hover.enable" lsp-svelte-plugin-svelte-hover-enable t) - ("svelte.plugin.svelte.completions.enable" lsp-svelte-plugin-svelte-completions-enable t) - ("svelte.plugin.svelte.format.enable" lsp-svelte-plugin-svelte-format-enable t) - ("svelte.plugin.svelte.compilerWarnings" lsp-svelte-plugin-svelte-compiler-warnings) - ("svelte.plugin.svelte.diagnostics.enable" lsp-svelte-plugin-svelte-diagnostics-enable t) - ("svelte.plugin.svelte.enable" lsp-svelte-plugin-svelte-enable t) - ("svelte.plugin.html.documentSymbols.enable" lsp-svelte-plugin-html-document-symbols-enable t) - ("svelte.plugin.html.tagComplete.enable" lsp-svelte-plugin-html-tag-complete-enable t) - ("svelte.plugin.html.completions.emmet" lsp-svelte-plugin-html-completions-emmet t) - ("svelte.plugin.html.completions.enable" lsp-svelte-plugin-html-completions-enable t) - ("svelte.plugin.html.hover.enable" lsp-svelte-plugin-html-hover-enable t) - ("svelte.plugin.html.enable" lsp-svelte-plugin-html-enable t) - ("svelte.plugin.css.selectionRange.enable" lsp-svelte-plugin-css-selection-range-enable t) - ("svelte.plugin.css.documentSymbols.enable" lsp-svelte-plugin-css-document-symbols-enable t) - ("svelte.plugin.css.colorPresentations.enable" lsp-svelte-plugin-css-color-presentations-enable t) - ("svelte.plugin.css.documentColors.enable" lsp-svelte-plugin-css-document-colors-enable t) - ("svelte.plugin.css.completions.emmet" lsp-svelte-plugin-css-completions-emmet t) - ("svelte.plugin.css.completions.enable" lsp-svelte-plugin-css-completions-enable t) - ("svelte.plugin.css.hover.enable" lsp-svelte-plugin-css-hover-enable t) - ("svelte.plugin.css.diagnostics.enable" lsp-svelte-plugin-css-diagnostics-enable t) - ("svelte.plugin.css.globals" lsp-svelte-plugin-css-globals) - ("svelte.plugin.css.enable" lsp-svelte-plugin-css-enable t) - ("svelte.plugin.typescript.rename.enable" lsp-svelte-plugin-typescript-rename-enable t) - ("svelte.plugin.typescript.signatureHelp.enable" lsp-svelte-plugin-typescript-signature-help-enable t) - ("svelte.plugin.typescript.selectionRange.enable" lsp-svelte-plugin-typescript-selection-range-enable t) - ("svelte.plugin.typescript.codeActions.enable" lsp-svelte-plugin-typescript-code-actions-enable t) - ("svelte.plugin.typescript.definitions.enable" lsp-svelte-plugin-typescript-definitions-enable t) - ("svelte.plugin.typescript.findReferences.enable" lsp-svelte-plugin-typescript-find-references-enable t) - ("svelte.plugin.typescript.completions.enable" lsp-svelte-plugin-typescript-completions-enable t) - ("svelte.plugin.typescript.documentSymbols.enable" lsp-svelte-plugin-typescript-document-symbols-enable t) - ("svelte.plugin.typescript.hover.enable" lsp-svelte-plugin-typescript-hover-enable t) - ("svelte.plugin.typescript.diagnostics.enable" lsp-svelte-plugin-typescript-diagnostics-enable t) - ("svelte.plugin.typescript.enable" lsp-svelte-plugin-typescript-enable t))) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection - (lambda () - `(,(lsp-package-path 'svelte-language-server) - "--stdio"))) - :activation-fn (lambda (file-name _mode) - (string= (f-ext file-name) - "svelte")) - :initialization-options - (lambda () - (list :config (ht-get* (lsp-configuration-section "svelte.plugin") - "svelte" - "plugin") - :prettierConfig (lsp-configuration-section "prettier") - :emmetConfig (lsp-configuration-section "emmet") - :typescriptConfig: (list :typescript (lsp-configuration-section "typescript") - :javascript (lsp-configuration-section "javascript")) - :dontFilterIncompleteCompletions t)) - :server-id 'svelte-ls - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'svelte-language-server callback error-callback)) - :initialized-fn - (lambda (workspace) - (with-lsp-workspace workspace - (lsp--set-configuration - (ht-merge (lsp-configuration-section "svelte") - (lsp-configuration-section "javascript") - (lsp-configuration-section "typescript"))) - (lsp--server-register-capability - (lsp-make-registration - :id "js/ts/id" - :method "workspace/didChangeWatchedFiles" - :register-options? (lsp-make-did-change-watched-files-registration-options - :watchers - (vector (lsp-make-file-system-watcher :glob-pattern "**/*.js") - (lsp-make-file-system-watcher :glob-pattern "**/*.ts"))))))))) - -(lsp-consistency-check lsp-svelte) - -(provide 'lsp-svelte) -;;; lsp-svelte.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-terraform.el b/elpa/lsp-mode-20220201.852/lsp-terraform.el deleted file mode 100644 index 0d7d4290..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-terraform.el +++ /dev/null @@ -1,99 +0,0 @@ -;;; lsp-terraform.el --- Terraform Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Ross Donaldson - -;; Author: Ross Donaldson -;; Keywords: terraform 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 . - -;;; Commentary: - -;; LSP client for Terraform - -;;; Code: - -(require 'lsp-mode) - - -;; terraform-lsp - -(defgroup lsp-terraform nil - "LSP support for Terraform, using terraform-lsp" - :group 'lsp-mode - :link '(url-link "https://github.com/juliosueiras/terraform-lsp") - :package-version `(lsp-mode . "6.2")) - -(defcustom lsp-terraform-server "terraform-lsp" - "Path to the `terraform-lsp' binary." - :group 'lsp-terraform - :risky t - :type '(choice - (file :tag "File") - (repeat string)) - :package-version `(lsp-mode . "6.2")) - -(defcustom lsp-terraform-enable-logging nil - "If non-nil, enable `terraform-ls''s native logging." - :group 'lsp-terraform - :risky t - :type 'boolean - :package-version `(lsp-mode . "6.2")) - - -(defun lsp-terraform--make-launch-cmd () - (-let [base (if (stringp lsp-terraform-server) - `(,lsp-terraform-server) - lsp-terraform-server)] - (when lsp-terraform-enable-logging - (push "-enable-log-file" base)) - base)) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection #'lsp-terraform--make-launch-cmd) - :major-modes '(terraform-mode) - :priority -1 - :server-id 'tfls)) - - -;; terraform-ls - -(defgroup lsp-terraform-ls nil - "LSP support for Terraform, using terraform-ls from Hashicorp." - :group 'lsp-mode - :link '(url-link "https://github.com/hashicorp/terraform-ls") - :package-version `(lsp-mode . "8.0.1")) - -(defcustom lsp-terraform-ls-server "terraform-ls" - "Path to the `terraform-ls' binary." - :group 'lsp-terraform-ls - :risky t - :type '(choice - (file :tag "File") - (repeat string)) - :package-version `(lsp-mode . "8.0.1")) - -(defun lsp-terraform-ls--make-launch-cmd () - `(,lsp-terraform-ls-server "serve")) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection #'lsp-terraform-ls--make-launch-cmd) - :major-modes '(terraform-mode) - :priority 1 - :server-id 'tfmls)) - -(lsp-consistency-check lsp-terraform) - -(provide 'lsp-terraform) -;;; lsp-terraform.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-tex.el b/elpa/lsp-mode-20220201.852/lsp-tex.el deleted file mode 100644 index 3cd6d083..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-tex.el +++ /dev/null @@ -1,68 +0,0 @@ -;;; lsp-tex.el --- description -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 emacs-lsp maintainers - -;; Author: emacs-lsp maintainers -;; Keywords: lsp, tex - -;; 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 . - -;;; Commentary: - -;; LSP Clients for the Tex Typesetting Language. - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-tex nil - "LSP support for TeX and friends, using Digestif and texlab." - :group 'lsp-mode - :link '(url-link "https://github.com/astoff/digestif/") - :link '(url-link "https://github.com/latex-lsp/texlab")) - -(defcustom lsp-tex-server 'texlab - "Choose LSP tex server." - :type '(choice (const :tag "texlab" texlab) - (const :tag "digestif" digestif)) - :group 'lsp-tex) - -(defcustom lsp-clients-digestif-executable "digestif" - "Command to start the Digestif language server." - :group 'lsp-tex - :risky t - :type 'file) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection lsp-clients-digestif-executable) - :major-modes '(plain-tex-mode latex-mode context-mode texinfo-mode) - :priority (if (eq lsp-tex-server 'digestif) 1 -1) - :server-id 'digestif)) - -(defcustom lsp-clients-texlab-executable "texlab" - "Command to start the texlab language server." - :group 'lsp-tex - :risky t - :type 'file) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection lsp-clients-texlab-executable) - :major-modes '(plain-tex-mode latex-mode) - :priority (if (eq lsp-tex-server 'texlab) 1 -1) - :server-id 'texlab)) - -(lsp-consistency-check lsp-tex) - -(provide 'lsp-tex) -;;; lsp-tex.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-toml.el b/elpa/lsp-mode-20220201.852/lsp-toml.el deleted file mode 100644 index cef88133..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-toml.el +++ /dev/null @@ -1,258 +0,0 @@ -;;; lsp-toml.el --- lsp-mode TOML integration -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 Taiki Sugawara - -;; Author: Taiki Sugawara -;; Keywords: lsp, toml - -;; 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 . - -;;; Commentary: - -;; Client for taplo-lsp. - -;;; Code: - -(require 'lsp-mode) -(require 'ht) -(require 'f) - -(defgroup lsp-toml nil - "LSP support for TOML, using taplo-lsp." - :group 'lsp-mode - :link '(url-link "https://taplo.tamasfe.dev/lsp/")) - -(defcustom lsp-toml-command "taplo-lsp" - "Path to taplo-lsp command." - :type 'string - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-cache-path (expand-file-name - (locate-user-emacs-file (f-join ".cache" "lsp-toml"))) - "Path to cache." - :type 'string - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - - -(defcustom lsp-toml-taplo-config nil - "An absolute, or workspace relative path to the Taplo configuration file." - :type 'file - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-taplo-config-enabled t - "Whether to enable the usage of a Taplo configuration file." - :type 'boolean - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - - -(defcustom lsp-toml-schema-enabled t - "Enable completion and validation based on JSON schemas." - :type 'boolean - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-schema-links nil - "Enable editor links." - :type 'boolean - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-schema-repository-enabled t - "Whether to use schemas from the provided schema repository." - :type 'boolean - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-schema-repository-url "https://taplo.tamasfe.dev/schema_index.json" - "A HTTP(S) URL that points to a schema index." - :type 'string - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-schema-associations - `((,(make-symbol "^(.*(/|\\\\)\\.?taplo\\.toml|\\.?taplo\\.toml)$") . "taplo://taplo.toml")) - "Document and schema associations." - :type '(alist :key-type symbol :value-type string) - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - - -(defcustom lsp-toml-formatter-align-entries nil - "Align consecutive entries vertically." - :type 'boolean - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-formatter-align-comments t - "Align comments vertically after entries and array values." - :type 'boolean - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-formatter-array-trailing-comma t - "Append trailing commas for multi-line arrays." - :type 'boolean - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-formatter-array-auto-expand t - "Expand arrays to multiple lines that exceed the maximum column width." - :type 'boolean - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-formatter-array-auto-collapse t - "Collapse arrays that don't exceed the maximum column width and -don't contain comments." - :type 'boolean - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-formatter-compact-arrays t - "Omit white space padding from single-line arrays." - :type 'boolean - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-formatter-compact-inline-tables nil - "Omit white space padding from the start and end of inline tables." - :type 'boolean - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-formatter-compact-entries nil - "Omit white space padding around `=` for entries." - :type 'boolean - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-formatter-column-width 80 - "Maximum column width in characters, affects array expansion -and collapse, this doesn't take whitespace into account." - :type 'number - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-formatter-indent-tables nil - "Indent based on tables and arrays of tables and their -subtables, subtables out of order are not indented." - :type 'boolean - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-formatter-indent-entries nil - "Indent entries under tables." - :type 'boolean - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-formatter-indent-string nil - "The substring that is used for indentation, should be tabs or -spaces, but technically can be anything. Uses the IDE setting if -not set." - :type '(repeat string) - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-formatter-reorder-keys nil - "Alphabetically reorder keys that are not separated by empty lines." - :type 'boolean - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-formatter-allowed-blank-lines 2 - "Maximum amount of allowed consecutive blank lines. -This does not affect the whitespace at the end of the document, -as it is always stripped." - :type 'number - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-formatter-trailing-newline t - "Add trailing newline at the end of the file if not present." - :type 'boolean - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-toml-formatter-crlf nil - "Use CRLF for line endings." - :type 'boolean - :group 'lsp-toml - :package-version '(lsp-mode . "8.0.1")) - - -(lsp-register-custom-settings - '( - ("evenBetterToml.taploConfig" lsp-toml-taplo-config) - ("evenBetterToml.taploConfigEnabled" lsp-toml-taplo-config-enabled t) - - ("evenBetterToml.schema.enabled" lsp-toml-schema-enabled t) - ("evenBetterToml.schema.links" lsp-toml-schema-links t) - ("evenBetterToml.schema.repositoryEnabled" lsp-toml-schema-repository-enabled t) - ("evenBetterToml.schema.repositoryUrl" lsp-toml-schema-repository-url) - ("evenBetterToml.schema.associations" lsp-toml-schema-associations) - - ("evenBetterToml.formatter.alignEntries" lsp-toml-formatter-align-entries t) - ("evenBetterToml.formatter.alignComments" lsp-toml-formatter-align-comments t) - ("evenBetterToml.formatter.arrayTrailingComma" lsp-toml-formatter-array-trailing-comma t) - ("evenBetterToml.formatter.arrayAutoExpand" lsp-toml-formatter-array-auto-expand t) - ("evenBetterToml.formatter.arrayAutoCollapse" lsp-toml-formatter-array-auto-collapse t) - ("evenBetterToml.formatter.compactArrays" lsp-toml-formatter-compact-arrays t) - ("evenBetterToml.formatter.compactInlineTables" lsp-toml-formatter-compact-inline-tables t) - ("evenBetterToml.formatter.compactEntries" lsp-toml-formatter-compact-entries t) - ("evenBetterToml.formatter.columnWidth" lsp-toml-formatter-column-width) - ("evenBetterToml.formatter.indentTables" lsp-toml-formatter-indent-tables t) - ("evenBetterToml.formatter.indentEntries" lsp-toml-formatter-indent-entries t) - ("evenBetterToml.formatter.indentString" lsp-toml-formatter-indent-string) - ("evenBetterToml.formatter.reorderKeys" lsp-toml-formatter-reorder-keys t) - ("evenBetterToml.formatter.allowedBlankLines" lsp-toml-formatter-allowed-blank-lines) - ("evenBetterToml.formatter.trailingNewline" lsp-toml-formatter-trailing-newline t) - ("evenBetterToml.formatter.crlf" lsp-toml-formatter-crlf t))) - - -(defun lsp-toml--initialized (workspace) - (with-lsp-workspace workspace - (lsp--set-configuration (lsp-configuration-section "evenBetterToml")) - (lsp-notify "taplo/cachePath" `(:path ,lsp-toml-cache-path)))) - -(defun lsp-toml--initialization-options () - (list :configuration (ht-get (lsp-configuration-section "evenBetterToml") "evenBetterToml"))) - -(defun lsp-toml--message-with-output (_workspace params) - (funcall (pcase (ht-get params "kind") - ("error" 'lsp--error) - ("warn" 'lsp--warn) - ("info" 'lsp--info) - (_ 'lsp--info)) - "lsp-toml: %s" - (ht-get params "message"))) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection (lambda () (list lsp-toml-command "run"))) - :activation-fn (lsp-activate-on "toml") - :initialized-fn #'lsp-toml--initialized - :initialization-options #'lsp-toml--initialization-options - :notification-handlers (ht ("taplo/messageWithOutput" #'lsp-toml--message-with-output)) - :server-id 'taplo-lsp - :priority -1)) - -(lsp-consistency-check lsp-toml) - -(provide 'lsp-toml) -;;; lsp-toml.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-v.el b/elpa/lsp-mode-20220201.852/lsp-v.el deleted file mode 100644 index a809a07e..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-v.el +++ /dev/null @@ -1,50 +0,0 @@ -;;; lsp-v.el --- lsp-mode V integration -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 remimimimi - -;; Author: remimimimi -;; 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 . - -;;; Commentary: - -;; client for vls, the V language server - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-v nil - "LSP support for V via vls." - :group 'lsp-mode - :link '(url-link "https://github.com/vlang/vls/tree/master")) - -(defcustom lsp-v-vls-executable "vls" - "The vls executable to use. -Leave as just the executable name to use the default behavior of -finding the executable with variable `exec-path'." - :group 'lsp-v - :type 'string) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection (lambda () lsp-v-vls-executable)) - :activation-fn (lsp-activate-on "V") - :server-id 'v-ls)) - -(lsp-consistency-check lsp-v) - -(provide 'lsp-v) -;;; lsp-v.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-vala.el b/elpa/lsp-mode-20220201.852/lsp-vala.el deleted file mode 100644 index 479743ba..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-vala.el +++ /dev/null @@ -1,51 +0,0 @@ -;;; lsp-vala.el --- Vala Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2020 Daniel Svensson - -;; Author: Daniel Svensson -;; Keywords: vala 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 . - -;;; Commentary: - -;; LSP client for Vala - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-vala nil - "LSP support for Vala, using vala-language-server" - :group 'lsp-mode - :link '(url-link "https://github.com/benwaffle/vala-language-server") - :package-version `(lsp-mode . "8.0.0")) - -(defcustom lsp-clients-vala-ls-executable "vala-language-server" - "Path to the `vala-language-server' binary." - :group 'lsp-vala - :risky t - :type 'file - :package-version `(lsp-mode . "8.0.0")) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection (lambda () lsp-clients-vala-ls-executable)) - :major-modes '(vala-mode) - :priority -1 - :server-id 'valals)) - -(lsp-consistency-check lsp-vala) - -(provide 'lsp-vala) -;;; lsp-vala.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-verilog.el b/elpa/lsp-mode-20220201.852/lsp-verilog.el deleted file mode 100644 index 3f9ba419..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-verilog.el +++ /dev/null @@ -1,186 +0,0 @@ -;;; lsp-verilog.el --- Verilog Client settings -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Patrick Grogan - -;; Author: Patrick Grogan -;; Created: 7 December 2019 -;; Keywords: languages, lsp, verilog - -;; 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 . - -;;; Commentary: -;; LSP client support for Verilog/SystemVerilog. Two language servers -;; are available: -;; 1) HDL Checker. See https://github.com/suoto/hdl_checker -;; 2) SVLangserver. See https://github.com/imc-trading/svlangserver -;; -;; This file is based on the lsp-vhdl.el file. -;; - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-svlangserver nil - "Settings for the SystemVerilog language server client." - :group 'lsp-mode - :link '(url-link "https://github.com/imc-trading/svlangserver") - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-clients-svlangserver-includeIndexing '["**/*.{sv,svh}"] - "Files included for indexing (glob pattern)" - :group 'lsp-svlangserver - :type '(lsp-repeatable-vector string) - :safe (lambda (x) (seq-every-p #'stringp x))) - -(defcustom lsp-clients-svlangserver-excludeIndexing '["test/**/*.{sv,svh}"] - "Files excluded for indexing (glob pattern)" - :group 'lsp-svlangserver - :type '(lsp-repeatable-vector string) - :safe (lambda (x) (seq-every-p #'stringp x))) - -(defcustom lsp-clients-svlangserver-defines nil - "Defines needed for linting" - :group 'lsp-svlangserver - :type '(lsp-repeatable-vector string) - :safe (lambda (x) (seq-every-p #'stringp x))) - -(defcustom lsp-clients-svlangserver-launchConfiguration "verilator -sv --lint-only -Wall" - "Verilator command used for linting" - :group 'lsp-svlangserver - :type 'string - :safe (lambda (x) (stringp x))) - -(defcustom lsp-clients-svlangserver-lintOnUnsaved t - "Enable linting on unsaved files" - :group 'lsp-svlangserver - :type 'boolean - :safe (lambda (x) (booleanp x))) - -(defcustom lsp-clients-svlangserver-formatCommand "verible-verilog-format" - "Verible verilog format command" - :group 'lsp-svlangserver - :type 'string - :safe (lambda (x) (stringp x))) - -(defcustom lsp-clients-svlangserver-disableCompletionProvider nil - "Disable auto completion provided by the language server" - :group 'lsp-svlangserver - :type 'boolean - :safe (lambda (x) (booleanp x))) - -(defcustom lsp-clients-svlangserver-disableHoverProvider nil - "Disable hover over help provided by the language server" - :group 'lsp-svlangserver - :type 'boolean - :safe (lambda (x) (booleanp x))) - -(defcustom lsp-clients-svlangserver-disableSignatureHelpProvider nil - "Disable signature help provided by the language server" - :group 'lsp-svlangserver - :type 'boolean - :safe (lambda (x) (booleanp x))) - -(defcustom lsp-clients-svlangserver-disableLinting nil - "Disable verilator linting" - :group 'lsp-svlangserver - :type 'boolean - :safe (lambda (x) (booleanp x))) - -(defcustom lsp-clients-svlangserver-workspace-additional-dirs nil - "Additional directories to be managed by this instance of svlangserver" - :group 'lsp-svlangserver - :type '(lsp-repeatable-vector string) - :safe (lambda (x) (seq-every-p #'stringp x))) - -(defcustom lsp-clients-svlangserver-bin-path "svlangserver" - "svlangserver binary path" - :group 'lsp-svlangserver - :type 'string - :safe (lambda (x) (stringp x))) - -(defcustom lsp-clients-svlangserver-bin-args nil - "command line arguments for svlangserver binary" - :group 'lsp-svlangserver - :type '(lsp-repeatable-vector string) - :safe (lambda (x) (seq-every-p #'stringp x))) - -(defcustom lsp-clients-svlangserver-node-command "node" - "node binary path" - :group 'lsp-svlangserver - :type 'string - :safe (lambda (x) (stringp x))) - -(defcustom lsp-clients-svlangserver-module-path "svlangserver.js" - "svlangserver module path" - :group 'lsp-svlangserver - :type 'string - :safe (lambda (x) (stringp x))) - -(lsp-dependency 'svlangserver - '(:system "svlangserver")) - -(defun lsp-clients-svlangserver-get-workspace-additional-dirs (_workspace) - lsp-clients-svlangserver-workspace-additional-dirs) - -(defun lsp-clients-svlangserver-command () - (let ((svlangserver-bin-path (lsp-package-path 'svlangserver))) - (if svlangserver-bin-path - (cons svlangserver-bin-path lsp-clients-svlangserver-bin-args) - (if (file-exists-p lsp-clients-svlangserver-bin-path) - (cons lsp-clients-svlangserver-bin-path lsp-clients-svlangserver-bin-args) - (if (file-exists-p lsp-clients-svlangserver-module-path) - `(,lsp-clients-svlangserver-node-command ,lsp-clients-svlangserver-module-path ,"--stdio") - `(,"svlangserver")))))) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection 'lsp-clients-svlangserver-command) - :major-modes '(verilog-mode) - :priority -1 - :library-folders-fn 'lsp-clients-svlangserver-get-workspace-additional-dirs - :server-id 'svlangserver)) - -(lsp-register-custom-settings '(("systemverilog.includeIndexing" lsp-clients-svlangserver-includeIndexing) - ("systemverilog.excludeIndexing" lsp-clients-svlangserver-excludeIndexing) - ("systemverilog.defines" lsp-clients-svlangserver-defines) - ("systemverilog.launchConfiguration" lsp-clients-svlangserver-launchConfiguration) - ("systemverilog.lintOnUnsaved" lsp-clients-svlangserver-lintOnUnsaved) - ("systemverilog.formatCommand" lsp-clients-svlangserver-formatCommand) - ("systemverilog.disableCompletionProvider" lsp-clients-svlangserver-disableCompletionProvider) - ("systemverilog.disableHoverProvider" lsp-clients-svlangserver-disableHoverProvider) - ("systemverilog.disableSignatureHelpProvider" lsp-clients-svlangserver-disableSignatureHelpProvider) - ("systemverilog.disableLinting" lsp-clients-svlangserver-disableLinting))) - -(defgroup lsp-verilog nil - "LSP support for Verilog/SystemVerilog." - :group 'lsp-mode - :link '(url-link "https://github.com/suoto/hdl_checker")) - -(defcustom lsp-clients-verilog-executable '("hdl_checker" "--lsp") - "Command to start the hdl_checker language server." - :group 'lsp-verilog - :risky t - :type 'file) - -(lsp-register-client - (make-lsp-client :new-connection (lsp-stdio-connection lsp-clients-verilog-executable) - :major-modes '(verilog-mode) - :language-id "verilog" - :priority -2 - :server-id 'lsp-verilog)) - -(lsp-consistency-check lsp-verilog) - -(provide 'lsp-verilog) -;;; lsp-verilog.el ends here diff --git a/elpa/lsp-mode-20220201.852/lsp-vetur.el b/elpa/lsp-mode-20220201.852/lsp-vetur.el deleted file mode 100644 index 8bebfcca..00000000 --- a/elpa/lsp-mode-20220201.852/lsp-vetur.el +++ /dev/null @@ -1,886 +0,0 @@ -;;; lsp-vetur.el --- vls configuration -*- lexical-binding: t; -*- - -;; Copyright (C) 2019 Ivan Yonchovski - -;; Author: Ivan Yonchovski -;; 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 . - -;;; Commentary: - -;; VLS configuration - -;;; Code: - -(require 'lsp-mode) -(require 'lsp-html) - -(defgroup lsp-vetur nil - "LSP support for Vue, using the Vue Language Server." - :group 'lsp-mode - :link '(url-link "https://github.com/vuejs/vetur/tree/master/server") - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-vetur-ignore-project-warning nil - "Ignore projects without jsconfig.json or tsconfig.json warnings." - :type 'boolean - :group 'lsp-vetur - :package-version '(lsp-mode . "8.0.1")) - -(defcustom lsp-vetur-use-workspace-dependencies nil - "Use dependencies from workspace. Currently only for -TypeScript." - :type 'boolean - :group 'lsp-vetur - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-vetur-completion-auto-import t - "Include completion for module export and auto import them" - :type 'boolean - :group 'lsp-vetur - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-vetur-completion-scaffold-snippet-sources - '((workspace . "(W)") - (user . "(U)") - (vetur . "(V)")) - "Where Vetur source Scaffold Snippets from and how to indicate them. -- workspace: /.vscode/vetur/snippets. -- user: /User/snippets/vetur. -- vetur: Bundled in Vetur. -The source value can be a string \"(User)\" or an emoji \"✌\". -Set a source to \"\" to disable it. -" - :type 'alist - :group 'lsp-vetur - :link '(url-link "https://vuejs.github.io/vetur/guide/snippet.html") - :package-version '(lsp-mode. "8.0.1")) - -(defcustom lsp-vetur-completion-tag-casing "kebab" - "Casing conversion for tag completion" - :type '(choice - (const "initial") - (const "kebab")) - :group 'lsp-vetur - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-vetur-grammar-custom-blocks '((docs . "md") (i18n . "json")) - "Mapping from custom block tag name to language name. Used for - generating grammar to support syntax highlighting for custom - blocks." - :type 'alist - :group 'lsp-vetur - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-vetur-validation-template t - "Validate vue-html in